home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 February / Chip_2000-02_cd.bin / zkuste / Delphi / navody / tt / gridsort.txt < prev    next >
Text File  |  1999-11-22  |  3KB  |  97 lines
  1. unit Unit2;
  2.  
  3. { ⌐ Olivier Dahan - odahan@cybercable.fr }
  4.  
  5. interface
  6. uses
  7.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  8.   ComCtrls, Grids, StdCtrls;
  9.  
  10. type
  11.  TodColType = (odct_Date,odct_time,odct_DateTime,odct_numeric,odct_CaseString,odct_NoCaseString);
  12.  
  13. Procedure ODSortGrid(grid:TStringGrid;ColToSort:Integer;TypeCol:TodColType;FromRow,ToRow:integer;Ascending:Boolean);
  14.  
  15. implementation
  16.  
  17. Procedure ODSortGrid(grid:TStringGrid;ColToSort:Integer;TypeCol:TodColType;FromRow,ToRow:integer;Ascending:Boolean);
  18. var Ts:TStringList; i:integer; sg:tstringgrid;
  19.  Function ToDate(const s:string):string;
  20.  var y,m,d : word;
  21.  begin
  22.   DecodeDate(StrToDate(s),y,m,d);
  23.   result := FormatFloat('0000',y)+FormatFloat('00',m)+FormatFloat('00',d);
  24.  end;
  25.  Function ToTime(const s:string):string;
  26.  var h,m,sx,ms:word;
  27.  begin
  28.   DecodeTime(StrToTime(s),h,m,sx,ms);
  29.   result := FormatFloat('00',h)+FormatFloat('00',m)+FormatFloat('00',sx)+FormatFloat('00',ms);
  30.  end;
  31.  Function ToDateTime(const s:string):string;
  32.  var p:integer;
  33.  begin
  34.   p:=pos(' ',s);
  35.   if p>0 then
  36.    begin
  37.     Result := ToDate(copy(s,1,p-1))+ToTime(copy(s,p+1,length(s)));
  38.    end else result := '0000000000000000';
  39.  end;
  40.  Function ToNumeric(const s:string):string;
  41.  var p:integer; sx:string;
  42.  const z30 = '000000000000000000000000000000';
  43.  function pad(z:integer):string;
  44.  begin
  45.   if z in [1..30] then result := copy(z30,1,z) else result :='';
  46.  end;
  47.  begin
  48.   sx:='';
  49.   for p:=1 to length(s) do
  50.    if s[p] in (['0'..'9','-',',','.']-[ThousandSeparator]) then sx:=sx+s[p];
  51.   p:=pos(DecimalSeparator,sx);
  52.   if p>0 then
  53.   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))))
  54.   else result := pad(25-length(sx))+sx;
  55.  end;
  56. begin
  57.  ts:=tstringlist.Create;
  58.  try
  59.   For i:=FromRow to ToRow do
  60.    begin
  61.     Case TypeCol of
  62.      odct_Date : ts.AddObject(ToDate(grid.cells[ColToSort,i]),tobject(i));
  63.      odct_Time : ts.AddObject(ToTime(grid.cells[ColToSort,i]),tobject(i));
  64.      odct_DateTime : ts.AddObject(ToDateTime(grid.cells[ColToSort,i]),tobject(i));
  65.      odct_Numeric : ts.AddObject(ToNumeric(grid.cells[ColToSort,i]),tobject(i));
  66.      odct_CaseString : ts.AddObject(grid.cells[ColToSort,i],tobject(i));
  67.      odct_NoCaseString : ts.AddObject(AnsiUpperCase(grid.cells[ColToSort,i]),tobject(i));
  68.     end;
  69.    end;
  70.   ts.sorted := true;
  71.   sg := TStringGrid.Create(application);
  72.   try
  73.    sg.ColCount := grid.colcount;
  74.    sg.rowcount := ToRow-FromRow+1;
  75.    sg.FixedCols := 0;
  76.    sg.FixedRows := 0;
  77.    if Ascending then
  78.     For i:=0 to ts.count-1 do
  79.      sg.Rows[i] := grid.Rows[integer(ts.objects[i])]
  80.     else
  81.     For i:=ts.count-1 downto 0 do
  82.      sg.Rows[(ts.count-1)-i] := grid.Rows[integer(ts.objects[i])];
  83.    For i:=FromRow to ToRow do
  84.     Grid.Rows[i] := sg.Rows[i-FromRow];
  85.   finally
  86.    sg.free;
  87.   end;
  88.  finally
  89.   ts.free;
  90.  end;
  91. end;
  92.  
  93. end.
  94.  
  95.  
  96.  
  97.