排序,不过比较复杂,求助。(300分)

  • 主题发起人 主题发起人 kia2004
  • 开始时间 开始时间
K

kia2004

Unregistered / Unconfirmed
GUEST, unregistred user!
有个表格:
1 3 5 7 7
2 12 5 0 2
3 3 5 7 7
4 0 2 2 8
5 12 7 0 8
说明:
1、第一列是序号;
2、对第二列排序,排序的要求是,从大到小进行排列,如果有相同的值,例如12,则看第三列,找第三列中对应小的值,是5;如果还一样就找第四列,第四列又找对应大的值,如果值还一样,则比较序号,序号大的在前;
3、最后按照值得大小对序号进行排列;
例如:上面这个表格对第二列的排序结果是:12 12 3 3 0,对应序号的排序是:2 5 3 1 4
 
定义二维数组,传入排序函数中,
函数中把if做成多次,就能定制完成你这个任务,不过通用性不强。
 
定义二维数组,顺序查找就能完成.FOR循环中当第一个数据大于第一个数据,那么就保存到动态数组,如果那么就换个位置后把下一个数保存到数组
 
这么简单?不要看说明直接看结果,
上面这个表格对第二列的排序结果是:12 12 3 3 0,对应序号的排序是:2 5 3 1 4
定义一个二维数组,把一二两列一一对应,用个冒泡法或者选择排序就搞定
 
看的很简单,但我做了循环就是得不出正确的结果,我都快做1个小时了。
 
总数整出来了,我只是简单循环,也可以做成函数,
在主界面添加一个按钮,一个memo控件,
procedure TForm1.Button1Click(Sender: TObject);

var
myarray:array[0..4,0..4] of integer;
i,j,k,m:integer;
begin
myarray[0][0]:=1;
myarray[0][1]:=3;
myarray[0][2]:=5;
myarray[0][3]:=7;
myarray[0][4]:=7;
myarray[1][0]:=2;
myarray[1][1]:=12;
myarray[1][2]:=5;
myarray[1][3]:=0;
myarray[1][4]:=2;
myarray[2][0]:=3;
myarray[2][1]:=3;
myarray[2][2]:=5;
myarray[2][3]:=7;
myarray[2][4]:=7;
myarray[3][0]:=4;
myarray[3][1]:=0;
myarray[3][2]:=2;
myarray[3][3]:=2;
myarray[3][4]:=8;
myarray[4][0]:=5;
myarray[4][1]:=12;
myarray[4][2]:=7;
myarray[4][3]:=0;
myarray[4][4]:=8;
for j:=0 to 4do
begin
for m:=j+1 to 4do
begin
if myarray[j][1]<myarray[m][1] then
begin
for i:=0 to 4do
begin
k:=myarray[j];
myarray[j]:=myarray[m];
myarray[m]:=k;
end;
end;

if (myarray[j][1]=myarray[j+1][1])
and (myarray[j][2]>myarray[j+1][2])then
begin
for i:=0 to 4do
begin
k:=myarray[j];
myarray[j]:=myarray[j+1];
myarray[j+1]:=k;
end ;
end
else
if (myarray[j][1]=myarray[j+1][1])
and (myarray[j][2]=myarray[j+1][2])
and (myarray[j][3]<myarray[j+1][3])then
begin
for i:=0 to 4do
begin
k:=myarray[j];
myarray[j]:=myarray[j+1];
myarray[j+1]:=k;
end;
end
else
if (myarray[j][1]=myarray[j+1][1])
and (myarray[j][2]=myarray[j+1][2])
and (myarray[j][3]=myarray[j+1][3])
and (myarray[j][0]>myarray[j+1][0])then
begin
for i:=0 to 4do
begin
k:=myarray[j];
myarray[j]:=myarray[j+1];
myarray[j+1]:=k;
end;
end ;
end;
end;
for i:=0 to 4do
begin
Memo1.Lines.Add('{'+inttostr(myarray[0])+','+inttostr(myarray[1])+','
+inttostr(myarray[2])+','+inttostr(myarray[3])+','
+inttostr(myarray[4])+'}');
end;

end;
 
一个表不可能按你的要求排,除非从这个表的数据按列抽到别的地方去.
你看第一列已排好了,每二列的12再放到尾,那第一列的2已会到尾
1 3 5 7 7
2 12 5 0 2
3 3 5 7 7
4 0 2 2 8
5 12 7 0 8
 
我的方法很是笨,再想快捷通用的方法。
 
program Project1;
{$APPTYPE CONSOLE}
type
TArr5 = array [1..5] of Integer;
TArr55 = array [1..5] of TArr5;
const
Data: TArr55 = ((1, 3, 5, 7, 7),
(2, 12, 5, 0, 2),
(3, 3, 5, 7, 7),
(4, 0, 2, 2, 8),
(5, 12, 7, 0, 8));
function Compare(const a, b: TArr5): Integer;
var
i: Integer;
Flag: Integer;
begin
Flag:=-1;
for i:=2 to 5do
begin
Flag:=-Flag;
if (Flag*a)>(Flag*b) then
begin
Result:=1;
Exit
end
else
if (Flag*a)<(Flag*b) then
begin
Result:=-1;
Exit
end
end;
if a[1]>b[1] then
Result:=1
else
if a[1]<b[1] then
Result:=-1
else
Result:=0
end;

procedure Swap(var a, b: TArr5);
var
i: Integer;
t: Integer;
begin
for i:=1 to 5do
begin
t:=a;
a:=b;
b:=t
end
end;

var
i, j: Integer;
t: TArr5;
d: TArr55;
begin
Move(Data, d, SizeOf(TArr55));
for i:=1 to 4do
for j:=i+1 to 5do
if Compare(d, d[j])<0 then
Swap(d, d[j]);
for i:=1 to 5do
Write(d[i, 1]: 3);
ReadLn
end.
 
感谢xingxin00,我当时也用二维数组做的,但发现不行,现在在用5维数组做,初步在用递归,还没成功,希望能对所有非序号列进行排序。
 
