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.