How to change the back color of a control at runtime ?

New to FreeBASIC? Post your questions here.
kcvinu
Posts: 232
Joined: Oct 07, 2015 16:44
Location: Keralam, India

How to change the back color of a control at runtime ?

Post by kcvinu »

Hi all,
I am practicing some win api gui related code. So far so good. I have a made my gui code worked but i dont know how to change the back color of the control in my gui. Somebody please guide me to achieve this. I had tried a little but those are failed. this is what i tried.

Code: Select all

dcH = GetDC(Btn1.Handle)
				SetBkMode(dcH, TRANSPARENT)
				SetBkColor(dcH, Rgb(40,50,200))
I have call ReleaseDC at the end of my program. Anyhow, this code didnt worked. I have used this code in an WM_LBUTTONDOWN message.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: How to change the back color of a control at runtime ?

Post by dodicat »

Here are some win api stunts.
To change the colour during run time i had to cheat by calling movewindow (to get into WM_PAINT)
I am sure Winapi experts will have a better method.

Code: Select all

#define WIN_INCLUDEALL
#Include Once "windows.bi"
#Include once "/win/commctrl.bi"

'for blue frame on message
Declare Function SetWindowTheme Lib "UxTheme.dll" Alias "SetWindowTheme"(As Any Ptr,As zstring Ptr,As zstring Ptr) As Long 

Declare Sub CreateMessageWindow 'a seperate little window

' Globals (unavoidable)
Dim Shared As HFONT guiFont
Dim Shared As zString * 255 textMessage="Slide the trackbars"
Dim Shared As Long flag
Dim Shared As HWND  MainWindow, MessageWindow
Dim Shared As HWND EditBox, Button,msgon,bar,label,bar2,label2,bar3,label3
Dim Shared As Long trackposX,trackposY,trackposZ


