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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
{%MainUnit ../controls.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.
*****************************************************************************
}
{ TControlActionLink }
procedure TControlActionLink.AssignClient(AClient: TObject);
begin
FClient := AClient as TControl;
end;
function TControlActionLink.DoShowHint(var HintStr: string): Boolean;
begin
Result := True;
if Action is TCustomAction then
begin
if TCustomAction(Action).DoHint(HintStr)
and Application.HintShortCuts
and (TCustomAction(Action).ShortCut <> scNone) then
begin
if HintStr <> '' then
HintStr := Format('%s (%s)', [HintStr,
ShortCutToText(TCustomAction(Action).ShortCut)]);
end;
end;
end;
function TControlActionLink.IsCaptionLinked: Boolean;
begin
Result := inherited IsCaptionLinked
and (FClient.Caption = (Action as TCustomAction).Caption);
end;
function TControlActionLink.IsEnabledLinked: Boolean;
begin
Result := inherited IsEnabledLinked
and (FClient.Enabled = (Action as TCustomAction).Enabled);
end;
function TControlActionLink.IsHintLinked: Boolean;
begin
Result := inherited IsHintLinked
and (FClient.Hint = (Action as TCustomAction).Hint);
end;
function TControlActionLink.IsVisibleLinked: Boolean;
begin
Result := inherited IsVisibleLinked
and (FClient.Visible = (Action as TCustomAction).Visible);
end;
function TControlActionLink.IsOnExecuteLinked: Boolean;
begin
Result := inherited IsOnExecuteLinked;
end;
procedure TControlActionLink.SetCaption(const Value: string);
begin
if IsCaptionLinked then FClient.Caption := Value;
end;
procedure TControlActionLink.SetEnabled(Value: Boolean);
begin
if IsEnabledLinked then FClient.Enabled := Value;
end;
procedure TControlActionLink.SetHint(const Value: string);
begin
if IsHintLinked then FClient.Hint := Value;
end;
procedure TControlActionLink.SetVisible(Value: Boolean);
begin
if IsVisibleLinked then FClient.Visible := Value;
end;
procedure TControlActionLink.SetOnExecute(Value: TNotifyEvent);
begin
// Note: formerly this changed FClient.OnClick, but that is unneeded, because
// TControl.Click executes Action
end;
function TControlActionLink.IsHelpLinked: Boolean;
begin
Result := (FClient.HelpContext = (Action as TCustomAction).HelpContext)
and (FClient.HelpKeyword = (Action as TCustomAction).HelpKeyword)
and (FClient.HelpType = (Action as TCustomAction).HelpType);
end;
procedure TControlActionLink.SetHelpKeyword(const Value: String);
begin
if IsHelpLinked then FClient.HelpKeyword := Value;
end;
procedure TControlActionLink.SetHelpContext(Value: THelpContext);
begin
if IsHelpLinked then FClient.HelpContext := Value;
end;
procedure TControlActionLink.SetHelpType(Value: THelpType);
begin
if IsHelpLinked then FClient.HelpType := Value;
end;
// included by controls.pp
|
