How to paint BackGround Color of static control with WM_CTLCOLORSTATIC

[Iczer]

I have multiply GUIs in separate threads and static controls in them should be painted in different colors (color decided on Thread/GUI start).
What I should use to pass right color to WndProc()/WM_CTLCOLORSTATIC ?
Is there are thread-wide shared variables in FreeBasic?

Code: Select all

Case WM_CTLCOLORSTATIC
	SetBkColor(Cast(HDC,wParam), Color_1)
	Return Cast(LRESULT,CreateSolidBrush(Color_1))

I tried to use HashTable and ThreadId to select color, but without success...

Code: Select all

Case WM_CTLCOLORSTATIC
	Dim As LPCOLORREF BkColor = g_hash_table_lookup(GlobalReferense_BkColorHashTable, @GetCurrentThreadId())
	SetBkColor(Cast(HDC,wParam), *BkColor)
	Return Cast(LRESULT,CreateSolidBrush(*BkColor))

[jj2007]

lParam is the handle of static control. Store the desired colour with the control itself. See GetWindowLong(hWnd, GWL_USERDATA)

[Iczer]

Thanks!

[Allen65]

lParam is the handle of static control. Store the desired colour with the control itself. See GetWindowLong(hWnd, GWL_USERDATA)

Have you considered subclassing the static window and doing owner draw?IndigoCard

[jj2007]

Have you considered subclassing the static window and doing owner draw?

Yes, I've considered that, but it's an overkill for OP's simple case

[dodicat]

"Is there are thread-wide shared variables in FreeBasic?"
At a push you can use err (carefully, see the help for preserving err).

Code: Select all

function proc() as long
    var e=err
print cast(ubyte ptr,@e)[2],cast(ubyte ptr,@e)[1],cast(ubyte ptr,@e)[0],cast(ubyte ptr,@e)[3]
return 0
end function


sub main
err=rgba(100,20,80,2)
proc
end sub


main
sleep
 

 

[dodicat]

I notice that err does not pass from win main to win proc.
Don't know why.
Information can be passed via WM_User, but it seems to be processed last (after WM_PAINT and WM_CTLCOLORstatic), but WM_User can pass the info to a child window via setwindowtext for the purpose of showing the value.
The wparam carries WM_User stuff.
Demo:

Code: Select all

#Include Once "windows.bi"
#define Red( c ) ( ( c ) Shr 16 And 255 )
#define Green( c ) ( ( c ) Shr  8 And 255 )
#define Blue( c ) ( ( c )        And 255 )
#define Alph( c ) ( ( c ) Shr 24         )


Declare Function  WinMain(Byval hInstance As HINSTANCE, _
Byval hPrevInstance As HINSTANCE, _
Byval szCmdLine As Zstring Ptr, _
Byval iCmdShow As Integer ) As Integer
'call
End WinMain( GetModuleHandle( null ), null, Command( ), SW_NORMAL )


Function Set_Font (Font As String,Size As Long,Bold As Long,Italic As Long,Underline As Long,StrikeThru As Long) As HFONT
    Dim As HDC hDC=GetDC(HWND_DESKTOP)
    Dim As Long CyPixels=GetDeviceCaps(hDC,LOGPIXELSY)
    ReleaseDC(HWND_DESKTOP,hDC)
    Return CreateFont(0-(Size*CyPixels)/72,0,0,0,Bold,Italic,Underline,StrikeThru,ANSI_CHARSET _
    ,OUT_TT_PRECIS,CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY,FF_DONTCARE,Font)
End Function

