Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
Collection Dataset an object oriented database Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
07-Nov-02
Category
DB-General
Language
Delphi 5.x
Views
171
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			Author: Pieter Valentijn

Incapsulating a collection in a TDataset decendant. Enabling to save and load 
diferent datasets in loading and saving component resources.

Answer:

I have writen a TDataset descendant that allows a collection to be set as property 
so it will do the deletes inserts and updates for you with a little help from the 
Data aware controls in delphi.

I made an example that saves some master detail data . 

In my example i'll show you how i use the dataset in design time so i can set the 
fields displaylength and it's displayLabel 

For those cracks that do not need an example here's the compleet code of the 
object. 

For those who do just download the sample . 

And of course do not forget to vote or leave a message :) .. 

Greatings all and keep up the good work. 

1   unit CollectionDataSet;
2   
3   interface
4   
5   uses
6     DB, Classes, typinfo, dialogs;
7   
8   type
9     PRecInfo = ^TRecInfo;
10    TRecInfo = packed record
11      Bookmark: Integer;
12      BookmarkFlag: TBookmarkFlag;
13    end;
14  
15    { TCollectionDataSet }
16  
17    TCollectionDataSet = class(TDataSet)
18    private
19      FRecBufSize: Integer;
20      FRecInfoOfs: Integer;
21      FCurRec: Integer;
22      FFileName: string;
23      FLastBookmark: Integer;
24      FCollection: TCollection;
25      FCollectionCount: Integer;
26      procedure SetCollection(const Value: TCollection);
27    protected
28      function AllocRecordBuffer: PChar; override;
29      procedure FreeRecordBuffer(var Buffer: PChar); override;
30      procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
31      function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
32      function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): 
33  TGetResult; override;
34      function GetRecordSize: Word; override;
35      procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
36      procedure InternalClose; override;
37      procedure InternalCancel; override;
38      procedure InternalDelete; override;
39      procedure InternalFirst; override;
40      procedure InternalGotoBookmark(Bookmark: Pointer); override;
41      procedure InternalHandleException; override;
42      procedure InternalInitFieldDefs; override;
43      procedure InternalInitRecord(Buffer: PChar); override;
44      procedure InternalLast; override;
45      procedure InternalOpen; override;
46      procedure InternalPost; override;
47      procedure InternalSetToRecord(Buffer: PChar); override;
48      function IsCursorOpen: Boolean; override;
49      procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
50      procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
51      procedure SetFieldData(Field: TField; Buffer: Pointer); override;
52      function GetRecordCount: Integer; override;
53      function GetRecNo: Integer; override;
54      procedure SetRecNo(Value: Integer); override;
55    public
56      function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
57      property Collection: TCollection read FCollection write SetCollection;
58    published
59      property FileName: string read FFileName write FFileName;
60      property Active;
61      property AutoCalcFields;
62      property BeforeOpen;
63      property AfterOpen;
64      property BeforeClose;
65      property AfterClose;
66      property BeforeInsert;
67      property AfterInsert;
68      property BeforeEdit;
69      property AfterEdit;
70      property BeforePost;
71      property AfterPost;
72      property BeforeCancel;
73      property AfterCancel;
74      property BeforeDelete;
75      property AfterDelete;
76      property BeforeScroll;
77      property AfterScroll;
78      property BeforeRefresh;
79      property AfterRefresh;
80      property OnCalcFields;
81      property OnDeleteError;
82      property OnEditError;
83      property OnFilterRecord;
84      property OnNewRecord;
85      property OnPostError;
86  
87    end;
88  
89  procedure register;
90  
91  implementation
92  
93  uses Windows, SysUtils, Forms;
94  
95  { TCollectionDataSet }
96  
97  procedure TCollectionDataSet.InternalOpen;
98  
99  begin
100   if Collection = nil then
101     raise EDatabaseError.Create('Collection is niet gevult !');
102 
103   FCurRec := -1;
104 
105   FCollectionCount := Collection.Count;
106   FLastBookmark := Collection.Count;
107   FRecInfoOfs := SizeOf(Integer);
108 
109   FRecBufSize := SizeOf(TRecInfo) + FRecInfoOfs;
110   BookmarkSize := SizeOf(Integer);
111 
112   InternalInitFieldDefs;
113 
114   if DefaultFields then
115     CreateFields;
116 
117   BindFields(True);
118 end;
119 
120 procedure TCollectionDataSet.InternalClose;
121 begin
122 
123   if DefaultFields then
124     DestroyFields;
125   FLastBookmark := 0;
126   FCurRec := -1;
127 end;
128 
129 function TCollectionDataSet.IsCursorOpen: Boolean;
130 begin
131   Result := Assigned(collection);
132 end;
133 
134 procedure TCollectionDataSet.InternalInitFieldDefs;
135 var
136   PropList: PPropList;
137   PropCount: Integer;
138   ClassTypeInfo: PTypeInfo;
139   ClassTypeData: PTypeData;
140   i: integer;
141 begin
142   FieldDefs.Clear;
143   if Collection = nil then
144     raise EInvalidPointer.create('Collection is nil');
145   ClassTypeInfo := Collection.ItemClass.ClassInfo;
146   ClassTypeData := GetTypeData(ClassTypeInfo);
147   PropCount := ClassTypeData.PropCount - 1;
148   //  reserveer geheugen
149   GetMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount);
150   // Error trap
151   try
152     // Vul de prop list
153     GetPropList(Collection.ItemClass.ClassInfo, tkAny, PropList);
154     for i := 0 to PropCount do
155     begin
156       try
157         case PropList[i]^.PropType^.Kind of
158           tkString, tkLString,
159             tkWString, tkWChar,
160             tkChar:
161             begin
162               FieldDefs.Add(PropList[i]^.Name, ftString, 255, False);
163             end;
164 
165           tkInteger,
166             tkEnumeration:
167             begin
168               FieldDefs.Add(PropList[i]^.Name, ftInteger, 0, False);
169             end;
170           tkFloat:
171             begin
172               FieldDefs.Add(PropList[i]^.Name, ftFloat, 0, False);
173             end;
174           tkClass:
175             begin
176             end;
177           tkArray:
178             begin
179             end;
180         end; // end case
181       except
182         on e: Exception do
183 
184       end;
185 
186     end;
187   finally
188     FreeMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount);
189   end;
190 
191 end;
192 
193 procedure TCollectionDataSet.InternalHandleException;
194 begin
195   Application.HandleException(Self);
196 end;
197 
198 procedure TCollectionDataSet.InternalGotoBookmark(Bookmark: Pointer);
199 var
200   Index: Integer;
201 begin
202   Index := PInteger(Bookmark)^ - 1;
203   if Index > -1 then
204     FCurRec := Index
205   else
206     DatabaseError('Bookmark not found');
207 end;
208 
209 procedure TCollectionDataSet.InternalSetToRecord(Buffer: PChar);
210 begin
211   InternalGotoBookmark(@PRecInfo(Buffer + FRecInfoOfs).Bookmark);
212 end;
213 
214 function TCollectionDataSet.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
215 begin
216   Result := PRecInfo(Buffer + FRecInfoOfs).BookmarkFlag;
217 end;
218 
219 procedure TCollectionDataSet.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
220 begin
221   PRecInfo(Buffer + FRecInfoOfs).BookmarkFlag := Value;
222 end;
223 
224 procedure TCollectionDataSet.GetBookmarkData(Buffer: PChar; Data: Pointer);
225 begin
226   PInteger(Data)^ := PRecInfo(Buffer + FRecInfoOfs).Bookmark;
227 end;
228 
229 procedure TCollectionDataSet.SetBookmarkData(Buffer: PChar; Data: Pointer);
230 begin
231   PRecInfo(Buffer + FRecInfoOfs).Bookmark := PInteger(Data)^;
232 end;
233 
234 function TCollectionDataSet.GetRecordSize: Word;
235 begin
236   Result := SizeOf(Integer); //MaxStrLen;
237 end;
238 
239 function TCollectionDataSet.AllocRecordBuffer: PChar;
240 begin
241   GetMem(Result, FRecBufSize);
242 end;
243 
244 procedure TCollectionDataSet.FreeRecordBuffer(var Buffer: PChar);
245 begin
246   FreeMem(Buffer, FRecBufSize);
247 end;
248 
249 function TCollectionDataSet.GetRecord(Buffer: PChar; GetMode: TGetMode;
250   DoCheck: Boolean): TGetResult;
251 begin
252   if Collection.Count < 1 then
253     Result := grEOF
254   else
255   begin
256     Result := grOK;
257     case GetMode of
258       gmNext:
259         if FCurRec >= RecordCount - 1 then
260           Result := grEOF
261         else
262           Inc(FCurRec);
263       gmPrior:
264         if FCurRec <= 0 then
265           Result := grBOF
266         else
267           Dec(FCurRec);
268       gmCurrent:
269         if (FCurRec < 0) or (FCurRec >= RecordCount) then
270           Result := grError;
271     end;
272     if Result = grOK then
273     begin
274       PInteger(Buffer)^ := Integer(FCollection.Items[FCurRec]);
275       with PRecInfo(Buffer + FRecInfoOfs)^ do
276       begin
277         BookmarkFlag := bfCurrent;
278         Bookmark := FCurRec + 1;
279       end;
280     end
281     else if (Result = grError) and DoCheck then
282       DatabaseError('No Records');
283   end;
284 end;
285 
286 procedure TCollectionDataSet.InternalInitRecord(Buffer: PChar);
287 begin
288   PInteger(Buffer)^ := Integer(FCollection.Add);
289 end;
290 
291 function TCollectionDataSet.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
292 
293 var
294   Apropinfo: PPropinfo;
295   AString: string;
296   AInteger: Integer;
297   AFloat: Double;
298   AItem: TCollectionItem;
299 begin
300   Result := False;
301   if Collection.Count = 0 then
302     exit;
303   AItem := TCollectionItem(PInteger(ActiveBuffer)^);
304   Apropinfo := typinfo.GetPropInfo(AItem, Field.FullName);
305   case Apropinfo.PropType^.Kind of
306     tkString, tkLString,
307       tkWString, tkWChar,
308       tkChar:
309       begin
310         AString := GetStrProp(AItem, Apropinfo);
311         StrLCopy(Buffer, PChar(AString), Length(AString));
312         Result := PChar(Buffer)^ <> #0;
313       end;
314 
315     tkInteger,
316       tkEnumeration:
317       begin
318         AInteger := GetOrdProp(AItem, Apropinfo);
319         PInteger(Buffer)^ := AInteger;
320         Result := true;
321       end;
322     tkFloat:
323       begin
324         AFloat := GetFloatProp(AItem, Apropinfo);
325         PDouble(Buffer)^ := AFloat;
326         Result := true;
327       end;
328   end; // end case
329 end;
330 
331 procedure TCollectionDataSet.SetFieldData(Field: TField; Buffer: Pointer);
332 var
333   Apropinfo: PPropinfo;
334   AString: string;
335   AInteger: Integer;
336   AFloat: Double;
337   AItem: TCollectionItem;
338 begin
339   AItem := TCollectionItem(PInteger(ActiveBuffer)^);
340   Apropinfo := typinfo.GetPropInfo(AItem, Field.FullName);
341   case Apropinfo.PropType^.Kind of
342     tkString, tkLString,
343       tkWString, tkWChar,
344       tkChar:
345       begin
346         AString := PChar(Buffer);
347         SetStrProp(AItem, Apropinfo, AString);
348       end;
349 
350     tkInteger,
351       tkEnumeration:
352       begin
353         AInteger := 0;
354         if Buffer <> nil then
355           AInteger := PInteger(Buffer)^;
356         SetOrdProp(AItem, Apropinfo, AInteger);
357       end;
358     tkFloat:
359       begin
360 
361         AFloat := 0;
362         if Buffer <> nil then
363           AFloat := PDouble(Buffer)^;
364         SetFloatProp(AItem, Apropinfo, AFloat);
365       end;
366   end; // end case
367 
368   DataEvent(deFieldChange, Longint(Field));
369 end;
370 
371 procedure TCollectionDataSet.InternalFirst;
372 begin
373   FCurRec := -1;
374 end;
375 
376 procedure TCollectionDataSet.InternalLast;
377 begin
378   FCurRec := FCollectionCount;
379 end;
380 
381 procedure TCollectionDataSet.InternalPost;
382 begin
383   if State = dsinsert then
384   begin
385     Inc(FCollectionCount);
386     Inc(FLastBookmark);
387     if FCurRec <> -1 then
388       TCollectionItem(PInteger(ActiveBuffer)^).Index := FCurRec;
389   end;
390 
391 end;
392 
393 procedure TCollectionDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
394 begin
395   Inc(FLastBookmark);
396   if Append then
397     InternalLast;
398   Inc(FCollectionCount);
399 
400 end;
401 
402 procedure TCollectionDataSet.InternalDelete;
403 begin
404   Collection.Delete(FCurRec);
405   Dec(FCollectionCount);
406   if FCurRec >= Collection.Count then
407     Dec(FCurRec);
408 end;
409 
410 function TCollectionDataSet.GetRecordCount: Longint;
411 begin
412   Result := FCollectionCount;
413 end;
414 
415 function TCollectionDataSet.GetRecNo: Longint;
416 begin
417   UpdateCursorPos;
418   if (FCurRec <= -1) and (RecordCount > 0) then
419     Result := 0
420   else
421     Result := FCurRec + 1;
422 end;
423 
424 procedure TCollectionDataSet.SetRecNo(Value: Integer);
425 begin
426   if (Value >= 0) and (Value < FCollectionCount) then
427   begin
428     FCurRec := Value - 1;
429     Resync([]);
430   end;
431 end;
432 
433 procedure TCollectionDataSet.SetCollection(const Value: TCollection);
434 begin
435   FCollection := Value;
436 end;
437 
438 procedure TCollectionDataSet.InternalCancel;
439 begin
440   Collection.Delete(Collection.Count - 1);
441 end;
442 
443 end.


			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC