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

New to FreeBASIC? Post your questions here.
jj2007
Posts: 375
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 21:46

OK, I managed to put all this stuff together, see here for the files. The result is not convincing. See incClass.bi, lines 530ff - that's where the messages belong, not in your extra cb, and they get called there, but the colours don't work. Reason is that the Rgb function does not return Red, Green, Blue, as a BASIC coder might be tempted to believe.

To see the colours working properly, replace in the lines 530ff part as follows:
hBrushStatic = CreateSolidBrush(&h00FF00) 'Rgb(0,255,0) = green
BrushH = CreateSolidBrush(&h00FFFF) 'Rgb(255,255,0) = yellow

On further investigation, it turns out that e.g. Rgb(255,255,0), i.e. yellow, returns &hFF00FFFF. Setting the alpha channel to ff won't work with a Windows DC; the correct result should be &h0000FFFF.
Josep Roca
Posts: 244
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 22:06

RGB Computes a valid color value for hi/truecolor modes.

Note for Windows API programmers: The macro named RGB in the Windows references has been renamed BGR in the FB headers for Windows to avoid collisions.

So you have to use BGR instead of RGB. See my previous post.
jj2007
Posts: 375
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 23:06

Josep Roca wrote:RGB Computes a valid color value for hi/truecolor modes.
Searching for truecolor mode msdn gives indeed plenty of results.

Note for Windows API programmers: The macro named RGB in the Windows references has been renamed BGR in the FB headers for Windows to avoid collisions.
So logically BrushH = CreateSolidBrush(BGR(255, 0, 0)) yields a blue brush, right?
Josep Roca
Posts: 244
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 23:11

> So logically BrushH = CreateSolidBrush(Bgr(255, 0, 0)) yields a blue brush, right?

No. A red brush! To reverse the letters just to avoid a conflict was not certainly a wise choice.
jj2007
Posts: 375
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 23:14

Josep, you are very polite, as always ;-)
dodicat
Posts: 4766
Joined: Jan 10, 2006 20:30
Location: Scotland

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

Postby dodicat » Apr 16, 2018 11:04

If BGR is not very intuitive for RGB, what about BGRA?
This is a total bamboozler.
Of course anybody of sound mind wouldn't expect to get an alpha channel out of the api without going through a pain of headaches.
And WM_CTLCOLORbtn doesn't follow the same laws WM_CTLCOLORstatic. (tried it and deleted the effort)
Line 35 for BGRA

Code: Select all

 
#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

declare function main as long
end main
' Globals (unavoidable)

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_CTLCOLORstatic
          var dcH =  Cast(HDC, Wparam)
         SetBkMode(dcH, TRANSPARENT)
         SetTextColor(dcH, BGR(100,250,75))
            Static  BrushH As HBRUSH
         If BrushH = NULL Then
            BrushH =  Cast(HBRUSH, CreateSolidBrush(BGRA(0,100,255,0)))'<--------
         End If
         Return  Cast(LRESULT,BrushH)
       
         
        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
            'not decided
        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

function CreateTrackBar(dest as hwnd,x as long,y as long,lngth as long,height as long,range as long) as hwnd
dim as hwnd h=CreateWindowEx(NULL,TRACKBAR_CLASS, "Trackbar Control", WS_VISIBLE Or WS_CHILD Or  TBS_AUTOTICKS Or TBS_ENABLESELRANGE,x,y,lngth,height,dest,NULL, NULL, NULL)
SendMessage(h, TBM_SETRANGE,TRUE, MAKELONG(0,range))
return h
end function

function MAIN as long
' Create  window class:
Dim As WNDCLASS wcls
function=0
With wcls
    .style      = CS_HREDRAW Or CS_VREDRAW
    .lpfnWndProc  = @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)
'three labels
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)
'set up three trackbars
bar =CreateTrackBar(mainwindow,100, 150, 200, 40,255)
bar2=CreateTrackBar(mainwindow,100, 250, 200, 40,255)
bar3=CreateTrackBar(mainwindow,100, 350, 200, 40,255)

'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
end function

 
     
Josep Roca
Posts: 244
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 16, 2018 11:25

> And WM_CTLCOLORbtn doesn't follow the same laws WM_CTLCOLORstatic. (tried it and deleted the effort)

The WM_CTLCOLORBTN message is sent to the parent window of a button before drawing the button. The parent window can change the button's text and background colors. However, only owner-drawn buttons respond to the parent window processing this message.
kcvinu
Posts: 127
Joined: Oct 07, 2015 16:44
Location: Keralam, India

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

Postby kcvinu » Apr 16, 2018 14:20

@Josep Roca,
Thanks a lot. You saved me. My mistake. I didnt noticed that Rgb is not a function.
Now, it worked for Static controls.
kcvinu
Posts: 127
Joined: Oct 07, 2015 16:44
Location: Keralam, India

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

Postby kcvinu » Apr 16, 2018 15:00

@Josep Roca,
Then how did visual studio change button colors when we set the back color property ?. They have few button styles included OWNERDRAW style. And we dont need to use OWNERDRAW to change the button back color. How did they do it ?
Josep Roca
Posts: 244
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 16, 2018 15:23

I'm not a Visual Studio user.
kcvinu
Posts: 127
Joined: Oct 07, 2015 16:44
Location: Keralam, India

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

Postby kcvinu » Apr 16, 2018 15:40

