cgridsort.pas

TGridSort Component (1.0) -- by WeiYF, 1998.10.29 该组件提供了对TStringGrid内容进行排序的函数 支持普通排序和快速排序两种模式

unit CGridSort;
{*******************************************************

  TGridSort Component (1.0) -- by WeiYF, 1998.10.29
  该组件提供了对TStringGrid内容进行排序的函数
  支持普通排序和快速排序两种模式

********************************************************}
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids;

type
  TSortMoreEvent = procedure(Sender: TObject; var iCol: integer;
                      var sType: string) of object;
  TSortSpecialEvent = function(Sender: TObject;
                        iRow1,iRow2: integer): integer of object;
  TGridSort = class(TComponent)
  private
    { Private declarations }
    FGrid: TStringGrid;
    FList: TList;
    iCompareCol, iSequenceCol, iColumnFrom: integer;
    sSortType: string;
    bSortSort: boolean;

    FOnSortMore: TSortMoreEvent;
    FOnSortSpecial: TSortSpecialEvent;

    function CompareGridCell(Item1, Item2: integer): Integer;
    function CompareCellOnly(s1, s2: string; sType: string): Integer;

    procedure SortList;
    procedure QPassList(iMin,iMax: integer; var iMinMax,iMaxMin: integer);
    procedure QuickSortList(iMin,iMax: integer);
    procedure QSortList;

    procedure SortGrid(pGrid: TStringGrid; iCol: integer; iColSeqNo: integer;
        iRowFrom: integer; iRowTo: integer; sType: string; bSortMore: boolean; bQuick: boolean);
  protected
    { Protected declarations }
  public
    { Public declarations }

    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;

    procedure Sort(pGrid: TStringGrid; iCol: integer; iColSeqNo: integer;
        iRowFrom: integer; iRowTo: integer; sType: string);
    procedure SortSort(pGrid: TStringGrid; iCol: integer; iColSeqNo: integer;
        iRowFrom: integer; iRowTo: integer; sType: string);

    procedure QSort(pGrid: TStringGrid; iCol: integer; iColSeqNo: integer;
        iRowFrom: integer; iRowTo: integer; sType: string);
    procedure QSortSort(pGrid: TStringGrid; iCol: integer; iColSeqNo: integer;
        iRowFrom: integer; iRowTo: integer; sType: string);
  published
    { Published declarations }
    property OnSortMore: TSortMoreEvent read FOnSortMore write FOnSortMore;
    property OnSortSpecial: TSortSpecialEvent read FOnSortSpecial write FOnSortSpecial;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('WeiYF', [TGridSort]);
end;

constructor TGridSort.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FGrid := TStringGrid.Create(self);
  FList := TList.Create;
end;

destructor TGridSort.Destroy;
begin
  FGrid.Free;
  FList.Free;
  inherited Destroy;
end;

procedure TGridSort.SortList;
var
  i,j: integer;
begin
  for i := FList.Count-1 downto 0 do begin
    for j := 0 to FList.Count-1 - 1 do begin
      if (CompareGridCell(j,j+1)>0) then begin
        FList.Exchange(j,j+1);
      end;
    end;
  end;
end;

procedure TGridSort.QPassList(iMin,iMax: integer; var iMinMax,iMaxMin: integer);
var
  iLow,iHigh: integer;
begin
  iLow := iMin;
  iHigh := iMax;
  with FList do begin
    Items[Count-1] := Items[(iLow+iHigh) div 2]
  end;
  repeat
    while ((CompareGridCell(iLow,FList.Count-1)<0)) do iLow := iLow+1;
    while ((CompareGridCell(iHigh,FList.Count-1)>0)) do iHigh := iHigh-1;
    if (iLow<=iHigh) then begin
      if (iLow<>iHigh) then FList.Exchange(iLow,iHigh);
      iLow := iLow+1;  iHigh := iHigh-1;
    end;
  until (iLow > iHigh);
  iMinMax := iHigh;  iMaxMin := iLow;
end;

procedure TGridSort.QuickSortList(iMin,iMax: integer);
var iMinMax, iMaxMin: integer;
begin
  if (iMin<iMax) then begin
    QPassList(iMin,iMax,iMinMax,iMaxMin);
    QuickSortList(iMin,iMinMax);
    QuickSortList(iMaxMin,iMax);
  end;
end;

procedure TGridSort.QSortList;
begin
  with FList do begin
    Add(FList.Items[0]);
    QuickSortList(0, Count-2);
    Delete(Count-1);
  end;
end;

procedure TGridSort.Sort(pGrid: TStringGrid; iCol: integer; iColSeqNo: integer;
        iRowFrom: integer; iRowTo: integer; sType: string);
begin
  SortGrid(pGrid,iCol,iColSeqNo,iRowFrom,iRowTo,sType,false,false);
end;

procedure TGridSort.SortSort(pGrid: TStringGrid; iCol: integer; iColSeqNo: integer;
        iRowFrom: integer; iRowTo: integer; sType: string);
begin
  SortGrid(pGrid,iCol,iColSeqNo,iRowFrom,iRowTo,sType,true,false);
end;

procedure TGridSort.QSort(pGrid: TStringGrid; iCol: integer; iColSeqNo: integer;
        iRowFrom: integer; iRowTo: integer; sType: string);
