学步园

unit sortObj;

{***********************************************************************

                           字符串排序单元
        Instruction:
            针对同一文件夹名件名称进行排序，因为传统排序为1,10,2,20。
        为使之排序为1,2,10,20的顺序进行而编写。

        方法：先进行按字符长度进行分组，再将每组中的字符进行按字符排
        序。

        该单元中使用了快速排序算法。


        Use Instruction:
            创建一个TFileNameSort实例。执行
            TFileNameSort.sort(param)方法即可。
            param为传出参数--描述：输入需要排序的列表。

        Fns := TFileNameSort.Create;
        Fns.Sort(strs);
        Memo2.Text:=strs.Text;
        Fns.Free;
        strs.Free;

        作者：边缘
         @CopyRight fsh
        QQ: 19985430
        Email:fengsh998@163.com
***********************************************************************}

interface

{$DEFINE USE_ARR}


uses
  classes,windows,sysutils;


  type
{$IFDEF USE_ARR}
    TStringArray = Array of WideString;//use unicode
{$ENDIF}
    TGroup = Class
      private
        sLen:Integer;
{$IFDEF USE_ARR}
        sArr:TStringArray;
{$ELSE}
        sArr:TStringList;
{$ENDIF}
        function getCount:Integer;
        function getsLen:Integer;
        function getStrs(index:Integer):String;
        procedure Setstrs(index: Integer; const Value: String);
      public
        constructor Create;
        destructor Destroy;override;
        procedure AddString(Const str:String);
        procedure sort;
        property count:Integer read getCount;
        property strLength:Integer read getsLen;
        property strs[index:Integer]:String read getStrs write Setstrs;
    End;

    TGroupList = Class(TList);
    
    TFileNameSort = Class
      private
        Group:TGroupList;
        function checkGroup(const sLen:Integer):TGroup;
        procedure sortGroup(var Grp:TGroupList);
        procedure sortGroupItem(var Grp:TGroupList);
      public
        constructor Create;
        destructor Destroy; override;
        procedure Sort(var strList:TStringList);
    End;

implementation

{ TGroup }

procedure TGroup.AddString(const str: String);
{$IFDEF USE_ARR}
var
   al:Integer;
begin
   al := count;
   setLength(sArr,al + 1);
   sArr[al] := str;
{$ELSE}
begin
  sArr.Add(str);
{$ENDIF}
end;

constructor TGroup.Create;
begin
{$IFNDEF USE_ARR}
   sArr:=TStringList.Create;
{$ENDIF}
end;

destructor TGroup.Destroy;
begin
  inherited;
{$IFNDEF USE_ARR}
  sArr.free;
{$ENDIF}
end;

function TGroup.getCount: Integer;
begin
{$IFDEF USE_ARR}
   result := length(sArr);
{$ELSE}
   result := sArr.count;
{$ENDIF}
end;

function TGroup.getsLen: Integer;
begin
   if count > 0 then
      sLen := Length(sArr[0])
   else
      sLen := -1;
   result := sLen;
end;

function TGroup.getStrs(index: Integer): String;
begin
   result := sArr[index];
end;

procedure TGroup.Setstrs(index: Integer; const Value: String);
begin
   sArr[index] := Value;
end;

procedure TGroup.sort;
{$IFDEF USE_ARR}
var
   f:Integer;
   l:Integer;

   procedure Switch(var arr:TStringArray;o,n:Integer);
   var
      tmp : WideString;
   begin
      tmp := arr[o];
      arr[o] := arr[n];
      arr[n] := tmp;
   end;

   procedure QuikeSort(var arr:TStringArray;s,e:Integer);
   var
      Key:WideString;
      m,n:Integer;
   begin
      Key := arr[s];

      if s > e then exit;

      m := s;
      n := e;
      while (m <> n) do
      begin
        while (m < n) and (CompareStr(arr[n],Key) > 0) do
            dec(n);

        Switch(arr,m,n);

        while (m < n) and (CompareStr(arr[m],Key) < 0) do
            inc(m);

        Switch(arr,n,m);
      end;
      //排序前半部分
      if s < m-1 then
        QuikeSort(arr,s,m-1);
      //排序后半部分
      if m+1 < e then
        QuikeSort(arr,m+1,e);
   end;
{$ENDIF}
begin
{$IFDEF USE_ARR}
   f := 0;
   l := count-1;

   QuikeSort(sArr,f,l);
{$ELSE}
   sArr.sort;
{$ENDIF}
end;