对第二列的排序结果应该是:
{2,12,5,0,2}
{5,12,7,0,8}
{3,3,5,7,7}
{1,3,5,7,7}
{4,0,2,2,8}
对第三列的排序结果是:
5 12 7 0 8
3 3 5 7 7
1 3 5 7 7
2 12 5 0 2
4 0 2 2 8
对第四列的排序结果是:(对第四列来说,排序后推第二列没有了,这时就得循环到第二列进行比较,即排序时对第四列,第五列和第二列按前面的要求进行排序)
3 3 5 7 7
1 3 5 7 7
4 0 2 2 8
2 12 5 0 2
5 12 7 0 8
对第五裂的排序结果是:(对第五列来说,排序后推的二列都没有了,这时就这时就得循环到第二列和第三列进行比较,即排序时对第五列,第二列和第三列按前面的要求进行排序
4 0 2 2 8
5 12 7 0 8
3 3 5 7 7
1 3 5 7 7
2 12 5 0 2
 
const
Data:array [1..5,1..5] of byte= ((1, 3, 5, 7, 7),
(2, 12, 5, 0, 2),
(3, 3, 5, 7, 7),
(4, 0, 2, 2, 8),
(5, 12, 7, 0, 8));
var
msStr:array [1..5] of string[15];
i1,i2.i3:byte;
ms:string[15];
ii:integr;
begin
for i1:=1 to 5do
begin
str(Data[i1,2]:3,ms);
// 大
msStr[i1]:=ms;
str(Data[i1,3] xor 255:3,ms);
// 小
msStr[i1]:=msStr[i1]+ms;
str(Data[i1,4]:3,ms);
// 大
msStr[i1]:=msStr[i1]+ms;
str(Data[i1,1]:3,ms);
// 序号大
msStr[i1]:=msStr[i1]+ms;
end;
for i1:=1 to 4do
begin
i3:=i1;
for i2:=i1+1 to 5do
if msStr[i3]<msStr[i2] then
i3:=i2;
if i3<>i1 then
begin
ms:=msStr[i3];
msStr[i3]:=msStr[i1];
msStr[i1]:=ms;
end;
end;

for i1:=1 to 5do
begin
str(copy(msStr[i1],Length(msStr[i1]),1),i2,ii);
for i3:=1 to 5do
write(Data[i2,i3]:3);
writeln;
end;
end.
 
多重排序么,呵呵,很简单的
可以去我的BLOG看看,那里有详细的算法描述,还是使用的快速排序:
http://blog.csdn.net/design1
 
我改进了一下,添加了一个edit控件,输入(1-4),代表按第几列排序(不包含序号列),但结果有点出入,是你的逻辑关系表达不是很清楚,但你可以参考修改一下。
(所有控件 edit button memo)
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
myar=array[0..4,0..4]of integer;
//自己定义5*5矩阵
function paixu(var myarray:myar;
var x:integer): myar ;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);

var
myarray:myar;//array[0..4,0..4] of integer;
i,j,k,m,n:integer;
begin
myarray[0][0]:=1;
myarray[0][1]:=3;
myarray[0][2]:=5;
myarray[0][3]:=7;
myarray[0][4]:=7;
myarray[1][0]:=2;
myarray[1][1]:=12;
myarray[1][2]:=5;
myarray[1][3]:=0;
myarray[1][4]:=2;
myarray[2][0]:=3;
myarray[2][1]:=3;
myarray[2][2]:=5;
myarray[2][3]:=7;
myarray[2][4]:=7;
myarray[3][0]:=4;
myarray[3][1]:=0;
myarray[3][2]:=2;
myarray[3][3]:=2;
myarray[3][4]:=8;
myarray[4][0]:=5;
myarray[4][1]:=12;
myarray[4][2]:=7;
myarray[4][3]:=0;
myarray[4][4]:=8;
n:=strtoint(edit1.Text);
paixu(myarray,n);
for i:=0 to 4do
begin
Memo1.Lines.Add('{'+inttostr(myarray[0])+','+inttostr(myarray[1])+','
+inttostr(myarray[2])+','+inttostr(myarray[3])+','
+inttostr(myarray[4])+'}');
end;

end;

{**********************************}
{* 功能:  实现按某列进行排序*}
{* 函数名称:paixu *}
{* 变量:  myar 和 interger *}
function paixu( var myarray:myar;
var x:integer): myar ;
var
i,j,k,m:integer;
begin
if(x<=2) then
begin
for j:=0 to 4do
begin
for m:=j+1 to 4do
begin
if myarray[j][x]<myarray[m][x] then
begin
for i:=0 to 4do
begin
k:=myarray[j];
myarray[j]:=myarray[m];
myarray[m]:=k;
end;
end
else
if (myarray[j][x]=myarray[m][x])
and (myarray[j][x+1]>myarray[m][x+1])then
begin
for i:=0 to 4do
begin
k:=myarray[j];
myarray[j]:=myarray[m];
myarray[m]:=k;
end ;
end
else
if (myarray[j][x]=myarray[m][x])
and (myarray[j][x+1]=myarray[m][x+1])
and (myarray[j][x+2]<myarray[m][x+2])then
begin
for i:=0 to 4do
begin
k:=myarray[j];
myarray[j]:=myarray[m];
myarray[j+1]:=k;
end;
end
else
if (myarray[j][x]=myarray[m][x])
and (myarray[j][x+1]=myarray[m][x+1])
and (myarray[j][x+2]=myarray[m][x+2])
and (myarray[j][0]<myarray[m][0])then
begin
for i:=0 to 4do
begin
k:=myarray[j];
myarray[j]:=myarray[m];
myarray[m]:=k;
end;
end ;
end;
result:=myarray;
end;
end
else
if (x=3) then
begin
for j:=0 to 4do
begin
for m:=j+1 to 4do
begin
if myarray[j][x]<myarray[m][x] then
begin
for i:=0 to 4do
begin
k:=myarray[j];
myarray[j]:=myarray[m];
myarray[m]:=k;
end;
end
else
if (myarray[j][x]=myarray[m][x])
and (myarray[j][x+1]>myarray[m][x+1])then
begin
for i:=0 to 4do
begin
k:=myarray[j];
myarray[j]:=myarray[m];
myarray[m]:=k;
end ;
end
else
if (myarray[j][x]=myarray[m][x])
and (myarray[j][x+1]=myarray[m][x+1])
and (myarray[j][x-2]<myarray[m][x-2])then
begin
for i:=0 to 4do
begin
k:=myarray[j];
myarray[j]:=myarray[m];
myarray[m]:=k;
end;
end
else
if (myarray[j][x]=myarray[m][x])
and (myarray[j][x+1]=myarray[m][x+1])
and (myarray[j][x-2]=myarray[m][x-2])
and (myarray[j][0]<myarray[m][0])then
begin
for i:=0 to 4do
begin
k:=myarray[j];
myarray[j]:=myarray[m];
myarray[m]:=k;
end;
end ;
end;
result:=myarray;
end;
end
else
if (x=4) then
begin
for j:=0 to 4do
begin
for m:=j+1 to 4do
begin
if myarray[j][x]<myarray[m][x] then
begin
for i:=0 to 4do
begin
k:=myarray[j];
myarray[j]:=myarray[m];
myarray[m]:=k;
end;
end;

