• Welcome to PlanetSquires Forums.
 

CWindow label text color

Started by James Fuller, June 10, 2016, 11:19:21 AM

Previous topic - Next topic

James Fuller

Jose,
  How does one set the text and background color of a label?
This started out as your popup example but I got stuck on the main window trying to set the text color of the label.

James


'=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
#define unicode
#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "Afx/CWindow.inc"
Using Afx.CWindowClass


Const IDC_INFO = 1001
Const IDC_START = 1002
Const IDC_CLOSE = 1003
'==============================================================================
#define CBCTLMSG HIWORD(wParam)
#define CBCTL LOWORD(wParam)
#define CBHNDL hWnd
#define CBHWND hWnd
#define CBLPARAM lParam
#define CBWPARAM wParam
#define CTLHNDL(id) GetDlgItem(hWnd,id)
'==============================================================================
Dim Shared ReUsableBrush AS HBRUSH
'==============================================================================
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, COMMAND(), SW_NORMAL)

Declare Function WndProc (Byval hWnd AS HWND, Byval uMsg AS UINT, Byval wParam AS WPARAM, Byval lParam AS LPARAM) AS LRESULT
Declare Function PopupWindow (Byval hParent AS HWND) AS LONG
Declare Function PopupWndProc (Byval hWnd AS HWND, Byval uMsg AS UINT, Byval wParam AS WPARAM, Byval lParam AS LPARAM) AS LRESULT
Declare Sub HSpaceControls (hDlg As HWND,pba() As Long,NumOfCtls As Long)
Declare Sub HCenterCtrlOnDlg(hWndCtrl As HWND,hDlg As HWND)
Declare Function RectWidth(tRect As RECT) As Long
Declare Function RectHeight(tRect As RECT) As Long
Declare Function SetColor ( Byval TxtColr As COLORREF, Byval BkColr As COLORREF, Byval hdc As HDC ) AS HBRUSH
' ========================================================================================
' Main
' ========================================================================================
Function WinMain (Byval hInstance AS HINSTANCE, _
                  Byval hPrevInstance AS HINSTANCE, _
                  Byval szCmdLine AS ZSTRING PTR, _
                  Byval nCmdShow AS LONG) AS LONG
    Dim As HWND hInfo                 
    Dim ButtonId(0 To 1) As Long  => {IDC_START,IDC_CLOSE}
   
    ' // Set process DPI aware
    AfxSetProcessDPIAware
   
    DIM pWindow AS CWindow
    pWindow.Create(NULL, "CWindow with a popup window", @WndProc)
    pWindow.SetClientSize(500, 320)
    pWindow.Center

    ' // Add a button without position or size (it will be resized in the WM_SIZE message).
    hInfo = pWindow.AddControl("Label", ,IDC_INFO,"This is a test",10,10,300,100,WS_CHILD OR WS_BORDER OR SS_CENTER OR WS_VISIBLE,WS_EX_DLGMODALFRAME)
    pWindow.AddControl("Button", , IDC_START, "&Start", 0, 250, 80, 30)
    pWindow.AddControl("Button", , IDC_CLOSE, "&Dismiss",0, 250, 80, 30)
    HCenterCtrlOnDlg(hInfo,pWindow.hWindow)   
    HSpaceControls(pWindow.hWindow,ButtonId(),2)
   
    Function = pWindow.DoEvents(nCmdShow)

