← Back to branch summary

~ubuntu-branches/ubuntu/feisty/fpc/feisty

« back to all changes in this revision

Viewing changes to fcl/classes/action.inc

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2007-01-27 20:08:50 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070127200850-9mrptaqqjsx9nwa7
Tags: 2.0.4-5
* Fixed Build-Depends.
* Add myself to Uploaders in debian/control.
* Make sure that the sources are really patched before building them.
* Build unit 'libc' on powerpc too.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fcl/classes/action.inc
1
 
{
2
 
    $Id: action.inc,v 1.2 2005/02/14 17:13:11 peter Exp $
3
 
    This file is part of the Free Component Library (FCL)
4
 
    Copyright (c) 1999-2000 by the Free Pascal development team
5
 
 
6
 
    See the file COPYING.FPC, included in this distribution,
7
 
    for details about the copyright.
8
 
 
9
 
    This program is distributed in the hope that it will be useful,
10
 
    but WITHOUT ANY WARRANTY; without even the implied warranty of
11
 
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12
 
 
13
 
 **********************************************************************}
14
 
 
15
 
{****************************************************************************}
16
 
{*                           TBasicActionLink                               *}
17
 
{****************************************************************************}
18
 
 
19
 
constructor TBasicActionLink.Create(AClient: TObject);
20
 
begin
21
 
  inherited Create;
22
 
  AssignClient(AClient);
23
 
end;
24
 
 
25
 
 
26
 
procedure TBasicActionLink.AssignClient(AClient: TObject);
27
 
begin
28
 
end;
29
 
 
30
 
 
31
 
destructor TBasicActionLink.Destroy;
32
 
begin
33
 
  if FAction <> nil then
34
 
    FAction.UnRegisterChanges(Self);
35
 
  inherited Destroy;
36
 
end;
37
 
 
38
 
 
39
 
procedure TBasicActionLink.Change;
40
 
begin
41
 
  if Assigned(OnChange) then
42
 
    OnChange(FAction);
43
 
end;
44
 
 
45
 
 
46
 
function TBasicActionLink.Execute(AComponent: TComponent): Boolean;
47
 
begin
48
 
  FAction.ActionComponent := AComponent;
49
 
  try
50
 
    Result := FAction.Execute;
51
 
  finally
52
 
    if FAction <> nil then
53
 
      FAction.ActionComponent := nil;
54
 
  end;
55
 
end;
56
 
 
57
 
 
58
 
procedure TBasicActionLink.SetAction(Value: TBasicAction);
59
 
begin
60
 
  if Value <> FAction then
61
 
  begin
62
 
    if FAction <> nil then FAction.UnRegisterChanges(Self);
63
 
    FAction := Value;
64
 
    if Value <> nil then Value.RegisterChanges(Self);
65
 
  end;
66
 
end;
67
 
 
68
 
 
69
 
function TBasicActionLink.IsOnExecuteLinked: Boolean;
70
 
begin
71
 
  Result := True;
72
 
end;
73
 
 
74
 
 
75
 
procedure TBasicActionLink.SetOnExecute(Value: TNotifyEvent);
76
 
begin
77
 
end;
78
 
 
79
 
 
80
 
function TBasicActionLink.Update: Boolean;
81
 
begin
82
 
  Result := FAction.Update;
83
 
end;
84
 
 
85
 
{****************************************************************************}
86
 
{*                             TBasicAction                                 *}
87
 
{****************************************************************************}
88
 
 
89
 
constructor TBasicAction.Create(AOwner: TComponent);
90
 
begin
91
 
  inherited Create(AOwner);
92
 
  FClients := TList.Create;
93
 
end;
94
 
 
95
 
 
96
 
destructor TBasicAction.Destroy;
97
 
begin
98
 
  inherited Destroy;
99
 
  while FClients.Count > 0 do
100
 
    UnRegisterChanges(TBasicActionLink(FClients.Last));
101
 
  FClients.Free;
102
 
end;
103
 
 
104
 
 
105
 
function TBasicAction.HandlesTarget(Target: TObject): Boolean;
106
 
begin
107
 
  Result := False;
108
 
end;
109
 
 
110
 
 
111
 
procedure TBasicAction.ExecuteTarget(Target: TObject);
112
 
begin
113
 
end;
114
 
 
115
 
 
116
 
procedure TBasicAction.UpdateTarget(Target: TObject);
117
 
begin
118
 
end;
119
 
 
120
 
 
121
 
function TBasicAction.Execute: Boolean;
122
 
begin
123
 
  if Assigned(FOnExecute) then
124
 
   begin
125
 
     FOnExecute(Self);
126
 
     Result := True;
127
 
   end
128
 
  else
129
 
   Result := False;
130
 
end;
131
 
 
132
 
 
133
 
function TBasicAction.Update: Boolean;
134
 
begin
135
 
  if Assigned(FOnUpdate) then
136
 
   begin
137
 
     FOnUpdate(Self);
138
 
     Result := True;
139
 
   end
140
 
  else
141
 
   Result := False;
142
 
end;
143
 
 
144
 
 
145
 
procedure TBasicAction.SetOnExecute(Value: TNotifyEvent);
146
 
var
147
 
  I: Integer;
148
 
begin
149
 
  if (TMethod(Value).Code <> TMethod(OnExecute).Code) or
150
 
     (TMethod(Value).Data <> TMethod(OnExecute).Data) then
151
 
  begin
152
 
    for I := 0 to FClients.Count - 1 do
153
 
      TBasicActionLink(FClients[I]).SetOnExecute(Value);
154
 
    FOnExecute := Value;
155
 
    Change;
156
 
  end;
157
 
end;
158
 
 
159
 
 
160
 
procedure TBasicAction.Change;
161
 
begin
162
 
  if Assigned(FOnChange) then
163
 
    FOnChange(Self);
164
 
end;
165
 
 
166
 
 
167
 
procedure TBasicAction.RegisterChanges(Value: TBasicActionLink);
168
 
begin
169
 
  Value.FAction := Self;
170
 
  FClients.Add(Value);
171
 
end;
172
 
 
173
 
 
174
 
procedure TBasicAction.UnRegisterChanges(Value: TBasicActionLink);
175
 
var
176
 
  I: Integer;
177
 
begin
178
 
  for I := 0 to FClients.Count - 1 do
179
 
    if TBasicActionLink(FClients[I]) = Value then
180
 
     begin
181
 
       Value.FAction := nil;
182
 
       FClients.Delete(I);
183
 
       break;
184
 
     end;
185
 
end;
186
 
 
187
 
 
188
 
{
189
 
  $Log: action.inc,v $
190
 
  Revision 1.2  2005/02/14 17:13:11  peter
191
 
    * truncate log
192
 
 
193
 
}