1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
|
{%MainUnit ../stdctrls.pp}
{
*****************************************************************************
This file is part of the Lazarus Component Library (LCL)
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
}
function TButtonControl.IsCheckedStored: boolean;
begin
Result := true;
//Result := (ActionLink = nil)
// or not TButtonActionLink(ActionLink).IsCheckedLinked;
end;
procedure TButtonControl.WMDefaultClicked(var Message: TLMessage);
begin
if not ((csClickEvents in ControlStyle) and (csClicked in ControlState)) then // prevent double click in case of csClickEvents, because clicks are send in MouseUp
Click;
end;
class procedure TButtonControl.WSRegisterClass;
begin
inherited WSRegisterClass;
RegisterButtonControl;
end;
function TButtonControl.GetActionLinkClass: TControlActionLinkClass;
begin
Result := TButtonActionLink;
end;
function TButtonControl.GetChecked: Boolean;
begin
Result := False;
end;
procedure TButtonControl.SetChecked(Value: Boolean);
begin
// this is done in the overriden methods
end;
procedure TButtonControl.DoOnChange;
begin
if [csLoading, csDestroying, csDesigning] * ComponentState <> [] then Exit;
EditingDone;
if Assigned(OnChange) then OnChange(Self);
end;
procedure TButtonControl.Click;
begin
DoOnChange;
inherited Click;
end;
constructor TButtonControl.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
ControlStyle := ControlStyle-csMultiClicks-[csAcceptsControls,csCaptureMouse];
AccessibleRole := larButton;
end;
{ TButtonActionLink }
procedure TButtonActionLink.AssignClient(AClient: TObject);
begin
inherited AssignClient(AClient);
FClientButton := AClient as TButtonControl;
end;
function TButtonActionLink.IsCheckedLinked: Boolean;
begin
Result:=inherited IsCheckedLinked
and ( (FClientButton.Checked = TCustomAction(Action).Checked)
or (TCustomAction(Action).Grayed) );
end;
procedure TButtonActionLink.SetChecked(Value: Boolean);
begin
if IsCheckedLinked then
begin
FClientButton.ClicksDisabled := True;
try
FClientButton.Checked := Value;
finally
FClientButton.ClicksDisabled := False;
end;
end;
end;
// included by stdctrls.pp
|
