呵呵,上面是不是看的云里雾里的,真正的算法单元文件在下面,由于是一个通用文件,所以代码比较多,直接拷贝下来使用就可以了,^_^,具体有什么问题可以到我的博客给我留言交流!
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
ointer):Integer;
function Equal(AParams:TSortParams;ADataObject1,ADataObject2
ointer):Boolean;
procedure QuickSort(AParams:TSortParams;L, R: Integer;SortList: TSortedList);
function Filter2By(AShip:TFilterShip;AFilters1, AFilters2:TFilteredList):TFilteredList;
protected
procedure GetCompareValue(AParams: TFilterParams;ADataObject
ointer;
var datavalue,paramvalue:Variant);overload;virtual;abstract;
procedure GetCompareValue(AParams: TSortParams;ADataObject1,ADataObject2
ointer;
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
ointer;
var datavalue,paramvalue:Variant);overload;override;
procedure GetCompareValue(AParams: TSortParams;ADataObject1,ADataObject2
ointer;
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(ADataObjectointer):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;
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;
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 ABufferChar;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,ADataObject2ointer;
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.