End Function
' ========================================================================================
' Window procedure
' ========================================================================================
Function WndProc (Byval hWnd AS HWND, Byval uMsg AS UINT, Byval wParam AS WPARAM, Byval lParam AS LPARAM) AS LRESULT

    DIM hDC AS HDC
    DIM pPaint AS PAINTSTRUCT
    DIM rc AS RECT
    DIM pWindow AS CWindow PTR
   
    Select Case uMsg
   
        Case WM_CREATE
            Exit Function
   
        Case WM_COMMAND
            If CBCTLMSG = BN_CLICKED Then
                Select Case CBCTL
                    Case IDC_START
                        PopupWindow(hwnd)
                        Exit Function
                    Case IDC_CLOSE
                        PostMessage hwnd, WM_CLOSE, 0, 0
                        Exit Function
                End Select               
            EndIf
           
        Case WM_CTLCOLORSTATIC
            If CTLHNDL(IDC_INFO) = CAST(HWND,lParam) Then
                Function = CAST(LRESULT,SetColor(RGB(0,0,255),RGB(230,230,230),CAST(HDC,wParam)))
            EndIf
   
        Case WM_DESTROY
            PostQuitMessage(0)
            Exit Function
    End Select
   
    Function = DefWindowProcW(hWnd, uMsg, wParam, lParam)

End Function
' ========================================================================================

' ========================================================================================
' Popup window procedure
' ========================================================================================
Function PopupWindow (Byval hParent AS HWND) AS LONG

    DIM pWindow AS CWindow
    pWindow.Create(hParent, "Popup window", @PopupWndProc, , , , , _
      WS_VISIBLE OR WS_CAPTION OR WS_POPUPWINDOW OR WS_THICKFRAME, WS_EX_WINDOWEDGE)
    pWindow.Brush = GetStockObject(WHITE_BRUSH)
    pWindow.SetClientSize(300, 200)
    pWindow.Center(pWindow.hWindow, hParent)
    ' / Process Windows messages
    Function = pWindow.DoEvents
End Function
' ========================================================================================

' ========================================================================================
' Popup window procedure
' ========================================================================================
Function PopupWndProc (Byval hWnd AS HWND, Byval uMsg AS UINT, Byval wParam AS WPARAM, Byval lParam AS LPARAM) AS LRESULT

    Dim hOldFont AS HFONT
    Static hNewFont AS HFONT
   
    Select Case uMsg
        Case WM_CREATE
            ' // Get a pointer to the CWindow class from the CREATESTRUCT structure
            Dim pCreateStruct AS CREATESTRUCT Ptr = CAST(CREATESTRUCT Ptr, lParam)
            Dim pWindow AS CWindow Ptr = CAST(CWindow Ptr, pCreateStruct->lpCreateParams)
            ' // Create a new font scaled according the DPI ratio
            If pWindow->DPI <> 96 Then
                hNewFont = pWindow->CreateFont("Tahoma", 9)
            EndIf
            ' Disable parent window to make popup window modal
            EnableWindow GetParent(hwnd), FALSE
            Exit Function
    Case WM_COMMAND
        Select Case LOWORD(wParam)
            ' // If ESC key pressed, close the application sending an WM_CLOSE message
            Case IDCANCEL
                If HIWORD(wParam) = BN_CLICKED Then
                    SendMessage hwnd, WM_CLOSE, 0, 0
                    Exit Function
                End If
        End Select
   
    Case WM_PAINT
        Dim rc As RECT, ps As PAINTSTRUCT, hDC As HANDLE
        hDC = BeginPaint(hWnd, @ps)
        If hNewFont Then
             hOldFont = CAST(HFONT, SelectObject(hDC, CAST(HGDIOBJ, hNewFont)))
        EndIf
        GetClientRect(hWnd, @rc)
        DrawTextW(hDC, "Hello, World!", -1, @rc, DT_SINGLELINE or DT_CENTER or DT_VCENTER)
        If hNewFont Then
            SelectObject(hDC, CAST(HGDIOBJ, CAST(HFONT, hOldFont)))
        EndIf
        EndPaint(hWnd, @ps)
        Exit Function
   
    Case WM_CLOSE
        ' // Enables parent window keeping parent's zorder
        EnableWindow GetParent(hwnd), CTRUE
        ' // Don't exit; let DefWindowProcW perform the default action
   
    Case WM_DESTROY
        ' // Destroy the new font
        IF hNewFont Then
             DeleteObject(CAST(HGDIOBJ, hNewFont))
        EndIf
        ' // End the application by sending an WM_QUIT message
        PostQuitMessage(0)
        Exit Function
    End Select
   
    Function = DefWindowProcW(hWnd, uMsg, wParam, lParam)

