source: cprs/branches/GUI-config/TMG_Extra/SortStringGrid.pas@ 834

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

Sortable grids, fixed hint-bug
File size: 8.2 KB
Line 
1unit SortStringGrid;
2// Written by K. Toppenberg, MD
3// Copyright (C) 6/23/2010
4// Released under GPL license.
5
6interface
7uses
8 Windows, Messages, StrUtils, SysUtils, Classes, Graphics, Controls, Dialogs, Grids;
9
10type
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
37implementation
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
246end.
247
Note: See TracBrowser for help on using the repository browser.