1 | unit SortStringGrid;
|
---|
2 | // Written by K. Toppenberg, MD
|
---|
3 | // Copyright (C) 6/23/2010
|
---|
4 | // Released under GPL license.
|
---|
5 |
|
---|
6 | interface
|
---|
7 | uses
|
---|
8 | Windows, Messages, StrUtils, SysUtils, Classes, Graphics, Controls, Dialogs, Grids;
|
---|
9 |
|
---|
10 | type
|
---|
11 | TSortDirection = (sdNoSort,sdAscending,sdDescending);
|
---|
12 |
|
---|
13 | TSortStringGrid = class(TStringGrid)
|
---|
14 | private
|
---|
15 | FNumbers : TList;
|
---|
16 | FLastSortDirection : TSortDirection;
|
---|
17 | FLastSortedColumn : LongInt;
|
---|
18 | function GetPreSortRowNum(CurRowNum : LongInt) : LongInt;
|
---|
19 | procedure SetNumber(RowNum : LongInt; Value : integer);
|
---|
20 | function GetNumber(RowNum : LongInt) : Integer;
|
---|
21 | protected
|
---|
22 | procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
|
---|
23 | procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
---|
24 | property ANumber[RowNum : LongInt] : Integer read GetNumber write SetNumber;
|
---|
25 | function Piece(const S: string; Delim: string; PieceNum: Integer): string; overload;
|
---|
26 | public
|
---|
27 | constructor Create(AOwner: TComponent); override;
|
---|
28 | destructor Destroy; override;
|
---|
29 | procedure Assign(Source : TPersistent); override;
|
---|
30 | procedure SortCol(SortColNum : integer; SortDirection : TSortDirection);
|
---|
31 | property SortedColumn : LongInt read FLastSortedColumn;
|
---|
32 | property PreSortRowNum[CurRowNum : LongInt] : LongInt read GetPreSortRowNum;
|
---|
33 | end;
|
---|
34 |
|
---|
35 | procedure Register;
|
---|
36 |
|
---|
37 | implementation
|
---|
38 |
|
---|
39 | constructor TSortStringGrid.Create(AOwner: TComponent);
|
---|
40 | begin
|
---|
41 | inherited Create(AOwner);
|
---|
42 | FNumbers := TList.Create;
|
---|
43 | FLastSortedColumn := -1;
|
---|
44 | FLastSortDirection := sdNoSort;
|
---|
45 | end;
|
---|
46 |
|
---|
47 | destructor TSortStringGrid.Destroy;
|
---|
48 | begin
|
---|
49 | FNumbers.Free;
|
---|
50 | inherited Destroy;
|
---|
51 | end;
|
---|
52 |
|
---|
53 | procedure TSortStringGrid.Assign(Source : TPersistent);
|
---|
54 | var Row,Col : LongInt;
|
---|
55 | Src : TSortStringGrid;
|
---|
56 | begin
|
---|
57 | //Inherited Assign(Source);
|
---|
58 | //NOTE: This is only a limited copy. Could extend later.
|
---|
59 | if not (Source is TSortStringGrid) then exit;
|
---|
60 | Src := TSortStringGrid(Source);
|
---|
61 | Self.ColCount := Src.ColCount;
|
---|
62 | Self.RowCount := Src.RowCount;
|
---|
63 | for Row := 0 to Self.RowCount-1 do begin
|
---|
64 | Self.Rows[Row].Text := Src.Rows[Row].Text;
|
---|
65 | for Col := 0 to Self.ColCount-1 do begin
|
---|
66 | Self.Objects[Col,Row] := Src.Objects[Col,Row];
|
---|
67 | end;
|
---|
68 | end;
|
---|
69 | end;
|
---|
70 |
|
---|
71 |
|
---|
72 | procedure TSortStringGrid.SetNumber(RowNum : Integer; Value : integer);
|
---|
73 | begin
|
---|
74 | if RowNum < 0 then exit;
|
---|
75 | while RowNum > (FNumbers.Count-1) do begin
|
---|
76 | FNumbers.Add(TObject(0));
|
---|
77 | end;
|
---|
78 | FNumbers.Items[RowNum] := TObject(Value);
|
---|
79 | end;
|
---|
80 |
|
---|
81 | function TSortStringGrid.GetNumber(RowNum : integer) : Integer;
|
---|
82 | begin
|
---|
83 | Result := 0; //default value
|
---|
84 | if (RowNum < 0) or (RowNum > (FNumbers.Count-1)) then exit;
|
---|
85 | Result := Integer(FNumbers.Items[RowNum]);
|
---|
86 | end;
|
---|
87 |
|
---|
88 | procedure TSortStringGrid.MouseUp(Button: TMouseButton;
|
---|
89 | Shift: TShiftState;
|
---|
90 | X, Y: Integer);
|
---|
91 | var ACol,ARow : LongInt;
|
---|
92 | SortDir : TSortDirection;
|
---|
93 | //temp : integer;
|
---|
94 | begin
|
---|
95 | MouseToCell(X, Y, ACol, ARow);
|
---|
96 | if ARow=0 then begin
|
---|
97 | if ACol = FLastSortedColumn then begin
|
---|
98 | case FLastSortDirection of
|
---|
99 | sdNoSort : SortDir := sdAscending;
|
---|
100 | sdAscending : SortDir := sdDescending;
|
---|
101 | sdDescending: SortDir := sdNoSort;
|
---|
102 | else SortDir := sdNoSort;
|
---|
103 | end; {case}
|
---|
104 | end else SortDir := sdAscending;
|
---|
105 | SortCol(ACol,SortDir);
|
---|
106 | end else begin
|
---|
107 | //temp := Self.PreSortRowNum[ARow];
|
---|
108 | //MessageDlg('Original Row# '+ IntToStr(temp),mtInformation,[mbOK],0);
|
---|
109 | inherited MouseUp(Button,Shift,X,Y);
|
---|
110 | end;
|
---|
111 | end;
|
---|
112 |
|
---|
113 | procedure TSortStringGrid.SortCol(SortColNum : integer; SortDirection : TSortDirection);
|
---|
114 | //Sort routine heavily modified from code found here
|
---|
115 | //http://www.delphitricks.com/source-code/components/sort_a_stringgrid.html
|
---|
116 | const
|
---|
117 | DivS = '{°v°}'; //some arbitrary but unique character sequence
|
---|
118 |
|
---|
119 | var
|
---|
120 | RowNum,ColNum : integer;
|
---|
121 | PreSortRowNum : integer;
|
---|
122 | SourceRow : LongInt;
|
---|
123 | DestRow : LongInt;
|
---|
124 | MyList : TStringList;
|
---|
125 | FirstSort : boolean;
|
---|
126 | TempGrid : TSortStringGrid;
|
---|
127 | InfoStr : string;
|
---|
128 |
|
---|
129 | begin
|
---|
130 | TempGrid := TSortStringGrid.Create(Self);
|
---|
131 | TempGrid.Assign(Self);
|
---|
132 | FLastSortedColumn := SortColNum;
|
---|
133 | FLastSortDirection := SortDirection;
|
---|
134 | MyList := TStringList.Create;
|
---|
135 | MyList.Sorted := False;
|
---|
136 | try
|
---|
137 | FirstSort := (Self.FNumbers.Count=0);
|
---|
138 | MyList.Add('--'); //placeholder for header row-
|
---|
139 | for RowNum := 1 to RowCount-1 do MyList.Add(''); //fill to allow random access
|
---|
140 | if (SortDirection = sdNoSort) and FirstSort then exit; //will jump to Finally part.
|
---|
141 | for RowNum := 1 to RowCount - 1 do begin
|
---|
142 | PreSortRowNum := Self.PreSortRowNum[RowNum];
|
---|
143 | if (SortDirection = sdNoSort) then DestRow := PreSortRowNum
|
---|
144 | else begin
|
---|
145 | DestRow := RowNum;
|
---|
146 | if FirstSort then PreSortRowNum := RowNum;
|
---|
147 | end;
|
---|
148 | InfoStr := Self.Cells[SortColNum,RowNum] + DivS + IntToStr(RowNum) + DivS + IntToStr(PreSortRowNum);
|
---|
149 | MyList.Strings[DestRow] := InfoStr;
|
---|
150 | end;
|
---|
151 | if (SortDirection <> sdNoSort) then Mylist.Sort;
|
---|
152 |
|
---|
153 | //Order in MyList is new order for grid
|
---|
154 | for RowNum := 1 to RowCount - 1 do begin
|
---|
155 | InfoStr := MyList.Strings[RowNum];
|
---|
156 | SourceRow := StrToIntDef(Piece(InfoStr,DivS,2),0);
|
---|
157 | DestRow := RowNum;
|
---|
158 | if SortDirection = sdDescending then DestRow := RowCount-RowNum;
|
---|
159 | Rows[DestRow].Text := TempGrid.Rows[SourceRow].Text; //Copy all strings on row
|
---|
160 | //Set up pre-sort number.
|
---|
161 | PreSortRowNum := StrToIntDef(Piece(InfoStr,DivS,3),0);
|
---|
162 | Self.ANumber[DestRow] := PreSortRowNum; //Set PreSortNumber
|
---|
163 | //Copy object pointers
|
---|
164 | for ColNum := 0 to ColCount-1 do begin
|
---|
165 | Self.Objects[ColNum,DestRow] := TempGrid.Objects[ColNum,SourceRow];
|
---|
166 | end;
|
---|
167 | end;
|
---|
168 |
|
---|
169 | finally
|
---|
170 | MyList.Free;
|
---|
171 | TempGrid.Free;
|
---|
172 | end;
|
---|
173 | end;
|
---|
174 |
|
---|
175 |
|
---|
176 | procedure TSortStringGrid.DrawCell(ACol, ARow: Longint;
|
---|
177 | ARect: TRect;
|
---|
178 | AState: TGridDrawState);
|
---|
179 | var P,P2 : TPoint;
|
---|
180 | OrigRect : TRect;
|
---|
181 | OrigPen : TPen;
|
---|
182 | i : integer;
|
---|
183 | Dir : integer;
|
---|
184 | begin
|
---|
185 | //custom code here
|
---|
186 | OrigRect := ARect;
|
---|
187 | if (ARow=0) and (ACol = FLastSortedColumn)
|
---|
188 | and (FLastSortDirection <> sdNoSort) then begin
|
---|
189 | ARect.Left := ARect.Left+10; //create space for sort indicator
|
---|
190 | end;
|
---|
191 | inherited DrawCell(ACol,ARow,ARect,AState);
|
---|
192 | if (ARow=0) and (ACol = FLastSortedColumn)
|
---|
193 | and (FLastSortDirection <> sdNoSort) then begin
|
---|
194 | OrigPen := Canvas.Pen;
|
---|
195 | Canvas.Pen.Width := 1;
|
---|
196 | Canvas.Pen.Color := clRed;
|
---|
197 | P := OrigRect.TopLeft;
|
---|
198 | P.X := OrigRect.Left+3;
|
---|
199 | P.Y := ARect.Top + (ARect.Bottom - ARect.Top) div 2;
|
---|
200 | if FLastSortDirection= sdAscending then Dir := 1
|
---|
201 | else Dir := -1;
|
---|
202 | for i := 0 to 4 do begin
|
---|
203 | P2.X := P.X + i;
|
---|
204 | P2.Y := P.Y + i*Dir;
|
---|
205 | Canvas.PenPos := P2;
|
---|
206 | Canvas.LineTo(P.X+8-i, P.Y+i*Dir);
|
---|
207 | end;
|
---|
208 | Canvas.Pen := OrigPen;
|
---|
209 | end;
|
---|
210 | end;
|
---|
211 |
|
---|
212 | function TSortStringGrid.GetPreSortRowNum(CurRowNum : LongInt) : LongInt;
|
---|
213 | var i :integer;
|
---|
214 | begin
|
---|
215 | if Self.FNumbers.Count=0 then begin
|
---|
216 | for i := 0 to RowCount-1 do begin
|
---|
217 | SetNumber(i,i);
|
---|
218 | end;
|
---|
219 | end;
|
---|
220 | Result := GetNumber(CurRowNum);
|
---|
221 | end;
|
---|
222 |
|
---|
223 | function TSortStringGrid.Piece(const S: string; Delim: string; PieceNum: Integer): string;
|
---|
224 | //kt 8/09 Added entire function
|
---|
225 | var Remainder : String;
|
---|
226 | PieceLen,p : integer;
|
---|
227 | begin
|
---|
228 | Remainder := S;
|
---|
229 | Result := '';
|
---|
230 | PieceLen := Length(Delim);
|
---|
231 | while (PieceNum > 0) and (Length(Remainder) > 0) do begin
|
---|
232 | p := Pos(Delim,Remainder);
|
---|
233 | if p=0 then p := length(Remainder)+1;
|
---|
234 | Result := MidStr(Remainder,1,p-1);
|
---|
235 | Remainder := MidStr(Remainder,p+PieceLen,9999);
|
---|
236 | Dec(PieceNum);
|
---|
237 | end;
|
---|
238 | end;
|
---|
239 |
|
---|
240 |
|
---|
241 | procedure Register;
|
---|
242 | begin
|
---|
243 | RegisterComponents('Additional', [TSortStringGrid]);
|
---|
244 | end;
|
---|
245 |
|
---|
246 | end.
|
---|
247 |
|
---|