source: cprs/branches/HealthSevak-CPRS/VA/VAClasses.pas@ 1689

Last change on this file since 1689 was 829, checked in by Kevin Toppenberg, 14 years ago

Upgrade to version 27

File size: 7.0 KB
Line 
1unit VAClasses;
2
3interface
4
5uses
6 Windows, Controls, Classes, SysUtils, Types, RTLConsts;
7
8type
9 TVABaseMethodList = class(TObject)
10 strict private
11 FCode: TList;
12 FData: TList;
13 strict protected
14 function GetMethod(index: integer): TMethod;
15 property Code: TList read FCode;
16 property Data: TList read FData;
17 protected
18 constructor Create; virtual;
19 function IndexOf(const Method: TMethod): integer;
20 procedure Add(const Method: TMethod);
21 procedure Clear;
22 function Count: integer;
23 procedure Delete(index: integer);
24 procedure Remove(const Method: TMethod);
25 property Methods[index: integer]: TMethod read GetMethod; default;
26 public
27 destructor Destroy; override;
28 end;
29
30 TVAMethodList = class(TVABaseMethodList)
31 public
32 constructor Create; override;
33 destructor Destroy; override;
34 function IndexOf(const Method: TMethod): integer;
35 procedure Add(const Method: TMethod);
36 procedure Clear;
37 function Count: integer;
38 procedure Delete(index: integer);
39 procedure Remove(const Method: TMethod);
40 property Methods;
41 end;
42
43
44 TVALinkedMethodList = class(TVABaseMethodList)
45 private
46 FLinkedObjects: TList;
47 public
48 constructor Create; override;
49 destructor Destroy; override;
50 procedure Add(Obj: TObject; const Method: TMethod);
51 function IndexOf(const obj: TObject): integer;
52 procedure Clear;
53 function Count: integer;
54 procedure Delete(index: integer);
55 procedure Remove(const obj: TObject); overload;
56 function GetMethod(Obj: TObject): TMethod;
57// property Methods;
58 end;
59
60 // event fires before the component has acted on the notification
61 TVANotifyEvent = procedure(AComponent: TComponent; Operation: TOperation) of object;
62
63 TVANotificationEventComponent = class(TComponent)
64 private
65 FOnNotifyEvent: TVANotifyEvent;
66 protected
67 procedure Notification(AComponent: TComponent; Operation: TOperation); override;
68 public
69 constructor NotifyCreate(AOwner: TComponent; AOnNotifyEvent: TVANotifyEvent); virtual;
70 property OnNotifyEvent: TVANotifyEvent read FOnNotifyEvent write FOnNotifyEvent;
71 end;
72
73 TVAListChangeEvent = procedure(Sender: TObject; Item: Pointer; Operation: TOperation) of object;
74
75 TVAList = class(TList)
76 private
77 FOnChange: TVAListChangeEvent;
78 protected
79 procedure Notify(Ptr: Pointer; Action: TListNotification); override;
80 published
81 property OnChange: TVAListChangeEvent read FOnChange write FOnChange;
82 end;
83
84const
85 DynaPropAccesibilityCaption = 1;
86
87type
88 IVADynamicProperty = interface(IInterface)
89 ['{1D1620E9-59D1-475D-94E9-FAE89A601D55}']
90 function SupportsDynamicProperty(PropertyID: integer): boolean;
91 function GetDynamicProperty(PropertyID: integer): string;
92 end;
93
94implementation
95
96{ TVABaseMethodList }
97
98procedure TVABaseMethodList.Add(const Method: TMethod);
99begin
100 if IndexOf(Method) < 0 then
101 begin
102 FCode.Add(Method.Code);
103 FData.Add(Method.Data);
104 end;
105end;
106
107procedure TVABaseMethodList.Clear;
108begin
109 FCode.Clear;
110 FData.Clear;
111end;
112
113function TVABaseMethodList.Count: integer;
114begin
115 Result := FCode.Count;
116end;
117
118constructor TVABaseMethodList.Create;
119begin
120 FCode := TList.Create;
121 FData := TList.Create;
122end;
123
124procedure TVABaseMethodList.Delete(index: integer);
125begin
126 FCode.Delete(index);
127 FData.Delete(index);
128end;
129
130destructor TVABaseMethodList.Destroy;
131begin
132 FreeAndNil(FCode);
133 FreeAndNil(FData);
134 inherited;
135end;
136
137function TVABaseMethodList.GetMethod(index: integer): TMethod;
138begin
139 Result.Code := FCode[index];
140 Result.Data := FData[index];
141end;
142
143function TVABaseMethodList.IndexOf(const Method: TMethod): integer;
144begin
145 if assigned(Method.Code) and assigned(Method.data) and (FCode.Count > 0) then
146 begin
147 Result := 0;
148 while((Result < FCode.Count) and ((FCode[Result] <> Method.Code) or
149 (FData[Result] <> Method.Data))) do inc(Result);
150 if Result >= FCode.Count then Result := -1;
151 end
152 else
153 Result := -1;
154end;
155
156procedure TVABaseMethodList.Remove(const Method: TMethod);
157var
158 idx: integer;
159
160begin
161 idx := IndexOf(Method);
162 if(idx >= 0) then
163 begin
164 FCode.Delete(idx);
165 FData.Delete(idx);
166 end;
167end;
168
169{ TVAMethodList }
170
171procedure TVAMethodList.Add(const Method: TMethod);
172begin
173 inherited Add(Method);
174end;
175
176procedure TVAMethodList.Clear;
177begin
178 inherited Clear;
179end;
180
181function TVAMethodList.Count: integer;
182begin
183 Result := inherited Count;
184end;
185
186constructor TVAMethodList.Create;
187begin
188 inherited Create;
189end;
190
191procedure TVAMethodList.Delete(index: integer);
192begin
193 inherited Delete(index);
194end;
195
196destructor TVAMethodList.Destroy;
197begin
198 inherited;
199end;
200
201function TVAMethodList.IndexOf(const Method: TMethod): integer;
202begin
203 Result := inherited IndexOf(Method);
204end;
205
206procedure TVAMethodList.Remove(const Method: TMethod);
207begin
208 inherited Remove(Method);
209end;
210
211{ TVANotificationEventComponent }
212
213procedure TVANotificationEventComponent.Notification(AComponent: TComponent;
214 Operation: TOperation);
215begin
216 if assigned(FOnNotifyEvent) then FOnNotifyEvent(AComponent, Operation);
217 inherited;
218end;
219
220constructor TVANotificationEventComponent.NotifyCreate(AOwner: TComponent;
221 AOnNotifyEvent: TVANotifyEvent);
222begin
223 inherited Create(AOwner);
224 FOnNotifyEvent := AOnNotifyEvent;
225end;
226
227{ TVALinkedMethodList }
228
229procedure TVALinkedMethodList.Add(Obj: TObject; const Method: TMethod);
230begin
231 if assigned(obj) and assigned(Method.Code) and (IndexOf(Obj) < 0) then
232 begin
233 FLinkedObjects.Add(Obj);
234 Code.Add(Method.Code);
235 Data.Add(Method.Data);
236 end;
237end;
238
239procedure TVALinkedMethodList.Clear;
240begin
241 FLinkedObjects.Clear;
242 Code.Clear;
243 Data.Clear;
244end;
245
246function TVALinkedMethodList.Count: integer;
247begin
248 Result := FLinkedObjects.Count;
249end;
250
251constructor TVALinkedMethodList.Create;
252begin
253 inherited;
254 FLinkedObjects := TList.Create;
255end;
256
257procedure TVALinkedMethodList.Delete(index: integer);
258begin
259 FLinkedObjects.Delete(index);
260 Code.Delete(index);
261 Data.Delete(index);
262end;
263
264destructor TVALinkedMethodList.Destroy;
265begin
266 FreeAndNil(FLinkedObjects);
267 inherited;
268end;
269
270function TVALinkedMethodList.GetMethod(Obj: TObject): TMethod;
271var
272 idx: integer;
273begin
274 idx := IndexOf(Obj);
275 if idx < 0 then
276 begin
277 Result.Code := nil;
278 Result.Data := nil;
279 end
280 else
281 Result := Methods[idx];
282end;
283
284function TVALinkedMethodList.IndexOf(const obj: TObject): integer;
285begin
286 if assigned(obj) then
287 Result := FLinkedObjects.IndexOf(obj)
288 else
289 Result := -1;
290end;
291
292procedure TVALinkedMethodList.Remove(const obj: TObject);
293var
294 i: integer;
295begin
296 i := IndexOf(obj);
297 if i >= 0 then
298 Delete(i);
299end;
300
301{ TVAList }
302
303procedure TVAList.Notify(Ptr: Pointer; Action: TListNotification);
304begin
305 if assigned(FOnChange) and (Ptr <> nil) then
306 begin
307 if Action = lnAdded then
308 FOnChange(Self, Ptr, opInsert)
309 else
310 FOnChange(Self, Ptr, opRemove)
311 end;
312end;
313
314end.
Note: See TracBrowser for help on using the repository browser.