Multicolored string

[Natter]

Hi,

I need to show a text string, each character of which has its own color. Is it possible to do this on FW ?

[karinha]

Code: Select all  Expand view

// C:\FWH...\SAMPLES\CORSAY.PRG

#include "fivewin.ch"

FUNCTION SayColors()

   local oDlg, oFont, oFontBold, oBold, oSay, oSay1, oSay2, oSay3, oSayFin
   local nValue   := 2000

   /*
   oSay1 := "SAY de uma Cor  "
   oSay2 := "SAY de outra Cor"
   oSay3 := "SAY de Nada Não. "
   */

   oSay1 := "One a Color "
   oSay2 := "another Color"
   oSay3 := "Don't SAY NO."

   DEFINE FONT oFont     NAME "TAHOMA"  SIZE 0, -12
   DEFINE FONT oFontBold NAME "TAHOMA"  SIZE 0, -14 BOLD
   DEFINE FONT oBold     NAME "VERDANA" SIZE 0, -32 BOLD

   DEFINE DIALOG oDlg SIZE 400, 250 PIXEL TRUEPIXEL FONT oFont ;
      TITLE FWVERSION

   @ 150,  50 SAY oSay1 PICTURE "@K" SIZE 100, 16 PIXEL OF oDlg FONT oFontBold ;
      UPDATE COLORS CLR_CYAN, CLR_WHITE

   @ 150, 150 SAY oSay2 PICTURE "@K" SIZE 100, 16 PIXEL OF oDlg FONT oFontBold ;
      UPDATE COLORS CLR_HRED, CLR_WHITE

   @ 150, 252 SAY oSay3 PICTURE "@K" SIZE 120, 16 PIXEL OF oDlg FONT oFontBold ;
      UPDATE COLORS CLR_MAGENTA, CLR_WHITE

   @ 20,100 SAY oSay PROMPT nValue PICTURE "9999" ;
      SIZE 200,36 PIXEL OF oDlg FONT oBold CENTER ;
      COLOR SayClr( nValue ), CLR_WHITE UPDATE

   @ 80, 20 BUTTON   "50" SIZE 100,30 PIXEL OF oDlg ;
      ACTION ( nValue :=   50, oSay:SetColor( SayClr( nValue ), CLR_WHITE ), oDlg:Update() )

   @ 80,150 BUTTON  "500" SIZE 100,30 PIXEL OF oDlg ;
      ACTION ( nValue :=  500, oSay:SetColor( SayClr( nValue ), CLR_WHITE ), oDlg:Update() )

   @ 80,280 BUTTON "5000" SIZE 100,30 PIXEL OF oDlg ;
      ACTION ( nValue := 5000, oSay:SetColor( SayClr( nValue ), CLR_WHITE ), oDlg:Update() )

   ACTIVATE DIALOG oDlg CENTERED

   RELEASE FONT oFont, oBold

RETURN NIL

static function SayClr( n )

return If( n <= 100, CLR_BLUE, If( n <= 1000, CLR_GREEN, CLR_HRED ) )

// FIN / END  - kapiabafwh@gmail.com
 

Regards, saludos.

[karinha]

Code: Select all  Expand view

// \samples\CORSAY2.PRG - For apprentices. Swap colors.

#Include "FiveWin.ch"

STATIC oSay1, oSay2, oSay3, oSay4, oSay5, oSay6
STATIC oDlg, oFont1

FUNCTION Main()

   LOCAL cTitle

   cTitle := "Colors - CLICK WITH THE RIGHT MOUSE BUTTON"

   DEFINE FONT oFont1 NAME "MS Sans Serif" SIZE   0, - 24

   DEFINE DIALOG oDlg TITLE cTitle FROM 0, 0 TO 400, 700 PIXEL ;
      COLOR 0, 16777215 TRANSPARENT

   oDlg:lHelpIcon := .F.

   ACTIVATE DIALOG oDlg ON INIT Inicio() CENTERED

   oFont1:End()

RETURN NIL

