How to color text created by CreateWindowExa

[jaskin]

I've successfully used the following code to create a simple Windows text message with two lines. All I need now is to make the first line of text one color, say red, and the second line of text another color, say green. How can it be done please?

Code: Select all

#INCLUDE ONCE "windows.bi"
#Include "/win/commctrl.bi"

Dim As MSG msg     ' Message variable (stores massages)
Dim As HWND hWndx, stc1  ' Window variable and object variables
DIM AS HFONT xFont

' Create window
hWndx = CreateWindowExa( 0, "#32770", "", WS_OVERLAPPEDWINDOW Or WS_VISIBLE or WS_VSCROLL, 100, 100, 500, 300, 0, 0, 0, 0 )

 Create 1st static box
stc1 = CreateWindowExa( 0, "STATIC", "Line 1", WS_VISIBLE Or WS_CHILD, 0, 0, 300, 15, hWndx, 0, 0, 0 )
xFont = CreateFonta(20, 0, 0, 0, FW_BOLD, 0, 0, 0, ANSI_CHARSET, FALSE, FALSE, DEFAULT_QUALITY, DEFAULT_PITCH OR FF_ROMAN, "Courier New")
SendMessage(stc1, WM_SETFONT, CAST(WPARAM, xFont), True)

' Create 2nd static box
stc1 = CreateWindowExa( 0, "STATIC", "Line 2", WS_VISIBLE Or WS_CHILD, 0, 15, 300, 15, hWndx, 0, 0, 0 )
xFont = CreateFonta(20, 0, 0, 0, FW_BOLD, 0, 0, 0, ANSI_CHARSET, FALSE, FALSE, DEFAULT_QUALITY, DEFAULT_PITCH OR FF_ROMAN, "Courier New")
SendMessage(stc1, WM_SETFONT, CAST(WPARAM, xFont), True)


While GetMessage( @msg, 0, 0, 0 )    ' Get message from window
  TranslateMessage( @msg )
  DispatchMessage( @msg )

  Select Case msg.hwnd
    Case hWndx        ' If msg is window hwnd: get messages from window
      Select Case msg.message
        Case 273
        End
    End Select
  End Select
Wend

[SARG]

Not sure you can do that in simple textbox. It's ok to change the color for all the lines.
Use richtextbox control. Or search for a library which has this feature.

[jaskin]

Not sure you can do that in simple textbox. It's ok to change the color for all the lines.
Use richtextbox control. Or search for a library which has this feature.

Thanks but it's no use to me. I need to have the ability to change the color of any specific line.

Perhaps someone can direct me to where I can use something other than CreateWindowExa to display text messages with differently colored lines of text. It needs to have a vertical scroll bar feature just like what CreateWindowExa has.

[SARG]

As I wrote use richtextbox control. With that you can define font/size/color for each line.

[UEZ]

You can try this:

Code: Select all

#include once "windows.bi"

Dim As MSG msg     ' Message variable (stores massages)
Dim Shared As HWND hWndx, stc1, stc2  ' Window variable and object variables
Dim As HFONT xFont1, xFont2

Function WNDPROC(ByVal hWnd As HWND, ByVal uMsg As UINT, ByVal wParam As WPARAM, ByVal lParam As LPARAM) As LRESULT
    Select Case uMsg
		Case WM_DESTROY
			PostQuitMessage(NULL)
			Return 0
        Case WM_CTLCOLORSTATIC
            Dim As HDC hdcStatic = Cast(HDC, wParam)
            Select Case lParam
            	Case stc1
					SetTextColor(hdcStatic, &hFF0000) 'BGR
					SetBkColor(hdcStatic, GetSysColor(COLOR_WINDOW))
					Return Cast(INT_PTR, (GetSysColorBrush(COLOR_WINDOW)))
            	Case stc2
					SetTextColor(hdcStatic, &h0000FF) 'BGR
					SetBkColor(hdcStatic, GetSysColor(COLOR_WINDOW))
					Return Cast(INT_PTR, (GetSysColorBrush(COLOR_WINDOW)))
            End Select
            Return 0
    End Select
    Return DefWindowProc(hWnd, uMsg, wParam, lParam)
End Function


Dim As WNDCLASS WinCls

#ifdef unicode
	Dim szClassName As WString * 64
	Dim szCaption   As WString * 64
#else
	Dim szClassName As ZString * 64
	Dim szCaption   As ZString * 64
#endif

szClassName = "FB_GUI"

With WinCls
    .style          = CS_HREDRAW Or CS_VREDRAW
    .lpfnWndProc    = Cast(WNDPROC, @WNDPROC)
    .hInstance      = GetModuleHandle(NULL)
    .hIcon          = LoadIcon(NULL, IDI_APPLICATION)
    .hCursor        = LoadCursor(NULL, IDC_ARROW)
    .hbrBackground  = GetSysColorBrush(COLOR_3DFACE) 'GetStockObject(WHITE_BRUSH)
    .lpszMenuName   = NULL
    .lpszClassName  = StrPtr(szClassName)
