[fpc-pascal] Changing the background of a radiobutton inside a groupbox

[Felipe Monteiro de Carvalho]

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.
_______________________________________________
fpc-pascal maillist  -  fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal