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
How to use a In-Memory table using Linked Lists of records. 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
In-Memory table using Linked Lists of records 21-Jul-04
Category
DB-General
Language
Delphi All Versions
Views
305
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
Wray, Terry
Reference URL:
			1   
2   (*
3   What's in it?
4   The zip file contains an example of a simple in-memory table of names.  
5   Creation, sorting and destruction are demonstrated. 
6   
7   
8   What version of Delphi?
9   It's written in D6, but should compile on any version of Delphi.  
10  You may have to redo the form due to DFM incompatability.
11  Who cares?Anyone who wants to use an old-school method of making very fast datasets 
12  in memory.
13  
14  *)


15  
16  unit Unit1;
17  
18  interface
19  //-------------------------UNIT1.PAS--------------------------------------
20  uses
21    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
22    StdCtrls;
23  
24  type
25    TMyObjectPtr = ^TMyObject;
26    TMyObject = record
27      First_Name: string[20];
28      Last_Name: string[20];
29      Next: TMyObjectPtr;
30    end;
31  
32  type
33    TForm1 = class(TForm)
34      bSortByLastName: TButton;
35      bDisplay: TButton;
36      bPopulate: TButton;
37      ListBox1: TListBox;
38      bClear: TButton;
39      procedure bSortByLastNameClick(Sender: TObject);
40      procedure bPopulateClick(Sender: TObject);
41      procedure bDisplayClick(Sender: TObject);
42      procedure bClearClick(Sender: TObject);
43    private
44      { Private declarations }
45    public
46      { Public declarations }
47    end;
48  
49  var
50    Form1: TForm1;
51    pStartOfList: TMyObjectPtr = nil;
52  
53  procedure SortMyObjectListByLastName(var aStartOfList: TMyObjectPtr);
54  function CreateMyObject(aFirstName, aLastName: string): TMyObjectPtr;
55  procedure AppendMyObject(var aCurrentItem, aNewItem: TMyObjectPtr);
56  procedure ClearMyObjectList(var aMyObject: TMyObjectPtr);
57  procedure RemoveMyObject(var aStartOfList, aRemoveMe: TMyObjectPtr);
58  function AreInAlphaOrder(aString1, aString2: string): Boolean;
59  
60  
61  implementation
62  
63  {$R *.DFM}
64  
65  
66  procedure TForm1.bClearClick(Sender: TObject);
67  begin
68    ClearMyObjectList(pStartOfList);
69  end;
70  
71  procedure TForm1.bPopulateClick(Sender: TObject);
72  var
73    pNew: TMyObjectPtr;
74  begin
75    pNew := CreateMyObject('Suzy','Martinez');
76    AppendMyObject(pStartOfList, pNew);
77    pNew := CreateMyObject('John','Sanchez');
78    AppendMyObject(pStartOfList, pNew);
79    pNew := CreateMyObject('Mike','Rodriguez');
80    AppendMyObject(pStartOfList, pNew);
81    pNew := CreateMyObject('Mary','Sosa');
82    AppendMyObject(pStartOfList, pNew);
83    pNew := CreateMyObject('Betty','Hayek');
84    AppendMyObject(pStartOfList, pNew);
85    pNew := CreateMyObject('Luke','Smith');
86    AppendMyObject(pStartOfList, pNew);
87    pNew := CreateMyObject('John','Sosa');
88    AppendMyObject(pStartOfList, pNew);
89  end;
90  
91  procedure TForm1.bSortByLastNameClick(Sender: TObject);
92  begin
93    SortMyObjectListByLastName(pStartOfList);
94  end;
95  
96  procedure TForm1.bDisplayClick(Sender: TObject);
97  var
98    pTemp: TMyObjectPtr;
99  begin
100   ListBox1.Items.Clear;
101   pTemp := pStartOfList;
102   while pTemp <> nil do
103   begin
104     ListBox1.Items.Add(pTemp^.Last_Name + ', ' + pTemp.First_Name);
105     pTemp := pTemp^.Next;
106   end;
107 end;
108 
109 procedure ClearMyObjectList(var aMyObject: TMyObjectPtr);
110 var
111   TempMyObject: TMyObjectPtr;
112 begin
113   TempMyObject := aMyObject;
114   while aMyObject <> nil do
115   begin
116     aMyObject := aMyObject^.Next;
117     Dispose(TempMyObject);
118     TempMyObject := aMyObject;
119   end;
120 end;
121 
122 function CreateMyObject(aFirstName, aLastName: string): TMyObjectPtr;
123 begin
124   new(result);
125   result^.First_Name := aFirstName;
126   result^.Last_Name := aLastName;
127   result^.Next := nil;
128 end;
129 
130 procedure SortMyObjectListByLastName(var aStartOfList: TMyObjectPtr);
131 var
132   aSortedListStart, aSearch, aBest: TMyObjectPtr;
133 begin
134   aSortedListStart := nil;
135   while (aStartOfList <> nil) do
136   begin
137     aSearch := aStartOfList;
138     aBest := aSearch;
139     while aSearch^.Next <> nil do
140     begin
141       if not AreInAlphaOrder(aBest^.Last_Name, aSearch^.Last_Name) then
142         aBest := aSearch;
143       aSearch := aSearch^.Next;
144     end;
145     RemoveMyObject(aStartOfList, aBest);
146     AppendMyObject(aSortedListStart, aBest);
147   end;
148   aStartOfList := aSortedListStart;
149 end;
150 
151 procedure AppendMyObject(var aCurrentItem, aNewItem: TMyObjectPtr);
152 begin
153   if aCurrentItem = nil then
154     aCurrentItem := aNewItem
155   else
156     AppendMyObject(aCurrentItem^.Next, aNewItem);
157 end;
158 
159 procedure RemoveMyObject(var aStartOfList, aRemoveMe: TMyObjectPtr);
160 var
161   pTemp: TMyObjectPtr;
162 begin
163   pTemp := aStartOfList;
164   if pTemp = aRemoveMe then
165     aStartOfList := aStartOfList^.Next
166   else
167   begin
168     while (pTemp^.Next <> aRemoveMe) and (pTemp^.Next <> nil) do
169       pTemp := pTemp^.Next;
170     if pTemp = nil then Exit; //Shouldn't ever happen
171     if pTemp^.Next = nil then Exit; //Shouldn't ever happen
172     pTemp^.Next := aRemoveMe^.Next;
173   end;
174   aRemoveMe^.Next := nil;
175 end;
176 
177 function AreInAlphaOrder(aString1, aString2: string): Boolean;
178 var
179   i: Integer;
180 begin
181   Result := True;
182 
183   while Length(aString2) < Length(aString1) do  aString2 := aString2 + '!';
184   while Length(aString1) < Length(aString2) do  aString1 := aString1 + '!';
185 
186   for i := 1 to Length(aString1) do
187   begin
188     if aString1[i] > aString2[i] then Result := False;
189     if aString1[i] <> aString2[i] then break;
190   end;
191 end;
192 
193 end.
194 //-------------------------UNIT1.DFM--------------------------------------
195 object Form1: TForm1
196   Left = 334
197   Top = 198
198   Width = 374
199   Height = 329
200   Caption = 'Linked List Example'
201   Color = clBtnFace
202   Font.Charset = DEFAULT_CHARSET
203   Font.Color = clWindowText
204   Font.Height = -11
205   Font.Name = 'MS Sans Serif'
206   Font.Style = []
207   OldCreateOrder = False
208   PixelsPerInch = 96
209   TextHeight = 13
210   object bSortByLastName: TButton
211     Left = 4
212     Top = 63
213     Width = 125
214     Height = 25
215     Caption = 'Sort List by Last Name'
216     TabOrder = 0
217     OnClick = bSortByLastNameClick
218   end
219   object bDisplay: TButton
220     Left = 28
221     Top = 89
222     Width = 75
223     Height = 25
224     Caption = 'Display List'
225     TabOrder = 1
226     OnClick = bDisplayClick
227   end
228   object bPopulate: TButton
229     Left = 4
230     Top = 37
231     Width = 125
232     Height = 25
233     Caption = 'Populate List'
234     TabOrder = 2
235     OnClick = bPopulateClick
236   end
237   object ListBox1: TListBox
238     Left = 146
239     Top = 12
240     Width = 179
241     Height = 235
242     ItemHeight = 13
243     TabOrder = 3
244   end
245   object bClear: TButton
246     Left = 4
247     Top = 11
248     Width = 125
249     Height = 25
250     Caption = 'Clear List'
251     TabOrder = 4
252     OnClick = bClearClick
253   end
254 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