[fpc-pascal] Changing the background of a radiobutton inside a groupbox
Felipe Monteiro de Carvalho
felipemonteiro.carvalho at gmail.com
Wed Feb 13 18:53:01 CET 2008
Hello,
I am having problems on a pure Win32 API test software (the real
problem is something I'm tracking on the lazarus wince interface).
I am trying to change the background color of a radiobutton inside a
groupbox. If the radiobutton is put directly on the form, my code,
which handles the WM_CTLCOLORSTATIC message, works perfectly and the
radiobutton has it's background color changed acording to what I set.
Now, if I set the parent of the radiobutton to a groupbox, then it no
longer works. I searched everywhere, for hours, read tons of microsoft
docs, and I have found nothing that explains it =/
Any ideas? Thank you very much, there is my test program:
program winapitest;
{$ifdef fpc}{$mode delphi}{$endif}
uses
Strings, Windows;
const
AppClass: PWideChar = 'WinHello';
BtnClass: PWideChar = 'BUTTON';
WindowTitle: PWideChar = 'Test Program';
ControlTitle: PWideChar = 'A Control';
var
AMessage: Msg;
hWindow, hGroupBox, hRadioButton, hRadioButton2: HWnd;
{ WindowProc }
function WindowProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
LParam: Windows.LParam): LResult; stdcall;
begin
case Msg of
WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC:
begin
if (LParam = hRadioButton) or (LParam = hRadioButton2) then
begin
SetBkColor(WParam, $FF);
Result := GetStockObject(BLACK_BRUSH);
Exit;
end;
end;
WM_CLOSE:
begin
PostQuitMessage(0);
Result:=0;
Exit;
end;
end;
Result := DefWindowProc(Window, Msg, WParam, LParam);
end;
{ Register the Window Class }
function WinRegister: Boolean;
var
WindowClass: TWndClassW;
begin
WindowClass.Style := cs_hRedraw or cs_vRedraw;
WindowClass.lpfnWndProc := WndProc(@WindowProc);
WindowClass.cbClsExtra := 0;
WindowClass.cbWndExtra := 0;
WindowClass.hInstance := system.MainInstance;
WindowClass.hIcon := LoadIcon(0, idi_Application);
WindowClass.hCursor := LoadCursor(0, idc_Arrow);
WindowClass.hbrBackground := GetStockObject(WHITE_BRUSH);
WindowClass.lpszMenuName := nil;
WindowClass.lpszClassName := AppClass;
Result := RegisterClassW(WindowClass) <> 0;
end;
{ Create the Window Class }
function WinCreate: HWnd;
begin
Result := CreateWindowW(AppClass, WindowTitle,
ws_OverlappedWindow or WS_VISIBLE,
CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT,
0, 0, system.MainInstance, nil);
// ShowWindow(Result, SW_SHOW);
// UpdateWindow(Result);
end;
function CreateGroupBox(AParent: HWnd; X, Y, CX, CY: Integer): HWnd;
begin
Result := CreateWindowW(BtnClass, ControlTitle,
WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN or
BS_GROUPBOX or WS_VISIBLE,
X, Y, CX, CY,
AParent, 0, system.MainInstance, nil);
end;
function CreateRadioButton(AParent: HWnd; X, Y, CX, CY: Integer): HWnd;
begin
Result := CreateWindowW(BtnClass, ControlTitle,
WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN or
BS_AUTORADIOBUTTON or WS_VISIBLE,
X, Y, CX, CY,
AParent, 0, system.MainInstance, nil);
end;
{ Entry-point }
begin
if not WinRegister then
begin
MessageBox(0, 'Register failed', nil, mb_Ok);
Exit;
end;
hWindow := WinCreate;
if longint(hWindow) = 0 then
begin
MessageBox(0, 'WinCreate failed', nil, mb_Ok);
Exit;
end;
hGroupBox := CreateGroupBox(hWindow, 25, 25, 200, 200);
hRadioButton := CreateRadioButton(hGroupBox, 25, 25, 150, 25);
hRadioButton2 := CreateRadioButton(hWindow, 0, 0, 150, 25);
{ Message loop }
while GetMessage(@AMessage, 0, 0, 0) do
begin
TranslateMessage(AMessage);
DispatchMessage(AMessage);
end;
Halt(AMessage.wParam);
end.
More information about the fpc-pascal
mailing list