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

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

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

Postby kcvinu » Apr 10, 2018 21:03

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: 4883
Joined: Jan 10, 2006 20:30
Location: Scotland

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

Postby dodicat » Apr 10, 2018 22:41

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: 640
Joined: Jul 14, 2005 23:41
Contact:

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

Postby PaulSquires » Apr 10, 2018 23:25

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: 472
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

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

Postby jj2007 » Apr 11, 2018 3:16

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: 4883
Joined: Jan 10, 2006 20:30
Location: Scotland

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

Postby dodicat » Apr 11, 2018 9:28

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: 472
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

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

Postby jj2007 » Apr 11, 2018 11:32

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: 134
Joined: Oct 07, 2015 16:44
Location: Keralam, India

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

Postby kcvinu » Apr 11, 2018 12:31

@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: 472
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

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

Postby jj2007 » Apr 11, 2018 12:42

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: 134
Joined: Oct 07, 2015 16:44
Location: Keralam, India

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

Postby kcvinu » Apr 11, 2018 14:31

@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: 472
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

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

Postby jj2007 » Apr 11, 2018 16:03

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: 134
Joined: Oct 07, 2015 16:44
Location: Keralam, India

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

Postby kcvinu » Apr 15, 2018 16:03

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: 472
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

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

Postby jj2007 » Apr 15, 2018 16:10

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: 134
Joined: Oct 07, 2015 16:44
Location: Keralam, India

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

Postby kcvinu » Apr 15, 2018 17:44

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: 134
Joined: Oct 07, 2015 16:44
Location: Keralam, India

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

Postby kcvinu » Apr 15, 2018 20:59

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: 293
Joined: Sep 27, 2016 18:20
Location: Valencia, Spain

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

Postby Josep Roca » Apr 15, 2018 21:17

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.

Return to “Beginners”

Who is online

Users browsing this forum: No registered users and 2 guests