End Function
' ========================================================================================
Sub HSpaceControls (hDlg As HWND,pba() As Long,NumOfCtls As Long)
    Dim As Long InterSpace,Start,x,DlgWidth,CtlWidth,CtlHeight
    Dim As RECT r
    GetClientRect(hDlg,@r)
    DlgWidth = r.right - r.left
    GetWindowRect(GetDlgItem(hDlg,pba(0)),@r)
    MapWindowPoints(0,hDlg,CAST(LPPOINT,@r),2)
    CtlWidth = r.right - r.left
    CtlHeight = r.bottom - r.top
    InterSpace = (DlgWidth -(NumOfCtls * CtlWidth)) / (NumOfCtls+1)
    Start=InterSpace
    For x = 0 To NumOfCtls-1
        GetWindowRect(GetDlgItem(hDlg,pba(0)),@r)
        MapWindowPoints(0,hDlg,CAST(LPPOINT,@r),2)
        MoveWindow(GetDlgItem(hDlg,pba(x)),Start,r.top,CtlWidth,CtlHeight,1)
        Start = Start + InterSpace + CtlWidth   
    Next x
End Sub
'==============================================================================
Sub HCenterCtrlOnDlg(hWndCtrl As HWND,hDlg As HWND)
    Dim As RECT CtrlRect,DlgRect
    GetClientRect(hDlg,@DlgRect)
    GetWindowRect(hWndCtrl,@CtrlRect)
    MapWindowPoints(0, hDlg, CAST(LPPOINT,@CtrlRect), 2)
    MoveWindow(hWndCtrl, _
             (RectWidth(DlgRect)-RectWidth(CtrlRect))/2, _
             CtrlRect.top, _
             RectWidth(CtrlRect), _
             RectHeight(CtrlRect), _
             1)
End Sub
'==============================================================================
Function RectWidth(tRect As RECT) As Long
    Function = tRect.right - tRect.left
End Function
'==============================================================================
Function RectHeight(tRect As RECT) As Long
    Function = tRect.bottom - tRect.top
End Function
'==============================================================================
FUNCTION SetColor ( Byval TxtColr As COLORREF, Byval BkColr As COLORREF, Byval hdc As HDC ) AS HBRUSH
    'Dim As COLORREF rv
    DeleteObject(ReUsableBrush)
    ReUsableBrush = CreateSolidBrush( BkColr )
    SetTextColor( hdc, TxtColr )
    SetBkColor( hdc, BkColr )
    Function  = ReUsableBrush
END FUNCTION



José Roca

Cange your code to


        Case WM_CTLCOLORSTATIC
            If CTLHNDL(IDC_INFO) = CAST(HWND,lParam) Then
                Function = CAST(LRESULT,SetColor(BGR(0,0,255),BGR(230,230,230),CAST(HDC,wParam)))
                EXIT FUNCTION
            EndIf


You must use BGR. It was named with this most confusing name because RGB was already a reserved word for their graphic window.

You also must to exit the function when processing the WM_CTLCOLORSTATIC message or it  will not return the new brush but the result of the call to DefWindowProcW.

James Fuller

Jose,
  Thank you that works fine but this didn't

Dim As HBRUSH hbgBrush = CreateSolidBrush(BGR(230,230,230))
......

DIM pWindow AS CWindow

pWindow.Create(NULL, "CWindow with a popup window", @WndProc)
pWindow.Brush(hbgBrush)

and get

error 98: No matching overloaded function, BRUSH() in 'pWindow.Brush(hbgBrush)'

James

José Roca

#3
In CWindow, Brush is a property, not a method.

Use:


Dim As HBRUSH hbgBrush = CreateSolidBrush(BGR(230,230,230))
pWindow.Brush = hbgBrush