FUNCTION Inicio()

   @  20,  22 SAY oSay1 VAR "Text Color:" SIZE 152, 24 PIXEL ;
      OF oDlg COLOR 0, 16777215 FONT oFont1

   @  20, 209 SAY oSay2 VAR "0" SIZE 142,  28 PIXEL;
      OF oDlg COLOR 0, 16777215 FONT oFont1

   @  20, 371 SAY oSay3 VAR RRGB( 0 ) SIZE 200, 28 PIXEL ;
      OF oDlg COLOR 0, 16777215 FONT oFont1

   @  80,  20 SAY oSay4 VAR "Window Color:" SIZE 175, 33 PIXEL ;
      OF oDlg COLOR 0, 16777215 FONT oFont1

   @  80, 209 SAY oSay5 VAR "0" SIZE 141, 39 PIXEL ;
      OF oDlg COLOR 0, 16777215 FONT oFont1

   @  80, 371 SAY oSay6 VAR RRGB( 0 ) SIZE 200, 39 PIXEL ;
      OF oDlg COLOR 0, 16777215 FONT oFont1

   // Right click
   oDlg:bRClicked := {| nRow, nCol | RPopup( nRow, nCol, oDlg, { oSay1, oSAy2, oSay3, oSay4, oSay5, oSay6 } ) }

RETURN NIL

FUNCTION RPopup( nRow, nCol, oDlg, aSays )

   LOCAL oMenu

   oMenu := MenuPopUp( oDlg, aSays )

   ACTIVATE POPUP oMenu WINDOW oDlg AT nRow, nCol

RETURN NIL

FUNCTION MenuPopUp( oDlg, aSays )

   LOCAL oMenu
   LOCAL nClrTxt := oSay1:nClrText
   LOCAL nClrDlg := oDlg:nClrPane

   MENU oMenu PopUp

      MenuItem "Text Color" ;
         Action ( nClrTxt := ChooseColor( nClrTxt ), ;
         AplicaCores( oDlg, aSays, nClrTxt, nClrDlg ) )

      MenuItem "Window Color" ;
         Action( nClrDlg := ChooseColor( nClrDlg ), ;
         AplicaCores( oDlg, aSays, nClrTxt, nClrDlg ) )

   ENDMENU

RETURN( oMenu )

FUNCTION AplicaCores( oDlg, aSays, nClrTxt, nClrDlg )

   LOCAL i, cRgbTxt, cRgbDlg

   oDlg:SetColor( nClrTxt, nClrDlg )

   oDlg:Refresh()

   FOR i := 1 TO 6

      SysRefresh()

      aSays[ i ]:SetColor( nClrTxt, nClrDlg )

      aSays[ i ]:Refresh()

   NEXT

   cRgbTxt := RRGB( nClrTxt )
   cRgbDlg := RRGB( nClrDlg )

   aSays[ 2 ]:SetText( nClrTxt )
   aSays[ 3 ]:SetText( cRgbTxt )
   aSays[ 5 ]:SetText( nClrDlg )
   aSays[ 6 ]:SetText( cRgbDlg )

RETURN NIL

FUNCTION RRGB( nCor )

   LOCAL cRGB := "{ " + StrZero( nRGBRed( nCor ), 3 )   + ", "   + ;
                        StrZero( nRGBGreen( nCor ), 3 ) + ", " + ;
                        StrZero( nRGBBlue( nCor ), 3 )  + " }"

RETURN( cRGB)

// FIN / END
 

Regards, saludos.

[Natter]

In addition, this can be done on WebView and RichEdit.
No, these are not interesting solutions

[nageswaragunupudi]

I need to show a text string, each character of which has its own color. Is it possible to do this on FW ?

Code: Select all  Expand view

#include "fivewin.ch"
#define DT_SINGLELINE      32
#define DT_CALCRECT  1024