@Josep Roca,
Ok, but i hope, there is a way to do it without using OWNERDRAW style. If that's the only way to color a button, then if we change back color property of a button (in runtime too), visual studio didnt change our button style to owner draw. In fact, owner draw buttons need more coding than ordinary buttons. So this is my logic. By the way, does your CWindow buttons using OWNERDRAW style to change back color ?
Josep Roca
Posts: 244
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 16, 2018 15:46

They create an ownedraw button. The rest is up to you.

This example creates an owner draw button and draws it when processing the WM_DRAWITEM message:

Code: Select all

' ########################################################################################
' Microsoft Windows
' File: CW_COMMCTRL_ButtonOwnerdraw.fbtpl
' Contents: Demonstrates the use of an ownerdraw button.
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2016 José Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

#define UNICODE
#INCLUDE ONCE "Afx/CWindow.inc"
USING Afx

CONST IDC_BUTTON = 1001

DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                          BYVAL hPrevInstance AS HINSTANCE, _
                          BYVAL szCmdLine AS ZSTRING PTR, _
                          BYVAL nCmdShow AS LONG) AS LONG

   END WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)

' // Forward declaration
DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                  BYVAL hPrevInstance AS HINSTANCE, _
                  BYVAL szCmdLine AS ZSTRING PTR, _
                  BYVAL nCmdShow AS LONG) AS LONG

   ' // Set process DPI aware
   AfxSetProcessDPIAware

   ' // Create the main window
   DIM pWindow AS CWindow
   pWindow.Create(NULL, "CWindow with ownerdraw button", @WndProc)
   pWindow.Center

   ' // Add and ownerdraw button
   DIM hButton AS HWND = pWindow.AddControl("CUSTOMBUTTON", , IDC_BUTTON, "&Ownerdraw button", 100, 50, 150, 23)
'  Alternate way:
'   DIM hButton AS HWND = pWindow.AddControl("Button", , IDC_BUTTON, "&Ownerdraw button", 100, 50, 150, 23, BS_OWNERDRAW)
   SetFocus hButton

   ' // Dispatch Windows messages
   FUNCTION = pWindow.DoEvents(nCmdShow)

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main window callback procedure
' ========================================================================================
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_COMMAND
         SELECT CASE GET_WM_COMMAND_ID(wParam, lParam)
            ' // If ESC key pressed, close the application sending an WM_CLOSE message
            CASE IDCANCEL
               IF GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE WM_DRAWITEM
         DIM pDis AS DRAWITEMSTRUCT PTR = CAST(DRAWITEMSTRUCT PTR, lParam)
         IF pDis->CtlId <> IDC_BUTTON THEN EXIT FUNCTION
         ' // Get the rectangle that defines the boundaries of the button to be drawn.
         DIM rc AS RECT = pDis->rcItem
         ' // Create a new font
         DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
         DIM hNewFont AS HGDIOBJ = pWindow->CreateFont(IIF(AfxWindowsVersion >= 600, "Segoe UI", "Tahoma"), _
             IIF(AfxWindowsVersion >= 600, 9, 8), FW_NORMAL, FALSE, FALSE, FALSE, DEFAULT_CHARSET)
         ' // Select the font in the button's device context
         DIM hOldFont AS HGDIOBJ = SelectObject(pDis->hDC, hNewFont)
         ' // Draw the button
         IF (pDis->itemState AND ODS_FOCUS) THEN
            DIM hPen AS HPEN = SelectObject(pDis->hDC, CreatePen(PS_SOLID, 3, BGR(255,0,0)))
            DIM hBrush AS HBRUSH = SelectObject(pDis->hDC, GetSysColorBrush(COLOR_BTNFACE))
            Rectangle pDis->hDC, rc.Left, rc.Top, rc.Right, rc.Bottom
            SelectObject pDis->hDC, hBrush
            DeleteObject SelectObject(pDis->hDC, hPen)
         ELSE
            FillRect pDis->hDC, @rc, GetSysColorBrush(COLOR_BTNFACE)
         END IF
         ' // Draw the button's edge
         rc.Left += 3: rc.Top += 3 : rc.Bottom -= 3: rc.Right -= 3
         IF (pDis->itemState AND ODS_SELECTED) THEN
            DrawEdge pDis->hDC, @rc, BDR_SUNKEN, BF_RECT OR BF_MIDDLE OR BF_SOFT
            rc.Left += 2 : rc.Top += 2
         ELSE
            DrawEdge pDis->hDC, @rc, BDR_RAISED, BF_RECT OR BF_MIDDLE OR BF_SOFT
         END IF
         ' // Draw the button's caption
         SetBkMode pDis->hDC, TRANSPARENT
         SetTextColor pDis->hDC, IIF((pDis->itemState AND ODS_DISABLED), GetSysColor(COLOR_GRAYTEXT), GetSysColor(COLOR_BTNTEXT))
         DIM wszText AS WSTRING * 260
         GetWindowTextW(pDis->hWndItem, wszText, SIZEOF(wszText))
         DrawTextW pDis->hDC, wszText, -1, @rc, DT_CENTER OR DT_VCENTER ' or DT_SINGLELINE
         SelectObject pDis->hDC, hOldFont
         DeleteObject(hNewFont)
         FUNCTION = CTRUE
         EXIT FUNCTION

       CASE WM_DESTROY
         ' // Quit the application
         PostQuitMessage(0)
         EXIT FUNCTION

   END SELECT

   ' // Default processing of Windows messages
   FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================

Return to “Beginners”

Who is online

Users browsing this forum: No registered users and 3 guests