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.