begin
  SortGrid(pGrid,iCol,iColSeqNo,iRowFrom,iRowTo,sType,false,true);
end;

procedure TGridSort.QSortSort(pGrid: TStringGrid; iCol: integer; iColSeqNo: integer;
        iRowFrom: integer; iRowTo: integer; sType: string);
begin
  SortGrid(pGrid,iCol,iColSeqNo,iRowFrom,iRowTo,sType,true,true);
end;

procedure TGridSort.SortGrid(pGrid: TStringGrid; iCol: integer; iColSeqNo: integer;
        iRowFrom: integer; iRowTo: integer; sType: string; bSortMore: boolean; bQuick: boolean);
var
  i: integer;
begin
  FList.Clear;
  with FGrid do begin
    ColCount := pGrid.ColCount;   RowCount := iRowTo-iRowFrom+1;
    for i:=iRowFrom to iRowTo do  Rows[i-iRowFrom].Assign(pGrid.Rows[i]);
  end;

  FList.Capacity := pGrid.RowCount;
  with FGrid do begin
    for i:=0 to RowCount-1 do FList.Add(Rows[i]);
  end;
  iCompareCol := iCol;   iSequenceCol :=  iColSeqNo;   iColumnFrom := iRowFrom;
  sSortType := sType;    bSortSort := bSortMore;
  //FList.Sort(CompareGridCell);
  if (bQuick) then QSortList else SortList;

  with pGrid do begin
    for i:=iRowFrom to iRowTo do Rows[i].Assign(FList.Items[i-iRowFrom]);
    if (iColSeqNo>=0) then
      for i:=iRowFrom to iRowTo do Cells[iColSeqNo,i] := IntToStr(i);
  end;
end;

function TGridSort.CompareGridCell(Item1, Item2: integer): Integer;
var
  ss1,ss2: TStrings;
  s1,s2: string;
  iTmpCol: integer;
  sType: string;
  rr: integer;
begin
  //ss1 := Item1;  ss2 := Item2;
  ss1 := FList.Items[Item1];     ss2 := FList.Items[Item2];
  if ((Item1=Item2) or (ss1=ss2)) then begin
    result := 0; exit;
  end;
  if (sSortType[1]='?') then begin
    if Assigned(FOnSortSpecial)=true then begin
      result := FOnSortSpecial(self, Item1+iColumnFrom,Item2+iColumnFrom);
      if (result=0) then result := Item2-Item1;
      exit;
    end
  end;
  iTmpCol := iCompareCol;   sType := sSortType;
  while (true) do begin
    s1 := ss1.Strings[iTmpCol];  s2 := ss2.Strings[iTmpCol];
    if ((iTmpCol=iSequenceCol) and (s1=s2)) then begin
      MessageDlg('错误:'+#13+'TGridSort顺序号列'+IntToStr(iSequenceCol)+'内容重复!'+#13+#13
        		  +'  按确定将关闭程序!',mtError , [mbOK], 0);
      halt;
    end;
    rr := CompareCellOnly(s1,s2,sType);
    if (rr<>0) then begin
      result := rr;  exit;
    end;
    if (not bSortSort) then begin
      iTmpCol := iSequenceCol;   sType := 'iI';
      if (iTmpCol<0) then begin
        result := 0;  exit;
      end;
    end
    else begin
      if Assigned(FOnSortMore)=true then begin
        FOnSortMore(self, iTmpCol, sType);
        if (iTmpCol<0) then begin
          result := 0;  exit;
        end;
      end
      else begin
        MessageDlg('错误:'+#13+'TGridSort没有加载OnSortMore函数!'+#13+#13
        		  +'  按确定将关闭程序!',mtError , [mbOK], 0);
        halt;
      end;
    end;
  end;
end;

function TGridSort.CompareCellOnly(s1, s2: string; sType: string): Integer;
var
  n1,n2: integer;
  f1,f2: double;
begin
  case sType[1] of
    'c':  begin
            result := CompareStr(s1,s2);
            exit;
          end;
    'C':  begin
            result := CompareStr(s2,s1);
            exit;
          end;
    'i':  begin
            n1 := StrToIntDef(s1,0);
            n2 := StrToIntDef(s2,0);
            result := n1-n2;
            exit;
          end;
    'I':  begin
            n1 := StrToIntDef(s1,0);
            n2 := StrToIntDef(s2,0);
            result := n2-n1;
            exit;
          end;
    'f':  begin
            if (s1=s2) then begin
              result := 0;   exit;
            end;
            f1 := StrToFloat(Trim(s1));
            f2 := StrToFloat(Trim(s2));
            if (f1<f2) then result := -1
            else result := 1;
            exit;
          end;
    'F':  begin
            if (s1=s2) then begin
              result := 0;   exit;
            end;
            f1 := StrToFloat(Trim(s1));
            f2 := StrToFloat(Trim(s2));
            if (f1<f2) then result := 1
            else result := -1;
            exit;
          end;
    else begin
      MessageDlg('错误:'+#13+'  TGridSort编程有误，排序类型非法!'+#13+#13
                               +'  按确定将关闭程序!',mtError , [mbOK], 0);
      halt;
      result := 1;
    end;
  end;
end;



end.