{ TFileNameSort }

function TFileNameSort.checkGroup(const sLen: Integer): TGroup;
var
   i:Integer;
   gc:integer;
begin
   result := nil;
   gc := Group.Count;
   for i := 0 to gc - 1 do
     if TGroup(Group[i]).strLength = sLen then
     begin
        result := TGroup(Group[i]);
        break;
     end;
end;

constructor TFileNameSort.Create;
begin
   Group := TGroupList.Create;
end;

destructor TFileNameSort.Destroy;
var
   i:Integer;
begin
   inherited;
   for I := 0 to Group.Count - 1 do
       TGroup(Group[i]).Free;
   Group.Free;
end;

procedure TFileNameSort.Sort(var strList: TStringList);
var
  i:integer;
  ic:Integer;
  gp:TGroup;
  ws:WideString;
  sL:Integer;
  j:integer;
begin
   ic := strList.Count;

   //将字段按长度分组
   for i := 0 to ic - 1 do
   begin
       ws := strList[i];
       sL := Length(ws);
       gp := checkGroup(sL);
       if Assigned(gp) then //<>nil
       begin
          gp.AddString(ws);
       end
       else
       begin
          gp := TGroup.Create;
          gp.AddString(ws);
          Group.Add(gp);
       end;
   end;

   sortGroup(Group);

   sortGroupItem(Group);
   //重新输出
   strList.Clear;
   for i := 0 to Group.Count - 1 do
   begin
      gp := TGroup(Group[i]);
      for j := 0 to gp.count - 1 do
      begin
        strList.Add(gp.strs[j]);
      end;
   end;
end;

//先将分组按长度从小到大排序
//使用快速排序  从后找，找小的，从前找，找大的。
procedure TFileNameSort.sortGroup(var Grp: TGroupList);
var
   first,Last:Integer;
   procedure SwitchObj(var Grp:TGroupList;old,new:Integer);
   var
      tmp:Pointer;
   begin
      tmp := Grp[old];
      Grp[old] := Grp[new];
      Grp[new] := tmp;
   end;

   procedure QuikeSort(var Grp:TGroupList;s,e:Integer);
   var
      Key,i,j:Integer;
      gp:TGroup;
   begin
      gp := Grp[s];
      Key := gp.strLength;

      if s >= e then exit;

      i := s;
      j := e;

      while i <> j do
      begin
         //从后往前找。
         while (i < j) and (TGroup(Grp[j]).strLength > Key) do
            dec(j);

         SwitchObj(Grp,i,j);

         while (i < j) and (TGroup(Grp[i]).strLength < Key) do
            inc(i);

         SwitchObj(Grp,j,i);
      end;

      //排序前半部分
      if s < i-1 then
        QuikeSort(Grp,s,i-1);
      //排序后半部分
      if i+1 < e then
        QuikeSort(Grp,i+1,e);
   end;
begin
   first := 0;
   Last := Grp.Count - 1;

   QuikeSort(Grp,first,Last);
end;

//再将组中的同长度的字符串进行排序
procedure TFileNameSort.sortGroupItem(var Grp: TGroupList);
var
   i:integer;
   gc:Integer;
begin
   gc := Grp.Count;
   for i := 0 to gc - 1 do
      TGroup(Grp[i]).sort;
end;

end.