How to color text created by CreateWindowExa

[jaskin]

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

It works but it leaves blank lines at the start, and line spacing too much. I think I can fix that.

You stated you think I could also do this with normal scroll bars by using the position of the scroller. I will try.

[dodicat]

This should start off, only mouse directly on the scroller, I'm sure you'll find all the other options with google

Code: Select all

'CODE BY UEZ, added some vertical scrolling

#include once "windows.bi"
#include "crt.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 Loword(wParam) 
    
    Case SB_THUMBTRACK
       var p = Hiword(wParam) 
        MoveWindow(stc1,0,50-p,300,15,true)
        MoveWindow(stc2,0,50+25-p,300,15,true)
        SetScrollPos(hwnd,SB_VERT,p,true)
        
        printf(!"%d\n",p)
    End Select
    
    
    
    Select Case uMsg
    
    
    Case WM_DESTROY
        PostQuitMessage(NULL)
        Return 0
    Case WM_LBUTTONDOWN
        
        'dim as point p
        'dim as lprect r
        ' getclientrect hwnd,r
        
        'getcursorpos(@p)
        'Screentoclient(hWnd, @p) 
        'printf(!"%d\n",hiword(wparam))
        ' beep
    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 Else
        ' getcursorpos  
        '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, 50, 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, 50+25, 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) 

[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.

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.

Here it's :

Code: Select all

#Include Once "win\richedit.bi"
#Include Once "windows.bi"
Dim Shared richedit As HWND 
Dim Shared clrrichedit As Integer=&hFFFFFF    'background color white

Declare Function fb_RichEdit (t As String,h As HWND,i As Integer,x As Integer,y As Integer,w As Integer,h As Integer,s As Integer=0,x As Integer=-1) As HWND


private function fb_RichEdit(Text As String,hWnd As HWND,id As Integer,X As Integer,Y As Integer,W As Integer, _
	H As Integer,Style As Integer,Exstyle As Integer) As HWND
      if LoadLibrary("RICHED20.DLL")=0 then
         'todo fb_message("LOADLIBRARY ERROR","riched20.dll",MB_SYSTEMMODAL)
      End If
      Dim A As HWND
      If Style=0 Then ' or WS_CLIPSIBLINGS 
          Style=WS_CHILD Or WS_VISIBLE Or ES_NOHIDESEL Or ES_READONLY Or _
                WS_HSCROLL Or WS_VSCROLL Or ES_MULTILINE Or _
                ES_AUTOVSCROLL Or ES_AUTOHSCROLL  Or ES_WANTRETURN
      End If
      If Exstyle=-1 Then
          Exstyle=WS_EX_CLIENTEDGE
      End If
      A=CreateWindowEx(Exstyle,"RichEdit20W",NULL,Style,X,Y,W,H,hWnd,Cast(HMENU,id),null,NULL)'
      '''SetWindowRTFText(A,Text)
      SendMessage(A,WM_SETFONT,Cast(WPARAM,GetStockObject(DEFAULT_GUI_FONT)),0)
      Function=A
End Function

private function fb_setcolor(h As HWND,s As Integer,c As Integer,d As Integer) As Integer
	'''#define WM_USER  &h0400
	'''#define EM_SETCHARFORMAT 1092 'wm_user+68
	''#define CFM_COLOR  &h40000000
	''#define SCF_SELECTION  1
	''#define SCF_WORD  2
	''#define SCF_DEFAULT  0
	''#define SCF_ALL  4
	''#define CFE_AUTOCOLOR	1073741824
	Dim lpcharformat As CHARFORMAT,selt As Integer
	Select Case s
		Case 0
	selt=0 'set to the default format
		Case 1
	selt=SCF_ALL 'Applies the formatting to all text in the control.
		Case 2
	selt=SCF_SELECTION 'Applies the formatting to the current selection.
		Case 3
	selt=SCF_WORD Or SCF_SELECTION 'Applies the formatting to the selected word or words.
	End Select
	lpcharformat.cbsize=Len(charformat)
	lpcharformat.crtextcolor=c

	lpcharformat.dwmask= CFM_UNDERLINE Or CFM_BOLD Or CFM_COLOR Or CFM_ITALIC 
	If d=1 Then
	   lpcharformat.dweffects=CFE_AUTOCOLOR
	ElseIf d=2 Then
	   lpcharformat.dweffects=CFE_UNDERLINE Or CFE_BOLD 'Or STRIKEOUT'
	ElseIf d=3 Then
	   ' lpcharformat.dweffects=CFE_ITALIC
	End If

	If sendmessage(h,EM_SETCHARFORMAT,selt,Cast(LPARAM,@lpcharformat))=0 Then
		'todo fb_message("ERROR","Set color format")
		 Return FALSE
	Else
		Return TRUE
	End If
End Function

private sub sel_line(l As Integer,c As Integer=0,s As Integer=0,h As HWND=richedit)
	Dim d As Integer,f As Integer,range As charrange
	d=SendMessage ( h , EM_LINEINDEX,l, 0)
	f=SendMessage ( h , EM_LINEINDEX,l+1, 0)
	range.cpmin=d :range.cpmax=f-1
	SendMessage ( h , EM_exSETSEL,0,Cast(LPARAM,@range))
	fb_setcolor(h,2,c,s)
	SendMessage(h,EM_HIDESELECTION,1,0)
End Sub

#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)

richedit = fb_RichEdit("fb Edit Box",hwndx,0,3,65,475,100)

'sendmessage(richedit,EM_SETBKGNDCOLOR,0,clrrichedit) ''clear window

'ShowWindow(richedit,SW_SHOW)

setwindowtext(richedit,@("Line in red"+chr(13)+"Line in green"+chr(13)+"Line in blue"))

sel_line(0,&hFF)
sel_line(1,&hFF00)
sel_line(2,&hFF0000)

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

[jaskin]

Many thanks to SARG and dodicat. Both are close to what I need. I'll have a bash at them to complete them to my requirements. As per usual there's more than one way to achieve similar goals.