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
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.
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
In CWindow, Brush is a property, not a method.
Use:
Dim As HBRUSH hbgBrush = CreateSolidBrush(BGR(230,230,230))
pWindow.Brush = hbgBrush