if (myarray[j][x]=myarray[m][x])
and (myarray[j][x-3]>myarray[m][x-3])then
begin
for i:=0 to 4do
begin
k:=myarray[j];
myarray[j]:=myarray[m];
myarray[m]:=k;
end ;
end
else
if (myarray[j][x]=myarray[m][x])
and (myarray[j][x-3]=myarray[m][x-3])
and (myarray[j][x-2]<myarray[m][x-2])then
begin
for i:=0 to 4do
begin
k:=myarray[j];
myarray[j]:=myarray[m];
myarray[j+1]:=k;
end;
end
else
if (myarray[j][x]=myarray[m][x])
and (myarray[j][x-3]=myarray[m][x-2])
and (myarray[j][x-2]=myarray[m][x-2])
and (myarray[j][0]>myarray[m][0])then
begin
for i:=0 to 4do
begin
k:=myarray[j];
myarray[j]:=myarray[m];
myarray[m]:=k;
end;
end ;
end;
result:=myarray;
end;
end;
end;
end.
 
呵呵,这是典型的多重排序问题,偶最近正好研究这些东东,
用快速排序法实现了,支持多种类型的排序,我试过了,完全可以达到你想要的效果!速度也不错,呵呵,共享下吧!
下面是使用代码:
procedure TForm1.Button1Click(Sender: TObject);
var
xsl:TXSortList;
xs :TXSort;
sp:TSortParams;
sl:TSortedList;
i:Integer;
s:string;
begin
xsl := TXSortList.create;
xs := xsl.NewXSort;
xs.V1:=1;
xs.V2:=3;
xs.V3:=5;
xs.V4:=7;
xs.V5:=7;
xs := xsl.NewXSort;
xs.V1:=2;
xs.V2:=12;
xs.V3:=5;
xs.V4:=0;
xs.V5:=2;
xs := xsl.NewXSort;
xs.V1:=3;
xs.V2:=3;
xs.V3:=5;
xs.V4:=7;
xs.V5:=7;
xs := xsl.NewXSort;
xs.V1:=4;
xs.V2:=0;
xs.V3:=2;
xs.V4:=2;
xs.V5:=8;
xs := xsl.NewXSort;
xs.V1:=5;
xs.V2:=12;
xs.V3:=7;
xs.V4:=0;
xs.V5:=8;
//sp := TSortParams.Create;
sp.SortType := stDown;sp.Ident := dpt_XSortV1;
xsl.SortParamList.Add(sp);
sp := TSortParams.Create;
sp.SortType := stDown;sp.Ident := dpt_XSortV2;
xsl.SortParamList.Add(sp);
sp := TSortParams.Create;
sp.SortType := stUp;sp.Ident := dpt_XSortV3;
xsl.SortParamList.Add(sp);
sp := TSortParams.Create;
sp.SortType := stDown;sp.Ident := dpt_XSortV4;
xsl.SortParamList.Add(sp);
sp := TSortParams.Create;
sp.SortType := stUp;sp.Ident := dpt_XSortV5;
xsl.SortParamList.Add(sp);
sl := xsl.Sortsby(xsl.SortParamList,xsl.DefaultFilterResult);
for i := Low(sl) to High(sl)do
begin
s := IntToStr(xsl.Items[sl].V1)+' '+
IntToStr(xsl.Items[sl].V2)+' '+
IntToStr(xsl.Items[sl].V3)+' '+
IntToStr(xsl.Items[sl].V4)+' '+
IntToStr(xsl.Items[sl].V5);
Memo1.Lines.Add(s);
end;
end;
 
呵呵,上面是不是看的云里雾里的,真正的算法单元文件在下面,由于是一个通用文件,所以代码比较多,直接拷贝下来使用就可以了,^_^,具体有什么问题可以到我的博客给我留言交流!
http://blog.csdn.net/design1
{*******************************************************}
//
// 对象模板:完成数据在内存中的组织(基于DesignOne创建)
// 其中: TBaseObject是所有数据对象的基类
// TBaseObjectList是所有数据对象集合的基类,数据对象集合负责数据对象的管理
// TController是一个事件控制器,负责操作完成后的通知
// TControllers对多个TController进行管理,以完成事件的广播
// TDataFlow负责数据流的多步处理
// TModelData负责完成以上各对象的初始化,提供一个数据对象的入口点,
// 系统一般从实例化类的对象开始
//
{*******************************************************}

unit ModelObject;
interface
uses
Classes,Sysutils,Windows;
type
TFilteredList = array of Integer;
TSortedList = array of Integer;
TSortedList2 = array of TSortedList;
TFilterOperation = (foMore,foMoreandEqual,foLess,foLessandEqual,foEqual,foNotEqual,foLike);
TSortType = (stUp,stDown);
TFilterShip =(fsAnd,fsOr);
type
TPropertyIdent=class
Ident:Integer;
end;
TFilterParams=class(TPropertyIdent)
public
Operation :TFilterOperation;
Ship:TFilterShip;
Value:Variant;
end;
TSortParams=class(TPropertyIdent)
public
SortType:TSortType;
end;

type
TBaseObject =class;
TBaseObjectList=class;
TBaseObject =class
private
FObjectType: integer;
FAction: Integer;
FChangedNotify :boolean;
FObserverlist:TList;
procedure NotifyObserver(PropertyIdent:integer);
//发出更改通知
public
constructor create;
destructor Destroy;override;
procedure Attach(AObserver:TBaseObjectList);
procedure Detach(AObserver:TBaseObjectList);
property ObjectType : integer read FObjectType write FObjectType;
property Action :Integer read FAction write FAction;
property ChangedNotify :boolean read FChangedNotify write FChangedNotify default True;
end;

TBaseObjectList=class
private
FList:TList;
FFilterParamList: TList;
FSortParamList: TList;
function Compare(AParams:TSortParams;ADataObject1,ADataObject2:pointer):Integer;
function Equal(AParams:TSortParams;ADataObject1,ADataObject2:pointer):Boolean;
procedure QuickSort(AParams:TSortParams;L, R: Integer;SortList: TSortedList);
function Filter2By(AShip:TFilterShip;AFilters1, AFilters2:TFilteredList):TFilteredList;
protected
procedure GetCompareValue(AParams: TFilterParams;ADataObject:pointer;
var datavalue,paramvalue:Variant);overload;virtual;abstract;
procedure GetCompareValue(AParams: TSortParams;ADataObject1,ADataObject2:pointer;
var datavalue1,datavalue2:Variant);overload;virtual;abstract;
public
constructor create;
destructor Destroy;override;
procedure Update(AObject:TBaseObject;PropertyIdent:integer);virtual;abstract;
function DefaultFilterResult: TFilteredList;
function FiltersBy(AParamsList: TList): TFilteredList;
//搜索
function FilterBy(AParams:TFilterParams):TFilteredList;
function Sortsby(ASortParamsList: TList;AFilters:TFilteredList):TSortedList;
//快速排序
function Sortby(ASortParams: TSortParams;AFilters:TFilteredList):TSortedList;
property FilterParamList:TList read FFilterParamList;
//搜索参数列表,装载TFilterParams类型的参数
property SortParamList:TList read FSortParamList;
//排序参数列表,装载TSortParams类型的参数
end;
const
PropertyOffset =1000;
//对象,对象属性唯一标识符
do
t_XSort = 0;
//XSort

dpt_XSortV1 =0*PropertyOffset+0;
//V1

dpt_XSortV2 =0*PropertyOffset+1;
//V2

dpt_XSortV3 =0*PropertyOffset+2;
//V3

dpt_XSortV4 =0*PropertyOffset+3;
//V4

dpt_XSortV5 =0*PropertyOffset+4;
//V5


type
TXSort = class;
TXSortList = class;

TDataFlow =class;
TController =class;
TControllers =class(TList)
public
destructor Destroy;
override;
end;

TXSort = class(TBaseObject) //XSort
private



fV1 : Integer;

fV2 : Integer;

fV3 : Integer;

fV4 : Integer;

fV5 : Integer;


procedure SetV1(const Value : Integer);

procedure SetV2(const Value : Integer);

procedure SetV3(const Value : Integer);

procedure SetV4(const Value : Integer);

procedure SetV5(const Value : Integer);

public
constructor create;
destructor Destroy;override;
procedure Cloneto(ADest:TXSort;ADeepClone:Boolean);
function GetDataBuffer(var ABuffer: PChar;
var len: integer): Boolean;
function GetDataObject(ABuffer: PChar): Boolean;



property V1 : Integer read fV1 write SetV1;
//V1

property V2 : Integer read fV2 write SetV2;
//V2

property V3 : Integer read fV3 write SetV3;
//V3

property V4 : Integer read fV4 write SetV4;
//V4

property V5 : Integer read fV5 write SetV5;
//V5

end;

TOnInsertXSortEvent =procedure(index:integer;AData: TXSort) of Object;
TOnAddXSortEvent =procedure(AData: TXSort) of Object;
TOnDeleteXSortEvent=procedure(AData: TXSort) of Object;
TOnChangeXSortEvent=procedure(AData: TXSort) of Object;
TXSortList=class(TBaseObjectList)
private
FDataFlow:TDataFlow;
FControllers : TControllers;
FAddXSortEvent: TOnAddXSortEvent;
FChangeXSortEvent: TOnChangeXSortEvent;
FDeleteXSortEvent: TOnDeleteXSortEvent;
FInsertXSortEvent: TOnInsertXSortEvent;
function GetCount: integer;
function GetItems(index: integer): TXSort;
procedure SetItems(index: integer;
const Value: TXSort);
procedure SetDataFlow(const Value: TDataFlow);
procedure SetControllers(const Value: TControllers);
protected
procedure GetCompareValue(AParams: TFilterParams;ADataObject:pointer;
var datavalue,paramvalue:Variant);overload;override;
procedure GetCompareValue(AParams: TSortParams;ADataObject1,ADataObject2:pointer;
var datavalue1,datavalue2:Variant);overload;override;

public
destructor Destroy;override;
function NewXSort: TXSort;
//新建立一个XSort对象
function AddXSort(AXSort: TXSort):integer;
//添加一个XSort对象
procedure DeleteXSort(index:integer);
//删除一个XSort对象
function RemoveXSort(AXSort: TXSort):integer;
//移除一个XSort对象
function Indexof(AXSort: TXSort):integer;
procedure ClearList;
procedure Cloneto(ADest:TXSortList;ADeepClone:Boolean);
//拷贝一个XSort对象
procedure Insert(index:Integer;AXSort: TXSort);
//插入一个XSort对象
procedure Exchange(index1,index2:Integer);
procedure Update(AObject:TBaseObject;PropertyIdent:integer);override;

function FindbyV1(AV1:Integer):TXSort;
//查找V1 = AV1的对象,返回第一个

function FindbyV2(AV2:Integer):TXSort;
//查找V2 = AV2的对象,返回第一个

function FindbyV3(AV3:Integer):TXSort;
//查找V3 = AV3的对象,返回第一个

function FindbyV4(AV4:Integer):TXSort;
//查找V4 = AV4的对象,返回第一个

function FindbyV5(AV5:Integer):TXSort;
//查找V5 = AV5的对象,返回第一个

property Count: integer read GetCount;
property Items[index:integer]: TXSort read GetItems write SetItems;
property OnInsertXSortEvent :TOnInsertXSortEvent read FInsertXSortEvent write FInsertXSortEvent;
property OnAddXSortEvent :TOnAddXSortEvent read FAddXSortEvent write FAddXSortEvent;
property OnDeleteXSortEvent :TOnDeleteXSortEvent read FDeleteXSortEvent write FDeleteXSortEvent;
property OnChangeXSortEvent :TOnChangeXSortEvent read FChangeXSortEvent write FChangeXSortEvent;
property DataFlow:TDataFlow read FDataFlow write SetDataFlow;
//数据流
property Controllers : TControllers read FControllers write SetControllers;
//事件流控制
end;

TDataFlow =class
procedure AfterAddXSort(AXSort: TXSort);virtual;
//在加入一个XSort 后的处理
procedure AfterDeleteXSort(AXSort: TXSort);virtual;
//在删除一个XSort 后的处理

procedure AfterUpdateXSort_V1(AXSort: TXSort);virtual;
//在更改一个XSort 的V1后的处理

procedure AfterUpdateXSort_V2(AXSort: TXSort);virtual;
//在更改一个XSort 的V2后的处理

procedure AfterUpdateXSort_V3(AXSort: TXSort);virtual;
//在更改一个XSort 的V3后的处理

procedure AfterUpdateXSort_V4(AXSort: TXSort);virtual;
//在更改一个XSort 的V4后的处理

procedure AfterUpdateXSort_V5(AXSort: TXSort);virtual;
//在更改一个XSort 的V5后的处理


end;

TController =class
private
fOnAddXSort: TOnAddXSortEvent;
fOnInsertXSort: TOnInsertXSortEvent;
fOnDeleteXSort: TOnDeleteXSortEvent;
fOnChangeXSort: TOnChangeXSortEvent;

public
property OnAddXSort : TOnAddXSortEvent read fOnAddXSort write fOnAddXSort;
//成功添加一个XSort 对象后,发出添加通知
property OnInsertXSort : TOnInsertXSortEvent read fOnInsertXSort write fOnInsertXSort;
//成功插入一个XSort 对象后,发出插入通知
property OnDeleteXSort : TOnDeleteXSortEvent read fOnDeleteXSort write fOnDeleteXSort;
//成功删除一个XSort 对象后,发出删除通知
property OnChangeXSort: TOnChangeXSortEvent read fOnChangeXSort write fOnChangeXSort;
//成功修改一个XSort 对象的值后,发出改变通知

end;

//整个数据的管理入口
TModelData = class
private
FDataFlow: TDataflow;
fControllers :TControllers;

FXSortList: TXSortList;

procedure SetDataFlow(const Value : TDataflow);
public
constructor Create;
destructor Destroy;
override;
property DataFlow :TDataflow read FDataFlow write SetDataFlow;
property Controllers :TControllers read FControllers;
property XSortList : TXSortList read FXSortList;

end;

implementation
{ TBaseObject }
procedure TBaseObject.Attach(AObserver: TBaseObjectList);
begin
FObserverlist.Add(AObserver);
end;

constructor TBaseObject.create;
begin
FObserverlist:= TList.Create;
FChangedNotify := True;
end;

destructor TBaseObject.Destroy;
begin
FObserverlist.Free;
inherited;
end;

procedure TBaseObject.Detach(AObserver: TBaseObjectList);
begin
FObserverlist.Remove(AObserver);
end;

procedure TBaseObject.NotifyObserver(PropertyIdent:integer);
var
i:integer;
obs:TBaseObjectList;
begin
for i := 0 to FObserverlist.Count-1do
begin
obs := FObserverlist.Items;
obs.Update(Self,PropertyIdent);
end;
end;

{TDataFlow}
procedure TDataFlow.AfterAddXSort(AXSort: TXSort);
begin
end;
procedure TDataFlow.AfterDeleteXSort(AXSort: TXSort);
begin
end;

procedure TDataFlow.AfterUpdateXSort_V1(AXSort: TXSort);
begin
end;

procedure TDataFlow.AfterUpdateXSort_V2(AXSort: TXSort);
begin
end;

procedure TDataFlow.AfterUpdateXSort_V3(AXSort: TXSort);
begin
end;

procedure TDataFlow.AfterUpdateXSort_V4(AXSort: TXSort);
begin
end;

procedure TDataFlow.AfterUpdateXSort_V5(AXSort: TXSort);
begin
end;


destructor TControllers.Destroy;
var
C:TController;
begin
while Count>0do
begin
c := Items[0];
c.Free;
Delete(0);
end;
inherited;
end;

constructor TBaseObjectList.create;
begin
inherited;
FList := TList.Create;
FFilterParamList := TList.Create;
FSortParamList := TList.Create;
end;

destructor TBaseObjectList.Destroy;
begin
FList.Free;
FFilterParamList.Free;
FSortParamList.Free;
inherited;
end;

function TBaseObjectList.DefaultFilterResult:TFilteredList;
var
i: integer;
begin
SetLength(Result,0);
for i := 0 to fList.Count - 1do
begin
SetLength(Result,i+1);
Result := i;
end;
end;

function TBaseObjectList.FilterBy(AParams: TFilterParams): TFilteredList;
function Includeit(ADataObject:pointer):Boolean;
var
datavalue,paramvalue:Variant;
begin
GetCompareValue(AParams,ADataObject,datavalue,paramvalue);
case AParams.Operation of
foMore: Result := datavalue>paramvalue;
foLess: Result := datavalue<paramvalue;
foEqual:Result := datavalue=paramvalue;
foMoreandEqual:Result := datavalue>=paramvalue;
foLessandEqual:Result := datavalue<=paramvalue;
foNotEqual:Result := datavalue<>paramvalue;
foLike : Result := Pos(paramvalue,datavalue)>0;
end;
end;
var
i,j: integer;
begin
j := 0;
SetLength(Result,j);
for i := 0 to Flist.Count - 1do
begin
if Includeit(Flist.Items) then
begin
Inc(j);
SetLength(Result,j);
Result[j-1] := i;
end;
end;
end;

function TBaseObjectList.Filter2By(AShip:TFilterShip;AFilters1, AFilters2:TFilteredList):TFilteredList;
var
i,j,k: integer;
function Exists(AFilters:TFilteredList;value:Integer):Boolean;
var
n:Integer;
begin
Result := false;
for n := Low(AFilters) to High(AFilters)do
begin
if AFilters[n]= value then
begin
Result := true;
Break;
end;
end;
end;
begin
k := 0;
SetLength(Result,k);
case AShip of
fsAnd :
begin
for i := Low(AFilters1) to High(AFilters1)do
begin
for j:= Low(AFilters2) to High(AFilters2)do
begin
if AFilters1 = AFilters2[j] then
begin
Inc(k);
SetLength(Result,k);
Result[k-1] := i;
end;
end;
end;
end;
fsOr :
begin
for i := Low(AFilters1) to High(AFilters1)do
begin
Inc(k);
SetLength(Result,k);
Result[k-1] := i;
end;
for i := Low(AFilters2) to High(AFilters2)do
begin
if not Exists(AFilters1,AFilters2) then
begin
Inc(k);
SetLength(Result,k);
Result[k-1] := i;
end;
end;
end;
end;
end;

function TBaseObjectList.FiltersBy(AParamsList:TList):TFilteredList;
var
i:Integer;
AParams1,AParams2:TFilterParams;
begin
SetLength(Result,0);
if AParamsList.Count=0 then
begin
Result := DefaultFilterResult;
Exit;
end;
Result := FilterBy(AParamsList.Items[0]);
for i := 1 to AParamsList.Count-1do
Result := Filter2By(TFilterParams(AParamsList.Items[i-1]).Ship,
Result,FilterBy(AParamsList.Items));
end;

function TBaseObjectList.Sortsby(ASortParamsList: TList;AFilters:TFilteredList): TSortedList;
var
i:Integer;
function ReGroup(ASortList:TSortedList;ASortParams:TSortParams):TSortedList2;
var
j,k,n:integer;
begin
j := 0 ;n := 0;
SetLength(Result,j);
if (High(ASortList)-Low(ASortList)<0) then
Exit;
Inc(j);
SetLength(Result,j);
Inc(n);
SetLength(Result[j-1],n);
Result[j-1][n-1] := ASortList[0];
for k := Low(ASortList)+1 to High(ASortList)do
begin
if not Equal(ASortParams,FList.Items[ASortList[k]],FList.Items[ASortList[k-1]]) then
begin
n := 0 ;
inc(j);
SetLength(Result,j);
end;
Inc(n);
SetLength(Result[j-1],n);
Result[j-1][n-1] := ASortList[k];
end;
end;

function Sort(ASortList:TSortedList;Index:Integer):TSortedList;
var
m,l,h:Integer;
SortedList2 : TSortedList2;
SortList:TSortedList;
begin
h := 0 ;
SetLength(Result,0);
for h := Low(ASortList) to High(ASortList)do
begin
SetLength(Result,h+1);
Result[h] := ASortList[h];
end;
if Index>=ASortParamsList.Count-1 then
Exit;
h := 0;
SetLength(Result,h);
SortedList2 := ReGroup(ASortList,ASortParamsList.items[Index]);
for m := Low(sortedlist2) to High(sortedlist2)do
begin
SortList := sortedlist2[m];
QuickSort(ASortParamsList.items[Index+1],Low(SortList),High(SortList),SortList);
SortList := Sort(SortList,Index+1);
for l := Low(SortList) to High(SortList)do
begin
Inc(h);
SetLength(Result,h);
Result[h-1] := SortList[l];
end;
end;
end;
begin
i := 0 ;
SetLength(Result,0);
for i := Low(AFilters) to High(AFilters)do
begin
SetLength(Result,i+1);
Result := AFilters;
end;
if ASortParamsList.Count=0 then
Exit;
QuickSort(ASortParamsList.items[0],Low(Result),High(Result),Result);
Result := Sort(Result,0);
end;

procedure TBaseObjectList.QuickSort(AParams:TSortParams;
L, R: Integer;SortList: TSortedList);
var
I, J: Integer;
P: Pointer;
T:Integer;
begin
if High(SortList)-low(SortList)<1 then
Exit;
repeat
I := L;
J := R;
P := FList.Items[SortList[(L + R) shr 1]];
repeat
while (Compare(AParams,FList.Items[SortList], P)<0) do
Inc(I);
while (Compare(AParams,FList.Items[SortList[J]], P)>0) do
Dec(J);
if I <= J then
begin
T := SortList;
SortList := SortList[J];
SortList[J] := T;
Inc(I);
Dec(J);
end;
until I > J;
if L < J then
QuickSort(AParams, L, J,SortList);
L := I;
until I >= R;
end;

function TBaseObjectList.Compare(AParams: TSortParams;
ADataObject1,
ADataObject2: pointer): integer;
var
datavalue1,datavalue2:Variant;
begin
getcomparevalue(AParams,ADataObject1,ADataObject2,datavalue1,datavalue2);
case AParams.SortType of
stUp : if datavalue1>datavalue2 then
Result := 1 else
if datavalue1=datavalue2 then
Result := 0 else
Result := -1;
stDown :if datavalue1<datavalue2 then
Result := 1 else
if datavalue1=datavalue2 then
Result := 0 else
Result := -1;
end;
end;

function TBaseObjectList.Equal(AParams: TSortParams;
ADataObject1,
ADataObject2: pointer): Boolean;
var
datavalue1,datavalue2:Variant;
begin
getcomparevalue(AParams,ADataObject1,ADataObject2,datavalue1,datavalue2);
Result := datavalue1=datavalue2;
end;

function TBaseObjectList.Sortby(ASortParams: TSortParams;
AFilters: TFilteredList): TSortedList;
var
i:Integer;
begin
i := 0 ;
SetLength(Result,0);
for i := Low(AFilters) to High(AFilters)do
begin
SetLength(Result,i+1);
Result := AFilters;
end;
QuickSort(ASortParams,Low(Result),High(Result),Result);
end;


constructor TXSort.create;
begin
inherited;
ObjectType :=do
t_XSort;


fV1 := 0;

fV2 := 0;

fV3 := 0;

fV4 := 0;

fV5 := 0;

end;

destructor TXSort.Destroy;
begin

inherited;
end;

procedure TXSort.Cloneto(ADest:TXSort;ADeepClone:Boolean);
begin

ADest.V1 := fV1;

ADest.V2 := fV2;

ADest.V3 := fV3;

ADest.V4 := fV4;

ADest.V5 := fV5;

if ADeepClone then
begin

end;
end;

function TXSort.GetDataBuffer(var ABuffer:PChar;var len:integer):Boolean;
var
alen:Integer;
begin
Result := False;
len := 0;

alen := Sizeof(V1);
CopyMemory(@ABuffer[len],@alen,SizeOf(alen));
CopyMemory(@ABuffer[len+SizeOf(alen)],@V1,alen);
len := len+alen+SizeOf(alen);

alen := Sizeof(V2);
CopyMemory(@ABuffer[len],@alen,SizeOf(alen));
CopyMemory(@ABuffer[len+SizeOf(alen)],@V2,alen);
len := len+alen+SizeOf(alen);

alen := Sizeof(V3);
CopyMemory(@ABuffer[len],@alen,SizeOf(alen));
CopyMemory(@ABuffer[len+SizeOf(alen)],@V3,alen);
len := len+alen+SizeOf(alen);

alen := Sizeof(V4);
CopyMemory(@ABuffer[len],@alen,SizeOf(alen));
CopyMemory(@ABuffer[len+SizeOf(alen)],@V4,alen);
len := len+alen+SizeOf(alen);

alen := Sizeof(V5);
CopyMemory(@ABuffer[len],@alen,SizeOf(alen));
CopyMemory(@ABuffer[len+SizeOf(alen)],@V5,alen);
len := len+alen+SizeOf(alen);

Result := True;
end;

function TXSort.GetDataObject(ABuffer: PChar): Boolean;
var
alen:Integer;
offset:integer;
begin
Result := False;
offset := 0;

CopyMemory(@alen,@ABuffer[offset],SizeOf(alen));
CopyMemory(@V1,@ABuffer[offset+SizeOf(alen)],alen);
offset := alen+SizeOf(alen);

CopyMemory(@alen,@ABuffer[offset],SizeOf(alen));
CopyMemory(@V2,@ABuffer[offset+SizeOf(alen)],alen);
offset := alen+SizeOf(alen);

CopyMemory(@alen,@ABuffer[offset],SizeOf(alen));
CopyMemory(@V3,@ABuffer[offset+SizeOf(alen)],alen);
offset := alen+SizeOf(alen);

CopyMemory(@alen,@ABuffer[offset],SizeOf(alen));
CopyMemory(@V4,@ABuffer[offset+SizeOf(alen)],alen);
offset := alen+SizeOf(alen);

CopyMemory(@alen,@ABuffer[offset],SizeOf(alen));
CopyMemory(@V5,@ABuffer[offset+SizeOf(alen)],alen);
offset := alen+SizeOf(alen);

Result := True;
end;


procedure TXSort.SetV1(const Value: Integer);
begin
if Value = fV1 then
Exit;
FV1 := Value;
if FChangedNotify then
NotifyObserver(dpt_XSortV1);
end;

procedure TXSort.SetV2(const Value: Integer);
begin
if Value = fV2 then
Exit;
FV2 := Value;
if FChangedNotify then
NotifyObserver(dpt_XSortV2);
end;

procedure TXSort.SetV3(const Value: Integer);
begin
if Value = fV3 then
Exit;
FV3 := Value;
if FChangedNotify then
NotifyObserver(dpt_XSortV3);
end;

procedure TXSort.SetV4(const Value: Integer);
begin
if Value = fV4 then
Exit;
FV4 := Value;
if FChangedNotify then
NotifyObserver(dpt_XSortV4);
end;

procedure TXSort.SetV5(const Value: Integer);
begin
if Value = fV5 then
Exit;
FV5 := Value;
if FChangedNotify then
NotifyObserver(dpt_XSortV5);
end;

destructor TXSortList.Destroy;
begin
ClearList;
inherited;
end;

procedure TXSortList.ClearList;
var
Data : TXSort;
begin
while FList.Count>0do
begin
Data := FList.Items[0];
Data.Detach(Self);
data.Free;
FList.Delete(0);
end;
end;

function TXSortList.AddXSort(AXSort: TXSort): integer;
var
i:integer;
C : TController;
begin
Result := FList.Add(AXSort);
AXSort.Attach(Self);
if Assigned(FDataFlow) then
FDataFlow.AfterAddXSort(AXSort);
if Assigned(FControllers) then
for i := 0 to FControllers.Count-1do
begin
C := FControllers.Items;
if Assigned(C.OnAddXSort) then
C.OnAddXSort(AXSort);
end;
if Assigned(FAddXSortEvent) then
FAddXSortEvent(AXSort);
end;

procedure TXSortList.DeleteXSort(index: integer);
var
i:integer;
C : TController;
begin
TXSort(FList.Items[index]).Detach(Self);
if Assigned(FDataFlow) then
FDataFlow.AfterDeleteXSort(TXSort(FList.Items[index]));
if Assigned(FControllers) then
for i := 0 to FControllers.Count-1do
begin
C := FControllers.Items;
if Assigned(C.OnDeleteXSort) then
C.OnDeleteXSort(FList.Items[index]);
end;
if Assigned(FDeleteXSortEvent) then
FDeleteXSortEvent(FList.Items[index]);
FList.Delete(index);
end;

function TXSortList.GetCount: integer;
begin
Result := FList.Count;
end;

function TXSortList.GetItems(index: integer): TXSort;
begin
Result := FList.Items[Index];
end;

function TXSortList.Indexof(AXSort: TXSort): integer;
begin
Result := FList.IndexOf(AXSort);
end;

function TXSortList.RemoveXSort(AXSort: TXSort): integer;
var
i:integer;
C : TController;
begin
AXSort.Detach(Self);
if Assigned(FDeleteXSortEvent) then
FDeleteXSortEvent(AXSort);
if Assigned(FDataFlow) then
FDataFlow.AfterDeleteXSort(AXSort);
if Assigned(FControllers) then
for i := 0 to FControllers.Count-1do
begin
C := FControllers.Items;
if Assigned(C.OnDeleteXSort) then
C.OnDeleteXSort(AXSort);
end;
Result := FList.Remove(AXSort);
end;

procedure TXSortList.SetItems(index: integer;
const Value: TXSort);
begin
FList.Items[index] := Value;
end;

procedure TXSortList.Cloneto(ADest:TXSortList;ADeepClone:Boolean);
var
i:integer;
AXSort: TXSort;
begin
ADest.ClearList;
for i := 0 to Count-1do
begin
AXSort:=TXSort.create;
ADest.AddXSort(AXSort);
Items.Cloneto(AXSort,ADeepClone);
end;
end;

procedure TXSortList.Insert(index: Integer;
AXSort: TXSort);
var
i:integer;
C : TController;
begin
FList.Insert(index,AXSort);
AXSort.Attach(Self);
if Assigned(FDataFlow) then
FDataFlow.AfterAddXSort(AXSort);
if Assigned(FControllers) then
for i := 0 to FControllers.Count-1do
begin
C := FControllers.Items;
if Assigned(C.OnInsertXSort) then
C.OnInsertXSort(index,AXSort);
end;
if Assigned(FinsertXSortEvent) then
FinsertXSortEvent(index,AXSort);
end;

procedure TXSortList.Exchange(index1, index2: Integer);
begin
FList.Exchange(index1, index2);
end;

function TXSortList.FindbyV1(AV1:Integer):TXSort;
var
i:Integer;
lXSort:TXSort;
begin
Result := nil ;
for i:= 0 to FList.Count-1do
begin
lXSort := FList.Items;
if (lXSort.V1) = (AV1) then
begin
Result := lXSort;
Break;
end;
end;
end;

function TXSortList.FindbyV2(AV2:Integer):TXSort;
var
i:Integer;
lXSort:TXSort;
begin
Result := nil ;
for i:= 0 to FList.Count-1do
begin
lXSort := FList.Items;
if (lXSort.V2) = (AV2) then
begin
Result := lXSort;
Break;
end;
end;
end;

function TXSortList.FindbyV3(AV3:Integer):TXSort;
var
i:Integer;
lXSort:TXSort;
begin
Result := nil ;
for i:= 0 to FList.Count-1do
begin
lXSort := FList.Items;
if (lXSort.V3) = (AV3) then
begin
Result := lXSort;
Break;
end;
end;
end;