Function WndProc (Byval hWnd As HWND, _
    Byval wMsg As UINT, _
    Byval wParam As WPARAM, _
    Byval lParam As LPARAM ) As LRESULT
    
    Function = 0
    Static As Ulong x,y,z
    Static As zstring Ptr s
    Static As hwnd lab1,lab2,lab3,lab4,lab5
    Static As hdc dch
    Static  BrushH As HBRUSH 
    Dim  As HFONT  ThisFont:ThisFont=Set_Font("Times new roman",14,0,1,0,0)
    Select Case wMsg
    
    
    
    Case WM_CREATE
        lab1=createwindowex(0,"static","",WS_VISIBLE Or WS_CHILD Or WS_BORDER,10,10,250,40,hwnd,0,0,0) 
        lab2=createwindowex(0,"static","",WS_VISIBLE Or WS_CHILD Or WS_BORDER,10,50,250,40,hwnd,0,0,0) 
        lab3=createwindowex(0,"static","",WS_VISIBLE Or WS_CHILD Or WS_BORDER,10,90,250,40,hwnd,0,0,0)
        lab4=createwindowex(0,"static","",WS_VISIBLE Or WS_CHILD Or WS_BORDER,10,130,250,40,hwnd,0,0,0) 
        lab5=createwindowex(0,"static","Child window colours by: WM_CTLCOLORstatic",WS_VISIBLE Or WS_CHILD Or WS_BORDER,10,170,250,40,hwnd,0,0,0)
        SendMessage(lab1,WM_SETFONT,Cast(WPARAM,ThisFont),0) 
        SendMessage(lab2,WM_SETFONT,Cast(WPARAM,ThisFont),0)
        SendMessage(lab3,WM_SETFONT,Cast(WPARAM,ThisFont),0)
        SendMessage(lab4,WM_SETFONT,Cast(WPARAM,ThisFont),0)
        SendMessage(lab5,WM_SETFONT,Cast(WPARAM,ThisFont),0)
        
    Case WM_User + 997 
        x = wParam
        setwindowtext(lab1,"ulong passed x= "+Str(red(x))+","+Str(green(x))+","+Str(blue(x))+","+Str(alph(x)))
    Case WM_User + 998 
        y = wParam
        setwindowtext(lab2,"ulong passed y= "+Str(red(y))+","+Str(green(y))+","+Str(blue(y))+","+Str(alph(y))) 
    Case WM_User + 999
        z = wParam
        setwindowtext(lab3,"ulong passed z= "+Str(red(z))+","+Str(green(z))+","+Str(blue(z))+","+Str(alph(z))) 
    Case WM_User + 1000
        s =Cast(zstring Ptr, wParam)
        setwindowtext(lab4,"string passed = " + *s)
        
    Case WM_CTLCOLORstatic
        Static As Long flag
        Dim As Ulong c1
        
        dch =  Cast(HDC, wparam)
        
        BrushH =null
        
        If BrushH = null  Then
            flag+=1
            Select Case flag
            Case 1,6
                c1=bgr(200,0,0)
            Case 2,7
                c1=bgr(0,200,0)
            Case 3,8
                c1=bgr(0,0,200)
            Case 4,9
                c1=bgr(200,100,0)
            Case 5,10     '5 = number of child windows, but continue case 6,7,8,9, ... so not to miss any.
                c1=bgr(100,100,255)
            End Select
            
            SetBkMode(dcH, TRANSPARENT)
            SetTextColor(dch,bgr(255,255,255))
            BrushH =  Cast(HBRUSH, CreateSolidBrush(c1))
        End If
       
        Return  Cast(LRESULT,BrushH) 
       
    Case WM_PAINT 
        
        Dim As PAINTSTRUCT ps
        BeginPaint(hWnd, @ps)
        FillRect(ps.hdc, @ps.rcPaint, CreateSolidBrush(bgr(0,100,255)))
        EndPaint(hWnd, @ps)
       
    Case WM_DESTROY
        PostQuitMessage( 0 )
         deleteobject(brushh)
        Exit Function
    End Select
    
    
    Function = DefWindowProc( hWnd, wMsg, wParam, lParam )   
    deleteobject(brushh)
End Function


Function WinMain ( Byval hInstance As HINSTANCE, _
    Byval hPrevInstance As HINSTANCE, _
    Byval szCmdLine As Zstring Ptr, _
    Byval iCmdShow As Integer ) As Integer   
    
    Dim wMsg As MSG
    Dim wcls As WNDCLASS     
    Dim hWnd As HWND
    Function = 0
    
    With wcls
        .style         = CS_HREDRAW Or CS_VREDRAW
        .lpfnWndProc   = @WndProc
        .cbClsExtra    = 0
        .cbWndExtra    = 0
        .hInstance     = hInstance
        .hIcon         = LoadIcon( NULL, IDI_APPLICATION )
        .hCursor       = LoadCursor( NULL, IDC_ARROW )
        .hbrBackground = GetStockObject( WHITE_BRUSH )
        .lpszMenuName  = NULL
        .lpszClassName = @"HelloWin"
    End With
    
    If( RegisterClass( @wcls ) = False ) Then
        MessageBox( null, "Failed To register wcls", "Error", MB_ICONERROR )
        Exit Function
    End If
    
    hWnd = CreateWindowEx( 0, _
    @"HelloWin", _
    "Passing information from "+ __function__, _
    WS_OVERLAPPEDWINDOW, _
    300, _
    300, _
    800, _
    600, _
    NULL, _
    NULL, _
    hInstance, _
    NULL )
    
    Dim As Ulong x,y,z
    x=bgra(255,0,0,250)
    y=bgra(0,200,50,100)
    z=bgra(0,0,200,252)
    Dim As Integer s=Cast(Integer,Strptr(__function__))
    
    Print "In WinMain: ";"x = ";Str(red(x))+","+Str(green(x))+","+Str(blue(x))+","+Str(alph(x))
    Print "In WinMain: ";"y = ";Str(red(y))+","+Str(green(y))+","+Str(blue(y))+","+Str(alph(y))
    Print "In WinMain: ";"z = ";Str(red(z))+","+Str(green(z))+","+Str(blue(z))+","+Str(alph(z))
    
    
    PostMessage Hwnd, WM_USER + 997, x, 0
    PostMessage Hwnd, WM_USER + 998, y, 0
    PostMessage Hwnd, WM_USER + 999, z, 0
    PostMessage Hwnd, WM_USER + 1000, s, 0
    ShowWindow( hWnd, iCmdShow )
    UpdateWindow( hWnd )
    
    
    While( GetMessage( @wMsg, NULL, 0, 0 ) <> False )
        TranslateMessage( @wMsg )
        DispatchMessage( @wMsg )
    Wend
    
    Function = wMsg.wParam
    
    End Function