End With

If RegisterClass(@WinCls) = False Then
    MessageBox(NULL, "RegisterClass('WindowClass') FAIL!", "Error!", MB_OK Or MB_ICONERROR)
    End
End If

' Create window
hWndx = CreateWindowEx( 0, szClassName, "", WS_OVERLAPPEDWINDOW Or WS_VISIBLE Or WS_VSCROLL, 100, 100, 500, 300, 0, 0, 0, 0 )

' Create 1st Static box
stc1 = CreateWindowEx( 0, "STATIC", "Line 1", WS_VISIBLE Or WS_CHILD, 0, 0, 300, 15, hWndx, 0, 0, 0 )
xFont1 = CreateFont(20, 0, 0, 0, FW_BOLD, 0, 0, 0, ANSI_CHARSET, False, False, DEFAULT_QUALITY, DEFAULT_PITCH Or FF_ROMAN, "Courier New")
SendMessage(stc1, WM_SETFONT, Cast(WPARAM, xFont1), True)

' Create 2nd static box
stc2 = CreateWindowEx( 0, "STATIC", "Line 2", WS_VISIBLE Or WS_CHILD, 0, 15, 300, 15, hWndx, 0, 0, 0 )
xFont2 = CreateFont(20, 0, 0, 0, FW_BOLD, 0, 0, 0, ANSI_CHARSET, False, False, DEFAULT_QUALITY, DEFAULT_PITCH Or FF_ROMAN, "Courier New")
SendMessage(stc2, WM_SETFONT, Cast(WPARAM, xFont2), True)

Dim As MSG uMsg

While GetMessage(@uMsg, 0, 0, 0)
	TranslateMessage(@uMsg)
	DispatchMessage(@uMsg)
Wend
DeleteObject(xFont1)
DeleteObject(xFont2)

[jaskin]

You can try this:
....

Thank you, that worked.

[SARG]

I should have looked at your code more carefully.
I interpreted a text of 2 lines and in fact it's 2 texts of one line

[jaskin]

I should have looked at your code more carefully.
I interpreted a text of 2 lines and in fact it's 2 texts of one line

That's correct. So I can use richtext feature with CreateWindowExa. I just need to find out how it's done. Never easy with Windows controls, until one finds out how to do it

[SARG]

I can help you for richtextbox. I used it in a previous version of fbdebugger to display the code source of debugged programs.
Now it's Scintilla component, easier and multi OS.

[jaskin]

I can help you for richtextbox. I used it in a previous version of fbdebugger to display the code source of debugged programs.
Now it's Scintilla component, easier and multi OS.

Yes, please use the code I posted above to add the necessary statements using richtextbox to make the two lines have different colors. That's all I need.

[jaskin]

You can try this:
...

Although that worked as I said, when I create many more lines that go beyond the scope of the window, I can't scroll down to see the hidden ones. If that's a lot more coding to make it all work then I might have to forget it and just use a Console Window with a limited number of 15 colors. At least I can scroll in that window. It's a shame that a window created with the built-in screenres command can't have a vertical scroll bar so that I can scroll up and down the list of differently colored lines that are generated using the COLOR and PRINT commands.

[dodicat]

You can scroll child windows with a trackbar.
Example using wonky buttons coloured by temp bitmaps.

Code: Select all

 

#include once "windows.bi"
#Include once "/win/commctrl.bi"
#include "fbgfx.bi"

Function CreateTrackBar(dest As hwnd,x As Long,y As Long,lngth As Long,height As Long,range As Long,pagesize As Long) As hwnd
    Dim As hwnd h=CreateWindowEx(NULL,TRACKBAR_CLASS, "Trackbar Control", WS_VISIBLE Or WS_CHILD Or TBS_VERT Or TBS_AUTOTICKS Or TBS_ENABLESELRANGE,x,y,lngth,height,dest,NULL, NULL, NULL)
    SendMessage(h,TBM_SETRANGE,TRUE, MAKELONG(0,range))
    SendMessage(h,TBM_SETTICFREQ,pagesize,0)'Set tic frequency
    SendMessage(h,TBM_SETPAGESIZE,0,pagesize) 'Set page size
    Return h
End Function

