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:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
| (* CDSSort (c) 2002 Cary Jensen, Jensen Data Systems, Inc.
*
* This project includes two functions for sorting a
* ClientDataSet on a field at runtime using persistent
* indexes. The first time a field is sorted, the index
* will be an acsending index. Sorting this same field again
* will produce a descending index. Each subsequent sort will
* alternate between the previously generated ascending and
* descending indexes. The SortCustomClientDataSet function
* works with any TCustomClientDataSet, but requires runtime
* type information (RTTI). The SortClientDataSet function
* works only with TClientDataSets, but does not require RTTI.
*
*
* This project is provided for demonstration purposes only
*
* No guarantees or warrantees are expressed or implied concerning
* the applicability of techniques or code included in this example.
* If you wish to use techniques or code included in this example,
* it is your responsibility to test and certify any code,
* techniques, or design adopted as a result of this project.
*
* For information on consulting or training services, please visit
* http://www.JensenDataSystems.com.
*
* Delphi Developer Days - Information-packed Delphi (TM) seminars
* by Cary Jensen. Visit www.DelphiDeveloperDays.com for dates and locations.
*
*)
unit sortfunctions;
interface
uses
DB, DBClient;
function SortCustomClientDataSet(DataSet: TCustomClientDataSet;
const FieldName: String): Boolean;
function SortClientDataSet(ClientDataSet: TClientDataSet;
const FieldName: String): Boolean;
implementation
uses TypInfo; //TypInfo needed for RTTI GetObjectProp
//IsPublishedProp, and SetStrProp methods
//used in SortCustomClientDataSet
function SortCustomClientDataSet(DataSet: TCustomClientDataSet;
const FieldName: String): Boolean;
var
i: Integer;
IndexDefs: TIndexDefs;
IndexName: String;
IndexOptions: TIndexOptions;
Field: TField;
begin
Result := False;
Field := DataSet.Fields.FindField(FieldName);
//If invalid field name, exit.
if Field = nil then Exit;
//if invalid field type, exit.
if (Field is TObjectField) or (Field is TBlobField) or
(Field is TAggregateField) or (Field is TVariantField)
or (Field is TBinaryField) then Exit;
//Get IndexDefs and IndexName using RTTI
if IsPublishedProp(DataSet, 'IndexDefs') then
IndexDefs := GetObjectProp(DataSet, 'IndexDefs') as TIndexDefs
else
Exit;
if IsPublishedProp(DataSet, 'IndexName') then
IndexName := GetStrProp(DataSet, 'IndexName')
else
Exit;
//Ensure IndexDefs is up-to-date
IndexDefs.Update;
//If an ascending index is already in use,
//switch to a descending index
if IndexName = FieldName + '__IdxA'
then
begin
IndexName := FieldName + '__IdxD';
IndexOptions := [ixDescending];
end
else
begin
IndexName := FieldName + '__IdxA';
IndexOptions := [];
end;
//Look for existing index
for i := 0 to Pred(IndexDefs.Count) do
begin
if IndexDefs[i].Name = IndexName then
begin
Result := True;
Break
end; //if
end; // for
//If existing index not found, create one
if not Result then
begin
DataSet.AddIndex(IndexName, FieldName, IndexOptions);
Result := True;
end; // if not
//Set the index
SetStrProp(DataSet, 'IndexName', IndexName);
end;
//This version does not require RTTI, but only
//works with ClientDataSets.
function SortClientDataSet(ClientDataSet: TClientDataSet;
const FieldName: String): Boolean;
var
i: Integer;
NewIndexName: String;
IndexOptions: TIndexOptions;
Field: TField;
begin
Result := False;
Field := ClientDataSet.Fields.FindField(FieldName);
//If invalid field name, exit.
if Field = nil then Exit;
//if invalid field type, exit.
if (Field is TObjectField) or (Field is TBlobField) or
(Field is TAggregateField) or (Field is TVariantField)
or (Field is TBinaryField) then Exit;
//Get IndexDefs and IndexName using RTTI
//Ensure IndexDefs is up-to-date
ClientDataSet.IndexDefs.Update;
//If an ascending index is already in use,
//switch to a descending index
if ClientDataSet.IndexName = FieldName + '__IdxA'
then
begin
NewIndexName := FieldName + '__IdxD';
IndexOptions := [ixDescending];
end
else
begin
NewIndexName := FieldName + '__IdxA';
IndexOptions := [];
end;
//Look for existing index
for i := 0 to Pred(ClientDataSet.IndexDefs.Count) do
begin
if ClientDataSet.IndexDefs[i].Name = NewIndexName then
begin
Result := True;
Break
end; //if
end; // for
//If existing index not found, create one
if not Result then
begin
ClientDataSet.AddIndex(NewIndexName,
FieldName, IndexOptions);
Result := True;
end; // if not
//Set the index
ClientDataSet.IndexName := NewIndexName;
end;
end. |
Tino