Function WndProc(hWnd As HWND, msg As UINT, wParam As WPARAM, lParam As LPARAM) As LRESULT
    
    static as ubyte rd,gr,bl 'the colours
    Select Case hWnd
    Case MainWindow  
        Select Case msg
        
        
        Case  WM_HSCROLL'''TRACKBARS
            Select Case lparam
                Case bar'red
                
                Dim As rect r
                getwindowrect(Mainwindow,@r)'
                trackposX= SendMessage(bar, TBM_GETPOS, 0, 0)
                setwindowtext(label,"Red = "+Str(trackposX+0))
                rd=trackposX
                movewindow(mainWindow,r.left,r.top,800+(rnd-rnd),600,1) 'ACTIVATE WM_PAINT
                
                Case bar2 'green
               
                Dim As rect r
                getwindowrect(Mainwindow,@r)'
                trackposY= SendMessage(bar2, TBM_GETPOS, 0, 0)
                setwindowtext(label2,"Green = "+Str(trackposY+0))
                gr=trackposy
                movewindow(mainWindow,r.left,r.top,800+(rnd-rnd),600,1)'ACTIVATE WM_PAINT
                
                Case bar3 'blue
               
                Dim As rect r
                getwindowrect(Mainwindow,@r)'
                trackposZ= SendMessage(bar3, TBM_GETPOS, 0, 0)
                setwindowtext(label3,"Blue = "+Str(trackposZ+0))
                bl=trackposZ
                movewindow(mainWindow,r.left,r.top,800+(rnd-rnd),600,1)'ACTIVATE WM_PAINT
            End Select
            
        Case WM_PAINT 
            Dim As PAINTSTRUCT ps
            BeginPaint(hWnd, @ps)
            FillRect(ps.hdc, @ps.rcPaint, CreateSolidBrush(BGR(rd, gr, bl)))
            EndPaint(hWnd, @ps)
            
        Case WM_CLOSE
            PostQuitMessage(NULL) 
            
        Case WM_COMMAND
            Select Case lParam  
            Case msgon 
                CreateMessageWindow 
            End Select
        Case Else
            
            
        End Select
        
    Case MessageWindow  
        
        Select Case msg
        
        Case WM_COMMAND
            
            Select Case lParam  
            Case editbox
               
            Case Button  
                
                GetWindowText(EditBox, @textMessage, 255)
                flag=0
                destroywindow(messagewindow)
            End Select
            
        Case WM_CLOSE
            flag=0
        End Select
        
    End Select
    
    Return DefWindowProc(hWnd, msg, wParam, lParam)
End Function

Sub CreateMessageWindow 'new message box
    If flag=0 Then
        flag=1
        MessageWindow = CreateWindowEx(NULL, "WindowClass", "Messages", WS_OVERLAPPEDWINDOW Or WS_VISIBLE,0,0, 300, 150, NULL, NULL, NULL, NULL)
        EditBox = CreateWindowEx(WS_EX_CLIENTEDGE, "Edit", textmessage, WS_VISIBLE Or WS_CHILD Or WS_HSCROLL  Or ES_AUTOHSCROLL Or ES_MULTILINE, 10, 0, 250, 50, MessageWindow, NULL, NULL, NULL)
        Button = CreateWindowEx(NULL, "Button", "OK", WS_VISIBLE Or WS_CHILD, 10, 70, 200, 24, MessageWindow, NULL, NULL, NULL)
        SetWindowTheme(messagewindow," "," ")'  optional
    End If 
End Sub

Function CreateToolTip(X As hwnd,msg As String="") As hwnd
    Dim As hwnd  TT= CreateWindowEx(0,"ToolTips_Class32","",64,0,0,0,0,X,0,GetModuleHandle(0),0)
                                                           '64=bubble,0 = rectangle
    SendMessage(TT, TTM_SETMAXTIPWIDTH, 0 , 180) 
    SendMessage(TT, TTM_SETDELAYTIME, TTDT_INITIAL ,40) 
    SendMessage(TT, TTM_SETDELAYTIME, TTDT_RESHOW  ,60)
    Dim bubble As TOOLINFO 
    bubble.cbSize = Len(TOOLINFO) 
    bubble.uFlags = TTF_IDISHWND Or TTF_SUBCLASS 
    bubble.uId = Cast(Uinteger,X) 
    bubble.lpszText = Strptr(msg)
    SendMessage(TT, TTM_ADDTOOL, 0,Cast(LPARAM,@bubble))
    Return TT
End Function

'MAIN
' Create  window class:
Dim As WNDCLASS wcls

With wcls
    .style      = CS_HREDRAW Or CS_VREDRAW
    .lpfnWndProc  = Cast(WNDPROC, @WndProc)
    .hInstance    = GetModuleHandle(NULL)
    .hIcon      = LoadIcon(NULL, IDI_APPLICATION)
    .hCursor      = LoadCursor(NULL, IDC_ARROW)
    .hbrBackground  = GetStockObject(WHITE_BRUSH)
    .lpszMenuName  = NULL
    .lpszClassName  = Strptr("WindowClass")
End With

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

'mainwindow, and message button
MainWindow = CreateWindowEx(NULL, "WindowClass", "MainWindow", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, 100, 100, 800, 600, NULL, NULL, NULL, NULL)
msgon= CreateWindowEx(NULL, "Button", "Messages", WS_VISIBLE Or WS_CHILD , 10, 40, 90, 24, MainWindow, NULL, NULL, NULL)
'TRACKBARs and labels above them
bar= CreateWindowEx(NULL,TRACKBAR_CLASS, "Trackbar Control", WS_VISIBLE Or WS_CHILD Or  TBS_AUTOTICKS Or TBS_ENABLESELRANGE, 100, 150, 200, 40, mainwindow,NULL, NULL, NULL)
bar2= CreateWindowEx(NULL,TRACKBAR_CLASS, "Trackbar Control", WS_VISIBLE Or WS_CHILD Or  TBS_AUTOTICKS Or TBS_ENABLESELRANGE, 100, 250, 200, 40, mainwindow,NULL, NULL, NULL)
bar3=CreateWindowEx(NULL,TRACKBAR_CLASS, "Trackbar Control", WS_VISIBLE Or WS_CHILD Or  TBS_AUTOTICKS Or TBS_ENABLESELRANGE, 100, 350, 200, 40, mainwindow,NULL, NULL, NULL)
label= CreateWindowEx(NULL,"static", "", WS_VISIBLE Or WS_CHILD , 100, 100, 200, 30, mainwindow,NULL, NULL, NULL)
label2= CreateWindowEx(NULL,"static", "", WS_VISIBLE Or WS_CHILD , 100, 200, 200, 30, mainwindow,NULL, NULL, NULL)
label3= CreateWindowEx(NULL,"static", "", WS_VISIBLE Or WS_CHILD , 100, 300, 200, 30, mainwindow,NULL, NULL, NULL)

SendMessage(bar, TBM_SETRANGE,TRUE, MAKELONG(0,255))'TRACKBAR 1
SendMessage(bar2, TBM_SETRANGE,TRUE, MAKELONG(0,255))'TRACKBAR 2
SendMessage(bar3, TBM_SETRANGE,TRUE, MAKELONG(0,255))'TRACKBAR 2


'set up four  tooltips
'on all trackbars and message box 
CreateToolTip(bar,"Red scaler")
CreateToolTip(bar2,"Green scaler")
CreateToolTip(bar3,"Blue scaler")
CreateToolTip(msgon,"instructions")

SetWindowTheme(mainwindow," "," ")'  optional

Dim As MSG uMsg
While GetMessage(@uMsg, NULL, NULL, NULL) <> FALSE
    TranslateMessage(@uMsg)
    DispatchMessage(@uMsg)
Wend

 
   
PaulSquires
Posts: 999
Joined: Jul 14, 2005 23:41

Re: How to change the back color of a control at runtime ?

Post by PaulSquires »

Depends on what type of control you are trying to change color for. Some can change foreground and background, others just the background, while others you can not change at all (unless it is ownerdraw or customdraw). There is not a one solution that fits all cases.
jj2007
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: How to change the back color of a control at runtime ?

Post by jj2007 »

In your WndProc, add a handler for the WM_CTLCOLORxxx message (pseudo code, but tested and it works):

Code: Select all

  Switch uMsg
  Case WM_CREATE
  	SetBkMode(wParam, TRANSPARENT) ' the dc is in wParam
  	hBrush=CreateSolidBrush, RgbCol(255, 255, 0)
  Case WM_CTLCOLOREDIT
  	return hBrush
@dodicat: Can't make your code work. Which commandline did you use?
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: How to change the back color of a control at runtime ?

Post by dodicat »

Hi jj2007
freebasic 1.05
Win 10
No particular command line switches.
fbc thiscode.bas (which is -gen gas by default)
(I use fbide)

Please note I didn't use Case WM_CREATE.
I set up all the bits and pieces before the message loop.
As you mentioned a few days ago, it is not strictly procedure, but it works anyway.
jj2007
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: How to change the back color of a control at runtime ?

Post by jj2007 »

dodicat wrote: (I use fbide)
That could be the cause: The string in wcls is Unicode, but the compiler uses RegisterClassA and CreateWindowExA.
kcvinu
Posts: 232
Joined: Oct 07, 2015 16:44
Location: Keralam, India

Re: How to change the back color of a control at runtime ?

Post by kcvinu »

@dodicat,
Thanks a lot. Let me try your code.

@jj2007,
Thanks for the reply.
But my gui setup is quite different.
I have made an include file which consists few types for window and controls.
this is my window type

Code: Select all

Type Window Extends Control       
    
    lnWinExStyles As Long
    hChildWinHwnd As HWND
	_CallBackStatus As Boolean = False
    Declare Constructor() 
    Declare Destructor()
    Declare Property Handle() As HWND
    Declare Property Parent(hParentWindow As HWND) 
    Declare Property ChildHandles(Byval iIndex As Integer) As HWND
	Declare Property CallBackFunc( FuncPtr As Any Ptr) ' This Property determines the CallBack Function. 
    Declare Function CreateForm ( ) As HWND  
                
    Declare Sub MainLoop(WinHwnd As HWND = NULL)  
    Declare Sub ShowApp(Byval wHandle As HWND = GlobalWinHwnd, Byval iState As Integer = SW_SHOWDEFAULT)  
      
    Private :
    sample As Integer
    cl_hInstance As HINSTANCE        
    Declare Function RegWindow(hInst As HINSTANCE, Byval sClsName As CWSTR) As ATOM
    hMainWinHandle As Hwnd   
End Type
And this is my WndProc

Code: Select all

Function MyWndProc( ByVal hWnd As HWND, _
                   ByVal message As UINT, _
                   ByVal wParam As WPARAM, _
                   ByVal lParam As LPARAM ) As LRESULT
	If message = WM_DESTROY Then
		If hWnd = ListChildWindows(0) Then
			PostQuitMessage(0)
			Exit Function
		End If
	End If
	
	 
	cb_Message = message
	cb_WinHwnd = hWnd 
    	cb_Wparam = wParam
    	cb_Lparam = lParam
    
	If message = WM_COMMAND Then
         cb_CntlHwnd = WMC_ControlHandle(lParam) 
         cb_ControlID = WMC_ControlID(wParam)
         cb_NotifCode = WMC_NotifyCode(wParam)
    End If
    If message = WM_NOTIFY Then
        WM_NOTIFY_Details(lParam, cb_CntlHwnd, cb_ControlID, cb_NotifCode)
    End If
	
	ByPassProc()	' This is users wndproc
	Function =  DefWindowProc( hWnd, message, wParam, lParam )
End Function
And user can set his callback function like this

Code: Select all

With tApp
	.Caption = "My New Window"
	.Width = 900
	.Height = 600
	.CallBackFunc = @MyCallBack	 
End With
tApp.CreateForm( )
And call back function looks like this

Code: Select all

Sub MyCallBack()	 
	 
    Select Case cb_Message
		Case WM_CREATE				
			? "Created"			
			
		Case WM_LBUTTONDOWN
			 ? "clicked" 
			 			 
		Case WM_COMMAND
            		Select Case cb_NotifCode
				Case BN_CLICKED
					If cb_CntlHwnd = Btn1.Handle Then 
						tv.InsertChildItem("A child", 0, 2)						
						Dim cItem1 As HTREEITEM = tv.InsertChild("Child 1", hItem1)
						tv.InsertChild("Child 2", hItem1)
						tv.InsertChild("Grand child", cItem1)
					Elseif cb_CntlHwnd = Btn2.Handle Then
						? "Click from Button 2"						 
					End if               
                		Case STN_CLICKED                     
                			 ? "You click on label"
                	End Select			 
			 
		Case WM_SIZE
			If  cb_WinHwnd = tApp.Handle Then ? "Window Sized"	       
         
		Case WM_CLOSE'			
	End Select
End Sub
How can i use your idea in this setup ?
jj2007
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: How to change the back color of a control at runtime ?

Post by jj2007 »

kcvinu wrote:How can i use your idea in this setup ?
No idea. I might get an idea, though, if you post complete working code where I could insert the missing bits. As it is now, your code is spread all over the place, and I won't have the time to put the pieces together. And btw, there is no need for a separate callback function. WndProc is the callback function.
kcvinu
Posts: 232
Joined: Oct 07, 2015 16:44
Location: Keralam, India

Re: How to change the back color of a control at runtime ?

Post by kcvinu »

@jj2007,
I intentionally separated wndproc in bi file. Once i saw these method in ThinBasic forum and i liked it. User dont need to use wParam or lParam. Instead, they have some global variables like cbWParam, cblParam, cbWinHandle, cbControlHandle etc. I like the simplicity. So when they need to encounter WM_NOTIFY, they dont need to use NMHDR structure. Anyways, i tried your idea on my WndProc function in *.bi file. But it does nothing.
Note: - I like your masmBasic. Want to learn it but i am having hard time running masmBasic file on my pc because i have UAsm64 in my pc. I just posted the details on your forum. I hope you will give a reply on there. Thanks.
jj2007
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: How to change the back color of a control at runtime ?

Post by jj2007 »

kcvinu wrote:@jj2007,
I intentionally separated wndproc in bi file. Once i saw these method in ThinBasic forum and i liked it. User dont need to use wParam or lParam. Instead, they have some global variables like cbWParam, cblParam, cbWinHandle, cbControlHandle etc. I like the simplicity. So when they need to encounter WM_NOTIFY, they dont need to use NMHDR structure. Anyways, i tried your idea on my WndProc function in *.bi file. But it does nothing.
Note that the WM_CTLCOLOR??? messages depend on the type of control you are using. You may have picked one for the wrong control type. If you put a MsgBox into the WndProc WM_CREATE handler, do you see the message? Just to check whether your WndProc is being used at all, your setup is very exotic ;-)
I hope you will give a reply on there.
It's here, together with minimalistic code showing how to change the background colour of an edit control
kcvinu
Posts: 232
Joined: Oct 07, 2015 16:44
Location: Keralam, India

Re: How to change the back color of a control at runtime ?

Post by kcvinu »

Hi jj2007,
Thanks for the reply. I am on a little vacation now. Thats why i delayed to put a reply here. Can i give you my bi file and a sample bas file to run in your Pc ? Then you can easily run it and check my wndproc is working or not.

I have tested on WM_CTLCOLORXXXX for a button and static. I think the DefWndProc function is overwriting my color changes. After all it is dealing with control colors, right ? This is my code sample

Code: Select all

Case WM_CTLCOLORSTATIC
	dcH =  Cast(HDC, cb_Wparam)
	SetBkMode(dcH, TRANSPARENT)
	SetTextColor(dcH, Rgb(100,50,75))
	SetBkColor(dcH, Rgb(150,50,70))
	 
	If BrushH = NULL Then
		BrushH =  Cast(HBRUSH, CreateSolidBrush(Rgb(150,50,70)))
		? "testing"
	End If
	Return  Cast(LRESULT , @BrushH)
				
Case WM_DESTROY
	DeleteObject( BrushH)
I saw your reply in masmBasic forum, will put a reply soon.
jj2007
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: How to change the back color of a control at runtime ?

Post by jj2007 »

kcvinu wrote:I think the DefWndProc function is overwriting my color changes.
In a normal setup, "return" means that the DefWndProc function will not be called. You don't have a normal setup, though. Post complete code, in one peace, and I may be willing to test it.
kcvinu
Posts: 232
Joined: Oct 07, 2015 16:44
Location: Keralam, India

Re: How to change the back color of a control at runtime ?

Post by kcvinu »

Hi jj2007,
I will post the code sample soon. Thanks.
Last edited by kcvinu on Apr 15, 2018 21:04, edited 1 time in total.
kcvinu
Posts: 232
Joined: Oct 07, 2015 16:44
Location: Keralam, India

Re: How to change the back color of a control at runtime ?

Post by kcvinu »

Hi jj2007,
As you suggest, here is the one piece code of my gui project. I have changed some code and remove all include files except "windows.bi" which is inevitable. Now you can copy paste and run this code. This code is working and please note the code in WM_CTLCOLORSTATIC. That part is not working.

Code: Select all

#Include once "windows.bi"


Const Btn_Style As Integer  = WS_TABSTOP Or WS_VISIBLE Or WS_CHILD
Const Tb_Style As Integer  = WS_TABSTOP Or WS_VISIBLE Or WS_CHILD  Or ES_LEFT Or ES_WANTRETURN Or ES_AUTOHSCROLL
Const Lbl_Style As Integer = WS_CHILD Or WS_VISIBLE Or SS_NOTIFY

Const Btn_ExStyle As Integer = 0
Const Tb_ExStyle As Integer = WS_EX_CLIENTEDGE
Const Lbl_ExStyle As Integer = 0

Dim Shared cb_WinHwnd As Hwnd
Dim Shared cb_Message As UINT
Dim Shared cb_Lparam As LPARAM
Dim Shared cb_Wparam As WPARAM
Dim Shared cb_CntlHwnd As HWND
Dim Shared cb_ControlID As Long
Dim Shared cb_NotifCode As UINT


Dim Shared  ByPassProc As Function() As LRESULT

Declare function clWndProc(   ByVal hWnd As HWND, _
                                    ByVal message As UINT, _
                                    ByVal wParam As WPARAM, _
                                    ByVal lParam As LPARAM ) As LRESULT
Declare Function CreateGlobalHFONT(Byval FontName As String = "Tahoma", _
							Byval iSize As Integer = 12, _
							Byval iWeight As Integer = 400, _
							Byval bItalics As BOOL = False, _
							Byval bUnderLine As BOOL = False) As HFONT
	                                    
 
 
                                    
Function  WMC_NotifyCode(Byval wParam As WPARAM) As Long
	Function = Hiword(wParam)
End Function

Function  WMC_ControlID(Byval wParam As WPARAM) As Long
	Function = Loword(wParam)
End Function

Function  WMC_ControlHandle(Byval lParam As LPARAM) As HWND
	Function = Cast(HWND, lparam)
End Function

' This one is extract info from WM_NOTIFY
Sub WM_NOTIFY_Details(Byval lParam As LPARAM, Byref cntlhw As HWND, Byref cntlId As Long, Byref cb_NotifCode As Uint)  
    Dim pnmh As NMHDR Ptr
    pnmh = Cast(NMHDR Ptr, LParam)
    cntlhW = pnmh->hWndFrom
    cntlId = pnmh->idFrom
    cb_NotifCode = pnmh->code
    
End Sub

'==============================================================================================================
Type Control Extends Object
	_cntrlHWND As HWND     
    _Width As Integer
    _Height As Integer
    _Xpos As Integer
    _Ypos As Integer
    _wStyle As Integer
    _wExStyle As Integer    
	_Caption As String
	_ControlID As Integer
	 
	Declare Constructor
	Declare Property Width() As Integer
    Declare Property Width(W As Integer) 
    Declare Property Height() As Integer
    Declare Property Height(H As Integer) 
    Declare Property Xpos() As Integer
    Declare Property Xpos(X As Integer)
    Declare Property Ypos(Y As Integer)  
    Declare Property Ypos() As Integer
    Declare Property Caption() As String
    Declare Property Caption(sText As String)
    Declare Property ControlID(iControlID As Integer)
    Declare Property ControlID() As Integer
	Declare Property wStyle(StyleVal As Integer) 
	Declare Property wExStyle(ExStyleVal As Integer)
	Declare Property Handle() As Hwnd
End Type

Constructor Control()   
    
    _cntrlHWND = NULL 
    _Caption = ""     
    _Width = 100 
    _Height = 50
    _Xpos = 10
    _Ypos = 10
    _wStyle = 0
    _wExStyle  = 0
    _ControlID = 0    
End Constructor


Property Control.Caption(sText As String)
	This._Caption = sText
End Property
Property Control.Caption( ) As String
	Return This._Caption 
End Property
Property Control.Xpos(X As Integer)
	This._Xpos = X	 
End Property
Property Control.Xpos() As Integer
	Return This._Xpos 
End Property
Property Control.Ypos(Y As Integer)
	This._Ypos = Y	 
End Property
Property Control.Ypos() As Integer
	Return This._Ypos 
End Property

Property Control.Width(W As Integer)
	This._Width = W	 
End Property
Property Control.Width()As Integer
	Return This._Width
End Property
Property Control.Height(H As Integer)
	This._Height = H	 
End Property
Property Control.Height( ) As Integer
	Return This._Height	 
End Property
Property Control.wStyle(StyleVal As Integer)
	this._wStyle = This._wStyle Or StyleVal
End Property
Property Control.wExStyle(ExStyleVal As Integer)
	this._wExStyle = _wExStyle Or ExStyleVal
End Property

Property Control.ControlID(iControlID As Integer)
	_ControlID = iControlID
End Property
Property Control.ControlID() As Integer
	Return _ControlID
End Property

'==============================================================================================================

Type AppClass Extends Control
	
	_Caption As String
    _Width As Integer
    _Height As Integer
    _Xpos As Integer
    _Ypos As Integer
    _wStyle As Integer
    _wExStyle As Integer	     
	_hMainWinHwnd As HWND
	_CallBackStatus As Boolean = False
    Declare Constructor() 
    
    Declare Property Handle() As HWND     
	Declare Property CallBackFunc( FuncPtr As Any Ptr)
    Declare Function CreateForm ( ) As HWND  
                                                                         
    Declare Sub MainLoop(WinHwnd As HWND = NULL)  
    Declare Sub ShowApp(Byval wHandle As HWND = Null, Byval iState As Integer = SW_SHOWDEFAULT)  
  
    Private :
    cl_hInstance As HINSTANCE        
    Declare Function RegWindow(hInst As HINSTANCE, Byval sClsName As String) As ATOM
    hMainWinHandle As Hwnd   
End Type

'================================================================================================

Constructor AppClass() 
    cl_hInstance = GetModuleHandle(NULL)
    _Caption = "New Window"
    _Width = 700
    _Height = 500
    _Xpos = 200
    _Ypos = 150
    _wStyle = WS_OVERLAPPEDWINDOW Or WS_TABSTOP
    _wExStyle = WS_EX_WINDOWEDGE     
    
End Constructor
 
Private Function AppClass.RegWindow(hInst As HINSTANCE, Byval sClsName As String) As ATOM
    Dim wclsx As WNDCLASSEX
	Dim ResAtom As ATOM
     
    With wclsx
		.cbSize		   = Sizeof(wclsx)
        .style         = CS_DBLCLKS Or CS_HREDRAW Or CS_VREDRAW Or CS_PARENTDC
        .lpfnWndProc   = @clWndProc
		.cbClsExtra    = 0
		.cbWndExtra    = 0
        .hInstance     = hInst 
        .hIcon         = LoadIcon( NULL, IDI_APPLICATION )
        .hCursor       = LoadCursor( NULL, IDC_ARROW )
        .hbrBackground = Cast (HBRUSH, COLOR_WINDOW ) 
        .lpszMenuName  = NULL
        .lpszClassName = Strptr(sClsName)
		.hIconSm	   = LoadIcon( NULL, IDI_APPLICATION )
    End With	
    
	ResAtom = RegisterClassEx( @wclsx )		 
	Function = ResAtom 
	
End Function
'================================================================================================

Function clWndProc( ByVal hWnd As HWND, _
                   ByVal message As UINT, _
                   ByVal wParam As WPARAM, _
                   ByVal lParam As LPARAM ) As LRESULT	
	 
	cb_Message = message
	cb_WinHwnd = hWnd 
    cb_Wparam = wParam
    cb_Lparam = lParam
	
	Select Case message
		
		Case WM_DESTROY  
			 
			PostQuitMessage(0)
			Exit Function
			 
		Case WM_COMMAND
         cb_CntlHwnd = WMC_ControlHandle(lParam) 
         cb_ControlID = WMC_ControlID(wParam)
         cb_NotifCode = WMC_NotifyCode(wParam)
    
		Case WM_NOTIFY  
			WM_NOTIFY_Details(lParam, cb_CntlHwnd, cb_ControlID, cb_NotifCode)	
	End Select
	
	Dim Lrs As LRESULT = ByPassProc()
	If Lrs <> 0 Then 
		Function = Lrs
		? "lrs = ", lrs
		Exit Function
	Else
		Return DefWindowProc( hWnd, message, wParam, lParam )
	End If
End Function
 

Function AppClass.CreateForm() As HWND  				
	
	If _CallBackStatus = False Then 
		Function = NULL
		Exit Function
	End If
    Dim cAtom As Atom 
	 
	Dim  csClsName As String = "MyWinClass"
    cAtom  = RegWindow(This.cl_hInstance, csClsName )
	
	Dim TempWinHandle As HWND = NULL	 
	
    TempWinHandle = CreateWindowEx(_wExStyle, _
                            Strptr(csClsName), _
                           _Caption, _
                           _wStyle, _
                           _Xpos, _
                           _Ypos, _
                           _Width, _
                           _Height, _
                           NULL, _
                           NULL, _
                            This.cl_hInstance, _
                           NULL ) 
   
	 
	This._hMainWinHwnd = TempWinHandle		
    Function =   TempWinHandle

End Function
Property AppClass.Handle() as HWND
	Property = This._hMainWinHwnd
End Property
 

Sub AppClass.ShowApp(Byval wHandle As HWND, Byval iState As Integer = SW_SHOWDEFAULT)
	ShowWindow(wHandle, iState)
	UpdateWindow( wHandle)
End Sub
 
Sub  AppClass.MainLoop(WinHwnd As HWND = Null)  
	DIM uMsg AS MSG 
    
	While GetMessageW(@uMsg, WinHwnd, 0, 0)      
		TranslateMessage @uMsg		 
		DispatchMessageW @uMsg 
		If uMsg.message = 161 and uMsg.wParam = 20 Then
			Exit While		 
		End If 		
	Wend    
End Sub

Property AppClass.CallBackFunc( FuncPtr As Any Ptr)
	BypassProc = FuncPtr
	_CallBackStatus = TRUE
End Property

 

'==============================================================================================================
Type Button Extends Control   
    
    Declare Constructor()
    c_BtnHandle As HWND
    
    Declare Property Handle() As Hwnd
    Declare Function CreateButton(Byval hParent As HWND) As Hwnd
End Type

Constructor Button()
 	_Caption = "New Button"
	_Width = 100
	_Height = 50
	_Xpos = 10
	_Ypos = 10
	_wStyle = Btn_Style
	_wExStyle = Btn_ExStyle
	 
End Constructor


Function Button.CreateButton(Byval hParent As HWND ) As HWND   	 
	 
	 This.c_BtnHandle = CreateWindowEx(_wExStyle, "Button", _Caption, _wStyle, _Xpos,  _Ypos , _Width, _Height, hParent, _
										Cast(HMENU, _ControlID), _
										Cast(HINSTANCE, GetWindowLong(hParent, GWL_HINSTANCE)), 0 )	 
	 
	Function = This.c_BtnHandle
End Function
Property Button.Handle() As Hwnd
    Property = This.c_BtnHandle
End Property
'

'//================================================================================================TEXT BOX======================
Type TextBox Extends Control
     
    c_TbHandle As HWND    
    Declare Constructor()	 
    Declare Property Handle() As Hwnd
	 
	 
    Declare Function CreateTextBox(Byval hParent As HWND ) As HWND    
    
End Type

Constructor TextBox()     
    c_TbHandle = NULL
	_Caption = "New TextBox"
	_Width = 100
	_Height = 30
	_Xpos = 10
	_Ypos = 10
	_wStyle = Tb_Style
	_wExStyle = Tb_ExStyle		
End Constructor


Function TextBox.CreateTextBox(Byval hParent As HWND )	As HWND
	
	c_TbHandle = CreateWindowEx(_wExStyle, "Edit", _Caption, _wStyle, _Xpos,  _Ypos , _Width, _Height, hParent, _
										Cast(HMENU, _ControlID), _
										Cast(HINSTANCE, GetWindowLong(hParent, GWL_HINSTANCE)), 0 )	  
	Function = c_TbHandle
End Function

Property TextBox.Handle() As Hwnd
    Property = This.c_TbHandle
End Property
'

'\\============================================================================================LABEL============================
Type Label Extends Control
     
    c_LBLHandle As HWND 
    Declare Constructor()
    
    Declare Property Handle() As Hwnd
    Declare Function CreateLabel(Byval hParent As HWND ) As HWND   
    
End Type

Constructor Label()      
    c_LBLHandle = NULL
    _Caption = "New Label"
	_Width = 100
	_Height = 40
	_Xpos = 10
	_Ypos = 10
	_wStyle = Lbl_Style
	_wExStyle = Lbl_ExStyle	 
End Constructor


Function Label.CreateLabel(Byval hParent As HWND ) As HWND	 
	 
	c_LBLHandle = CreateWindowEx(_wExStyle, "Static", _Caption, _wStyle, _Xpos,  _Ypos , _Width, _Height, hParent, _
										Cast(HMENU, _ControlID), _
										Cast(HINSTANCE, GetWindowLong(hParent, GWL_HINSTANCE)), 0 )    
	Function = c_LBLHandle
End Function

Property Label.Handle() As Hwnd
    Property = This.c_LBLHandle
End Property
'
'/////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'==============================================================================================================



Declare Function MyCallBack() As LRESULT
 
Dim Shared Btn1 As Button
Dim Shared Lbl1  As Label
Dim Shared TB1 As TextBox

 
Dim Shared Form1 As AppClass
Dim Shared FrmHwnd As HWND 

With Form1
	.Caption = "My New Window"
	.Width = 900
	.Height = 600
	.CallBackFunc = @MyCallBack
	 
End With

Form1.CreateForm( )
FrmHwnd = Form1.Handle


With Btn1
	.Xpos = 40
	.Ypos = 50
	.Caption = "A Button"
	.Width = 120
	.Height = 50
	.ControlID = 1001	  
End With
 

With Lbl1 
	.Width = 300
	.Height = 20
	.Ypos = 70
	.Xpos = 300
	.Caption = "I want to cahnge back color of this label."	 
End With

With TB1
	.Caption = "A Text Box"
	.Xpos = 50
	.Ypos = 300
	.Width = 180
End With

Lbl1.CreateLabel(FrmHwnd)
Btn1.CreateButton(FrmHwnd)
TB1.CreateTextBox(FrmHwnd)

 
Form1.ShowApp(FrmHwnd )


Dim Shared dcH As HDC 
 
Static Shared BrushH As HBRUSH 

Function MyCallBack() As LRESULT	 
	
    Select Case cb_Message
		Case WM_NCCREATE
			? "nc create"
		Case WM_CREATE
			? "created"
		Case WM_LBUTTONDOWN
			If cb_WinHwnd = Form1.Handle Then				
				? "clicked on form1"				
			End If
			
		Case WM_COMMAND
            
			Select Case cb_NotifCode
				Case BN_CLICKED
					If cb_CntlHwnd = Btn1.Handle Then 						 
						? "from Btn 1"										
					End if                  
                              
			End Select
			 
		Case WM_SIZE
			If  cb_WinHwnd = Form1.Handle Then ? "Window Sized"			
			 
        Case WM_INITDIALOG
        
		Case WM_CLOSE
		
		Case WM_PAINT
			 
		
		Case WM_CTLCOLORSTATIC			
			 
			dcH =  Cast(HDC, cb_Wparam)
			SetBkMode(dcH, TRANSPARENT)
			SetTextColor(dcH, Rgb(100,50,75))
			
			SetBkColor(dcH, Rgb(150,50,70))
			 
			If BrushH = NULL Then
				BrushH =  Cast(HBRUSH, CreateSolidBrush(Rgb(150,50,70)))
				? "color change testing"
			End If
			Return  Cast(LRESULT , @BrushH)
				
		Case WM_DESTROY
			DeleteObject( BrushH)
			
	End Select
	
	Function = 0	
	
End Function

Form1.MainLoop() 

 


 
Josep Roca
Posts: 564
Joined: Sep 27, 2016 18:20
Location: Valencia, Spain

Re: How to change the back color of a control at runtime ?

Post by Josep Roca »

Change your code to:

Code: Select all

      Case WM_CTLCOLORSTATIC         
         
         dcH =  Cast(HDC, cb_Wparam)
         SetBkMode(dcH, TRANSPARENT)
         SetTextColor(dcH, BGR(100,50,75))
         
         SetBkColor(dcH, BGR(150,50,70))
         
         If BrushH = NULL Then
            BrushH =  Cast(HBRUSH, CreateSolidBrush(BGR(150,50,70)))
            ? "color change testing"
         End If
         Return  Cast(LRESULT , BrushH)
Two mistakes:

1. You're using RGB instead of BGR.

2. You're returning the address of the brush handle instead of the brush handle.
Post Reply