paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-16 05:00:46 +01:00
Code Issues Packages Projects Releases Wiki Activity

changed radiobutton style to BS_RADIOBUTTON to prevent test program from hanging.

Browse Source 
git-svn-id: trunk@5532 -
This commit is contained in:
vincents 2004-05-30 20:17:55 +00:00
parent caf487c9e8
commit 2d090ac2f7
3 changed files with 39 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lcl/controls.pp
View File

@ -1090,7 +1090,7 @@ type
end;
// Moved to LCLType ot avoid unit circles
// Moved to LCLType to avoid unit circles
// TCreateParams is part of the interface
TCreateParams = LCLType.TCreateParams;
@ -2289,6 +2289,9 @@ end.
{ =============================================================================
$Log$
Revision 1.206 2004/05/30 20:17:55 vincents
changed radiobutton style to BS_RADIOBUTTON to prevent test program from hanging.
Revision 1.205 2004/05/30 14:02:30 mattias
implemented OnChange for TRadioButton, TCheckBox, TToggleBox and some more docking stuff

27
lcl/interfaces/win32/win32callback.inc
View File

@ -274,6 +274,21 @@ Var
end;
end;
end;
procedure ClearSiblingRadioButtons(RadioButton: TRadioButton);
var
Parent: TWinControl;
Sibling: TControl;
i: Integer;
begin
Parent := RadioButton.Parent;
for i:= 0 to Parent.ControlCount - 1 do begin
Sibling := Parent.Controls[i];
if (Sibling is TRadioButton) and (Sibling<>RadioButton) and
(TRadioButton(Sibling).HandleAllocated) then
Windows.SendMessage(TRadioButton(Sibling).Handle, BM_SETCHECK, Windows.WParam(BST_UNCHECKED), 0);
end;
end;
Begin
Assert(False, 'Trace:WindowProc - Start');
@ -321,6 +336,12 @@ Begin
if Window = TWin32WidgetSet(InterfaceObject).AppHandle then
Windows.SetWindowPos(TWin32WidgetSet(InterfaceObject).AppHandle, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);
End;
BM_SETCHECK:
Begin
LMessage.Msg := LM_CHANGED;
if (WParam=BST_CHECKED) and (OwnerObject is TRadioButton) then
ClearSiblingRadioButtons(TRadioButton(OwnerObject));
End;
WM_CAPTURECHANGED:
Begin
LMessage.Msg := LM_CAPTURECHANGED;
@ -570,6 +591,9 @@ Begin
// CheckListBox functionality
if OwnerObject is TCheckListBox then
CheckListBoxLButtonDown;
// RadioButton functionality
if OwnerObject is TRadioButton then
Windows.SendMessage(Window, BM_SETCHECK, BST_CHECKED, 0);
End;
WM_LBUTTONUP:
Begin
@ -1161,6 +1185,9 @@ end;
{
$Log$
Revision 1.109 2004/05/30 20:17:55 vincents
changed radiobutton style to BS_RADIOBUTTON to prevent test program from hanging.
Revision 1.108 2004/05/29 11:45:19 micha
cleanup lcl<->win32 bounds code, remove duplicate code

28
lcl/interfaces/win32/win32object.inc
View File

@ -2132,7 +2132,9 @@ Begin
Begin
pClassName := 'BUTTON';
WindowTitle := StrCaption;
Flags := Flags Or BS_AUTORADIOBUTTON;
// BS_AUTORADIOBUTTON may hang the application,
// if the radiobuttons are not consecutive controls.
Flags := Flags Or BS_RADIOBUTTON;
End;
csScrollBar:
Begin
@ -2615,20 +2617,6 @@ Var
Handle: HWnd;
ST: SystemTime;
procedure ClearSiblingRadioButtons(RadioButton: TRadioButton);
var
Parent: TWinControl;
Sibling: TControl;
i: Integer;
begin
Parent := RadioButton.Parent;
for i:= 0 to Parent.ControlCount - 1 do begin
Sibling := Parent.Controls[i];
if (Sibling is TRadioButton) and (Sibling<>RadioButton) then
Windows.SendMessage(TRadioButton(Sibling).Handle, BM_SETCHECK, Windows.WParam(BST_UNCHECKED), 0);
end;
end;
Begin
Result := 0; // default if nobody sets it
@ -2663,11 +2651,8 @@ Begin
End;
csRadioButton, csCheckbox:
Begin
If TCheckBoxState(Data^) = cbChecked Then Begin
Windows.SendMessage(Handle, BM_SETCHECK, Windows.WParam(BST_CHECKED), 0);
If TControl(Sender).FCompStyle=csRadioButton Then
ClearSiblingRadioButtons(TRadioButton(Sender));
End
If TCheckBoxState(Data^) = cbChecked Then
Windows.SendMessage(Handle, BM_SETCHECK, Windows.WParam(BST_CHECKED), 0)
Else If TCheckboxState(Data^) = cbUnchecked Then
Windows.SendMessage(Handle, BM_SETCHECK, Windows.WParam(BST_UNCHECKED), 0)
Else
@ -3014,6 +2999,9 @@ End;
{
$Log$
Revision 1.200 2004/05/30 20:17:55 vincents
changed radiobutton style to BS_RADIOBUTTON to prevent test program from hanging.
Revision 1.199 2004/05/27 15:04:53 vincents
checking a radiobutton unchecks its siblibg radiobuttons