Function contrast(c As Ulong) As Ulong
    Randomize 1
    #define Intrange(f,l) Int(Rnd*((l+1)-(f))+(f))
    'get the rgb values
    Dim As Ubyte r=Cptr(Ubyte Ptr,@c)[2],g=Cptr(Ubyte Ptr,@c)[1],b=Cptr(Ubyte Ptr,@c)[0],r2,g2,b2
    Do
        r2=Intrange(0,255):g2=IntRange(0,255):b2=IntRange(0,255)
        'get at least 120 byte difference
    Loop Until Abs(r-r2)>120 Andalso Abs(g-g2)>120 Andalso Abs(b-b2)>120
    Return Rgb(r2,g2,b2) 
End Function

Sub getsize(picture As String,Byref dimensionx As Long,Byref dimensiony As Long)
    Open picture For Binary Access Read As #1
    Get #1, 19, dimensionx
    Get #1, 23, dimensiony
    Close #1
End Sub

Screen 17,32,,fb.GFX_NULL
Dim As Ulong colour(1 To 20)

For n As Long=1 To 20
    colour(n)=Rnd*Rgb(255,255,255)
Next
Dim As Any Ptr i(1 To 20)
For n As Long=1 To 20
    i(n)=Imagecreate(300+20*sin(n/1.5),50,colour(n))
Next

For n As Long=1 To 20
    Dim As String s= "line"+Str(n)
    Draw String i(n),(100+25,25),s,contrast(colour(n))
Next

Dim As String szBitmap(1  To 20)
For n As Long=1 To 20
    szbitmap(n)="line "+Str(n)+".bmp"
Next n

For n As Long=1 To 20
    Bsave szbitmap(n),i(n)
Next

For n As Long=1 To 20
    Imagedestroy i(n)
Next

Dim As Long w(1 To 20),h(1 To 20)
For n As Long=1 To 20
    getsize(szbitmap(n),w(n),h(n)) 
    If w(n)*h(n) Then Print "OK" Else Print "Loading error":Sleep:End
Next

Dim As MSG msg
Dim  As HWND hWnd, childwin(1 To 20)
hWnd = CreateWindowEx( 0, "#32770", "Bitmap Button Test", WS_OVERLAPPEDWINDOW Or WS_VISIBLE  , 100, 0, 470, 600, 0, 0, 0, 0 )

For n As Long=1 To 20
    childwin(n) = CreateWindowEx(SS_BITMAP , "button", "" , WS_VISIBLE Or ws_border Or  WM_ENABLE Or WS_CHILD  Or BS_BITMAP, 10 , 100+50*n , w(n) ,h(n) , hWnd, 0, 0, 0 )
Next

For n As Long=1 To 20
    Dim hBitmap As HANDLE = LoadImage(0, szBitmap(n), IMAGE_BITMAP, w(n), h(n),  LR_LOADFROMFILE )
    If hbitmap Then SendMessage(childwin(n), BM_SETIMAGE, IMAGE_BITMAP, Cast(LPARAM, hbitmap))
Next

Var tic=25,range=255
Var bar =CreateTrackBar(hwnd,410, 0, 30, 560,range,tic)

While GetMessage( @msg, 0, 0, 0 )
    
    TranslateMessage( @msg )
    DispatchMessage( @msg )
    
    Select Case msg.hwnd
    Case hWnd
        Select Case msg.message
        Case 273 : PostQuitMessage(0):end
        End Select 
    End Select
    
    Var t= SendMessage(bar, TBM_GETPOS, 1, 0)
    
    For n As Long=1 To 20
        MoveWindow(childwin(n),10,100+50*n-t*2.5,w(n),h(n),true)
        'showwindow(childwin(n),true)
    Next
Wend
For n As Long=1 To 20
    Kill "line "+Str(n)+".bmp"
Next

 

[jaskin]

You can scroll child windows with a trackbar.
Example using wonky buttons coloured by temp bitmaps.

Nice work but I much prefer normal text. Thanks anyway.

[dodicat]

But you can scroll your static windows with coloured text in the same way.
In the Winproc, if you use one
Case WM_VSCROLL
Select Case lparam
Case bar
trackpos= SendMessage(bar, TBM_GETPOS, 1, 0)
then use movewindow adding trackpos or a multiple of it to the y value.
You'll have to juggle about with the constants tic and range a bit maybe.

[dodicat]

Here is UEZ's code with scrolling (via a trackbar)

Code: Select all

'BY UEZ with scroll added
#include once "windows.bi"
#Include once "/win/commctrl.bi"

Dim As MSG msg     ' Message variable (stores massages)
Dim Shared As HWND hWndx, stc1, stc2 ,bar ' Window variable and object variables
Dim As HFONT xFont1, xFont2
Dim Shared As Long tic,range
tic=30
range=300
Function CreateTrackBar(dest As hwnd,x As Long,y As Long,lngth As Long,height As Long,range As Long,pagesize As Long) As hwnd
    Dim As hwnd h=CreateWindowEx(NULL,TRACKBAR_CLASS, "Trackbar Control", WS_VISIBLE Or WS_CHILD Or TBS_VERT Or TBS_AUTOTICKS Or TBS_ENABLESELRANGE,x,y,lngth,height,dest,NULL, NULL, NULL)
    SendMessage(h,TBM_SETRANGE,TRUE, MAKELONG(0,range))
    SendMessage(h,TBM_SETTICFREQ,pagesize,0)'Set tic frequency
    SendMessage(h,TBM_SETPAGESIZE,0,pagesize) 'Set page size
    Return h
End Function

Function WNDPROC(Byval hWnd As HWND, Byval uMsg As UINT, Byval wParam As WPARAM, Byval lParam As LPARAM) As LRESULT
    
    
    Select Case umsg
   
    Case WM_DESTROY
        PostQuitMessage(NULL)
        Return 0
        
    Case WM_CTLCOLORSTATIC
        
        Dim As HDC hdcStatic = Cast(HDC, wParam)
        Select Case lParam
        Case stc1
            SetTextColor(hdcStatic, &hFF0000) 'BGR
            SetBkColor(hdcStatic, GetSysColor(COLOR_WINDOW))
            Return Cast(INT_PTR, (GetSysColorBrush(COLOR_WINDOW)))
        Case stc2
            SetTextColor(hdcStatic, &h0000FF) 'BGR
            SetBkColor(hdcStatic, GetSysColor(COLOR_WINDOW))
            Return Cast(INT_PTR, (GetSysColorBrush(COLOR_WINDOW)))
        End Select
        
        '============
    Case  WM_VSCROLL                        'TRACKBARS
        Select Case lparam
        Case bar
            Var t= SendMessage(bar, TBM_GETPOS, 1, 0)
            MoveWindow(stc1,0,90+0-t,300,15,true)
            MoveWindow(stc2,0,90+25-t,300,15,true)
        End Select
       Return 0
    End Select
    Return DefWindowProc(hWnd, uMsg, wParam, lParam)
End Function


Dim As WNDCLASS WinCls

#ifdef unicode
Dim szClassName As WString * 64
Dim szCaption   As WString * 64
#else
Dim szClassName As ZString * 64
Dim szCaption   As ZString * 64
#endif

szClassName = "FB_GUI"

With WinCls
    .style          = CS_HREDRAW Or CS_VREDRAW
    .lpfnWndProc    = Cast(WNDPROC, @WNDPROC)
    .hInstance      = GetModuleHandle(NULL)
    .hIcon          = LoadIcon(NULL, IDI_APPLICATION)
    .hCursor        = LoadCursor(NULL, IDC_ARROW)
    .hbrBackground  = GetSysColorBrush(COLOR_3DFACE) 'GetStockObject(WHITE_BRUSH)
    .lpszMenuName   = NULL
    .lpszClassName  = Strptr(szClassName)
End With

If RegisterClass(@WinCls) = False Then
    MessageBox(NULL, "RegisterClass('WindowClass') FAIL!", "Error!", MB_OK Or MB_ICONERROR)
    End
End If

' Create window
hWndx = CreateWindowEx( 0, szClassName, "", WS_OVERLAPPEDWINDOW Or WS_VISIBLE   , 100, 100, 500, 300, 0, 0, 0, 0 )

' Create 1st Static box
stc1 = CreateWindowEx( 0, "STATIC", "Line 1", WS_VISIBLE Or WS_CHILD, 0, 0+90, 300, 15, hWndx, 0, 0, 0 )
xFont1 = CreateFont(20, 0, 0, 0, FW_BOLD, 0, 0, 0, ANSI_CHARSET, False, False, DEFAULT_QUALITY, DEFAULT_PITCH Or FF_ROMAN, "Courier New")
SendMessage(stc1, WM_SETFONT, Cast(WPARAM, xFont1), True)

' Create 2nd static box
stc2 = CreateWindowEx( 0, "STATIC", "Line 2", WS_VISIBLE Or WS_CHILD, 0, 25+90, 300, 15, hWndx, 0, 0, 0 )
xFont2 = CreateFont(20, 0, 0, 0, FW_BOLD, 0, 0, 0, ANSI_CHARSET, False, False, DEFAULT_QUALITY, DEFAULT_PITCH Or FF_ROMAN, "Courier New")
SendMessage(stc2, WM_SETFONT, Cast(WPARAM, xFont2), True)

'create a vertical trackbar, 300 high, with tic marks each 30
bar =CreateTrackBar(hwndx,450, 0, 30, 260,range,tic)
Dim As MSG uMsg

While GetMessage(@uMsg, 0, 0, 0)
	TranslateMessage(@uMsg)
	DispatchMessage(@uMsg)
Wend
DeleteObject(xFont1)
DeleteObject(xFont2) 

I think you could also do this with normal scroll bars.
You need to get the position of the scroller.