Tri rapide d'une grille (TStringGrid)

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
unit SortGrid;
 
{ © Olivier Dahan - odahan@cybercable.fr }
 
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, Grids, StdCtrls;
 
type
 TodColType = (odct_Date,odct_time,odct_DateTime,odct_numeric,odct_CaseString,odct_NoCaseString);
 
Procedure ODSortGrid(grid:TStringGrid;ColToSort:Integer;TypeCol:TodColType;FromRow,ToRow:integer;Ascending:Boolean);
 
implementation
 
Procedure ODSortGrid(grid:TStringGrid;ColToSort:Integer;TypeCol:TodColType;FromRow,ToRow:integer;Ascending:Boolean);
var Ts:TStringList; i:integer; sg:tstringgrid;
 Function ToDate(const s:string):string;
 var y,m,d : word;
 begin
  DecodeDate(StrToDate(s),y,m,d);
  result := FormatFloat('0000',y)+FormatFloat('00',m)+FormatFloat('00',d);
 end;
 Function ToTime(const s:string):string;
 var h,m,sx,ms:word;
 begin
  DecodeTime(StrToTime(s),h,m,sx,ms);
  result := FormatFloat('00',h)+FormatFloat('00',m)+FormatFloat('00',sx)+FormatFloat('00',ms);
 end;
 Function ToDateTime(const s:string):string;
 var p:integer;
 begin
  p:=pos(' ',s);
  if p>0 then
   begin
    Result := ToDate(copy(s,1,p-1))+ToTime(copy(s,p+1,length(s)));
   end else result := '0000000000000000';
 end;
 Function ToNumeric(const s:string):string;
 var p:integer; sx:string;
 const z30 = '000000000000000000000000000000';
 function pad(z:integer):string;
 begin
  if z in [1..30] then result := copy(z30,1,z) else result :='';
 end;
 begin
  sx:='';
  for p:=1 to length(s) do
   if s[p] in (['0'..'9','-',',','.']-[ThousandSeparator]) then sx:=sx+s[p];
  p:=pos(DecimalSeparator,sx);
  if p>0 then
  result := pad(25-length(copy(sx,1,p-1)))+copy(sx,1,p-1)+'.'+copy(sx,p+1,length(sx))+pad(25-length(copy(sx,p+1,length(sx))))
  else result := pad(25-length(sx))+sx;
 end;
begin
 ts:=tstringlist.Create;
 try
  For i:=FromRow to ToRow do
   begin
    Case TypeCol of
     odct_Date : ts.AddObject(ToDate(grid.cells[ColToSort,i]),tobject(i));
     odct_Time : ts.AddObject(ToTime(grid.cells[ColToSort,i]),tobject(i));
     odct_DateTime : ts.AddObject(ToDateTime(grid.cells[ColToSort,i]),tobject(i));
     odct_Numeric : ts.AddObject(ToNumeric(grid.cells[ColToSort,i]),tobject(i));
     odct_CaseString : ts.AddObject(grid.cells[ColToSort,i],tobject(i));
     odct_NoCaseString : ts.AddObject(AnsiUpperCase(grid.cells[ColToSort,i]),tobject(i));
    end;
   end;
  ts.sorted := true;
  sg := TStringGrid.Create(application);
  try
   sg.ColCount := grid.colcount;
   sg.rowcount := ToRow-FromRow+1;
   sg.FixedCols := 0;
   sg.FixedRows := 0;
   if Ascending then
    For i:=0 to ts.count-1 do
     sg.Rows[i] := grid.Rows[integer(ts.objects[i])]
    else
    For i:=ts.count-1 downto 0 do
     sg.Rows[(ts.count-1)-i] := grid.Rows[integer(ts.objects[i])];
   For i:=FromRow to ToRow do
    Grid.Rows[i] := sg.Rows[i-FromRow];
  finally
   sg.free;
  end;
 finally
  ts.free;
 end;
end;
 
end.