function TXSortList.FindbyV4(AV4:Integer):TXSort;
var
i:Integer;
lXSort:TXSort;
begin
Result := nil ;
for i:= 0 to FList.Count-1do
begin
lXSort := FList.Items;
if (lXSort.V4) = (AV4) then
begin
Result := lXSort;
Break;
end;
end;
end;

function TXSortList.FindbyV5(AV5:Integer):TXSort;
var
i:Integer;
lXSort:TXSort;
begin
Result := nil ;
for i:= 0 to FList.Count-1do
begin
lXSort := FList.Items;
if (lXSort.V5) = (AV5) then
begin
Result := lXSort;
Break;
end;
end;
end;

procedure TXSortList.GetCompareValue(AParams: TFilterParams;ADataObject: pointer;
var datavalue,paramvalue:Variant);
var
dataObject : TXSort;
begin
dataObject := ADataObject;
paramvalue := AParams.Value;
case AParams.Ident of

dpt_XSortV1: datavalue := dataObject.V1;

dpt_XSortV2: datavalue := dataObject.V2;

dpt_XSortV3: datavalue := dataObject.V3;

dpt_XSortV4: datavalue := dataObject.V4;

dpt_XSortV5: datavalue := dataObject.V5;

end;

end;

procedure TXSortList.GetCompareValue(AParams: TSortParams;ADataObject1,ADataObject2:pointer;
var datavalue1,datavalue2:Variant);
var
DataObject1,DataObject2 :TXSort;
begin
DataObject1 := ADataObject1;
DataObject2 := ADataObject2;
case AParams.Ident of

dpt_XSortV1:
begin
datavalue1 := DataObject1.V1;
datavalue2 := DataObject2.V1;
end;

dpt_XSortV2:
begin
datavalue1 := DataObject1.V2;
datavalue2 := DataObject2.V2;
end;

dpt_XSortV3:
begin
datavalue1 := DataObject1.V3;
datavalue2 := DataObject2.V3;
end;

dpt_XSortV4:
begin
datavalue1 := DataObject1.V4;
datavalue2 := DataObject2.V4;
end;

dpt_XSortV5:
begin
datavalue1 := DataObject1.V5;
datavalue2 := DataObject2.V5;
end;

end;
end;

function TXSortList.NewXSort: TXSort;
begin
Result := TXSort.create;
AddXSort(Result);
end;

procedure TXSortList.Update(AObject: TBaseObject;PropertyIdent:integer);
var
i:integer;
C : TController;
begin
if Assigned(FDataFlow) then
case PropertyIdent of

dpt_XSortV1 : FDataFlow.AfterUpdateXSort_V1(AObject as TXSort);

dpt_XSortV2 : FDataFlow.AfterUpdateXSort_V2(AObject as TXSort);

dpt_XSortV3 : FDataFlow.AfterUpdateXSort_V3(AObject as TXSort);

dpt_XSortV4 : FDataFlow.AfterUpdateXSort_V4(AObject as TXSort);

dpt_XSortV5 : FDataFlow.AfterUpdateXSort_V5(AObject as TXSort);

end;

if Assigned(FControllers) then
for i := 0 to FControllers.Count-1do
begin
C := FControllers.Items;
if Assigned(C.OnChangeXSort) then
C.OnChangeXSort(AObject as TXSort);
end;
if Assigned(FChangeXSortEvent) then
FChangeXSortEvent(AObject as TXSort);
end;

procedure TXSortList.SetDataFlow(const Value: TDataFlow);
var
i:integer;
lXSort:TXSort;
begin
if FDataFlow=Value then
exit;
FDataFlow := Value;

end;

procedure TXSortList.SetControllers(const Value: TControllers);
var
i:integer;
lXSort:TXSort;
begin
if FControllers=Value then
exit;
FControllers := Value;

end;


constructor TModelData.Create;
begin
fControllers := TControllers.Create;
FXSortList := TXSortList.Create;
FXSortList.Controllers := fControllers;

end;

destructor TModelData.Destroy;
begin

FXSortList.Free;

fControllers.Free;
inherited;
end;

procedure TModelData.SetDataFlow(const Value: TDataflow);
begin
if FDataFlow = Value then
exit;
FDataFlow := Value;

FXSortList.DataFlow := Value;

end;

end.
 
顶一下,楼主有最终结果请贴一下
 
哈哈,又见到老李出手啦:D
对多字段的排序可以考虑用字符串等长拼接,然后再一次性排序:
type
TArr5 = array [1..5] of Integer;
TArr55 = array [1..5] of TArr5;
const
Data: TArr55 = ((1, 3, 5, 7, 7),
(2, 12, 5, 0, 2),
(3, 3, 5, 7, 7),
(4, 0, 2, 2, 8),
(5, 12, 7, 0, 8));
function DataSort(AData: TArr55;
Idx: TArr5;
MinNum, MaxNum: Integer):TArr5;
var
i,j:Integer;
SL:TStringList;
mstr:String;
begin
SL:=TStringList.Create;
for i:=Low(AData) to High(AData)do
begin
mstr:='';
for j:=Low(Idx) to High(Idx)do
begin
if Idx[j]>0 then
mstr:=mstr+IntToHex(AData[Idx[j]]-MinNum,8)
else
if Idx[j]<0 then
mstr:=mstr+IntToHex(MaxNum+MinNum-AData[-Idx[j]],8);
end;
SL.AddObject(mstr,TObject(i));
end;
SL.Sort;
for i:=Low(Result) to High(Result)do
Result:=Integer(SL.Objects[i-1]);
SL.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
I5,Idx:TArr5;
begin
Idx[1]:=-2;
//绝对值表示对应列的序号,大者优先的情况用负数
Idx[2]:=3;
//小者优先用正数
Idx[3]:=-4;
Idx[4]:=-1;
Idx[5]:=0;
//零表示忽略
I5:=DataSort(Data,Idx,0,255);
//0和255表示被排序数值的范围,必须无误给出(算法依此在计算中将数据值归一化为正数并转换为等长字符串)
ShowMessage(Format('%d %d %d %d %d',[I5[1],I5[2],I5[3],I5[4],I5[5]]));
end;
 
design1,你在笑,我在哭,正看你的代码呢,够我喝一壶了啊,呵呵。
 
design1,你贴的这个要不要这么复杂啊.你贴的这个我看了前边的忘了后边的.
 

Similar threads

回复
0
查看
676
万一
回复
0
查看
848
不得闲
D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
后退
顶部