function Main()

   local cText := "MULTI-COLOR TEXT"
   local oDlg, oBar, oFont

   local aColors  := { ;
   METRO_LIME, METRO_GREEN, METRO_EMERALD, METRO_TEAL, METRO_CYAN,      ;
   METRO_COBALT, METRO_INDIGO, METRO_VIOLET, METRO_PINK, METRO_MAGENTA, ;
   METRO_CRIMSON, METRO_RED, METRO_ORANGE, METRO_AMBER, METRO_YELLOW,   ;
   METRO_BROWN, METRO_OLIVE, METRO_STEEL, METRO_MAUVE, METRO_TAUPE      }

   AShuffle( aColors )

   DEFINE FONT oFont NAME "IMPACT" SIZE 0,-60
   DEFINE DIALOG oDlg SIZE 600,400 PIXEL TRUEPIXEL RESIZABLE ;
      TITLE cText
   DEFINE BUTTONBAR oBar SIZE 64,32 2007

   oDlg:bPainted  := <|hDC|
      local aRect
      local c, n, w, nRight, bk

      // Center Text
      aRect := oDlg:GetCliAreaRect():aRect
      n     := DrawTextEx( hDC, cText, aRect, DT_SINGLELINE + DT_CALCRECT, oFont:hFont, 0, @nRight )
      aRect[ 1 ]  += ( aRect[ 3 ] - aRect[ 1 ] - n ) / 2
      aRect[ 2 ]  += Int( ( aRect[ 4 ] - nRight ) / 2 )

      // Paint Text
      bk := SetBkMode( hDC, 1 )
      for n := 1 to Len( cText )
         c  := SubStr( cText, n, 1 )
         DrawTextEx( hDC, c, aRect, DT_SINGLELINE + DT_CALCRECT, oFont:hFont, aColors[ n ], @nRight )
         DrawTextEx( hDC, c, aRect, DT_SINGLELINE, oFont:hFont, aColors[ n ] )
         aRect[ 2 ] := nRight
      next
      SetBkMode( hDC, bk )

      return nil
      >

   oDlg:bInit  := <||
      SET MESSAGE OF oDlg TO "Color Text" CENTER 2007
      return nil
      >

   ACTIVATE DIALOG oDlg CENTERED
   RELEASE FONT oFont

return nil
 

This is the main logic

Code: Select all  Expand view

     for n := 1 to Len( cText )
         c  := SubStr( cText, n, 1 )
         DrawTextEx( hDC, c, aRect, DT_SINGLELINE + DT_CALCRECT, oFont:hFont, aColors[ n ], @nRight )
         DrawTextEx( hDC, c, aRect, DT_SINGLELINE, oFont:hFont, aColors[ n ] )
         aRect[ 2 ] := nRight
      next
 

[Natter]

Rao, thank you very much, a beautiful solution !!

[Jimmy]

Great

the Main Logic also run under HMG

Code: Select all  Expand view

#include "hmg.ch"
#include "i_winuser.ch"

#define DT_SINGLELINE 32
#define DT_CALCRECT  1024
*------------------------------------------------------------------------------*
FUNCTION App_OnPaint( hWnd, hFont, cText )
*------------------------------------------------------------------------------*
   LOCAL aColors := { ;
      METRO_LIME, METRO_GREEN, METRO_EMERALD, METRO_TEAL, METRO_CYAN, ;
      METRO_COBALT, METRO_INDIGO, METRO_VIOLET, METRO_PINK, METRO_MAGENTA, ;
      METRO_CRIMSON, METRO_RED, METRO_ORANGE, METRO_AMBER, METRO_YELLOW, ;
      METRO_BROWN, METRO_OLIVE, METRO_STEEL, METRO_MAUVE, METRO_TAUPE }
   LOCAL aRect := { 0, 0, 0, 0 }
   LOCAL c, n, hDC, nRight, bk

   GetClientRectArea( hWnd, aRect )

   // Center Statusbar Text
   Form_Main.Statusbar.Item( 1 ) := PadC( "Color Text", aRect[ 4 ] / 4 )

   hDC := GetDC( hWnd )

   // Center Text
   n := DrawTextEx( hDC, cText, aRect, DT_SINGLELINE + DT_CALCRECT, hFont, 0, @nRight )
   aRect[ 1 ] += ( aRect[ 3 ] - aRect[ 1 ] - n ) / 2
   aRect[ 2 ] += Int( ( aRect[ 4 ] - nRight ) / 2 )

   // Paint Text
   bk := SetBkMode( hDC, 1 )
   FOR n := 1 TO Len( cText )
      c := SubStr( cText, n, 1 )
      DrawTextEx( hDC, c, aRect, DT_SINGLELINE + DT_CALCRECT, hFont, aColors[ n ], @nRight )
      DrawTextEx( hDC, c, aRect, DT_SINGLELINE, hFont, aColors[ n ] )
      aRect[ 2 ] := nRight
   NEXT
   SetBkMode( hDC, bk )

   ReleaseDC( hWnd, hDC )

RETURN NIL