一个简单的Ｄelphi框架－xDom－１　内存对象

来源：互联网发布：国际数据公司 idc 编辑：程序博客网时间：2024/06/06 04:37
从现在开始,着手实现一个简单而实用的Delphi框架-xDOM,这个框架准备具备以下几个特色:
1 基于DesignOne模板技术设计
2 分层设计,暂时分为对象层,存储层,显示层!
3 完整设计,理想情况下,数据模型设计完成,相应的初始完整代码也能够完成!
4 命名为:xDOM-X Delphi Object Model
基于上述目标，首先实现对象层代码如下：
{*******************************************************}
// 
//   对象模板:完成数据在内存中的组织(基于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;
    function  DefaultFilterResult: 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 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;
//对象,对象属性唯一标识符 
{DesignOne}
{CodeTemplate}
{<Object ObjectMapType=AllObjects>
  dot_[Objectname] = [ObjectIndex];   //[ObjectDisplayName]
   <Property PropertyMapType=AllPropertys ObjectName=[ObjectName]>
   dpt_[Objectname][PropertyName] =[ObjectIndex]*PropertyOffset+[PropertyIndex]; //[PropertyDisplayName]
   </Property>
 </Object>}
{/CodeTemplate}
{/DesignOne}
type
{DesignOne}
{CodeTemplate}
{<Object ObjectMapType=AllObjects>
  T[Objectname] = class;
  T[Objectname]List = class;
 </Object>}
{/CodeTemplate}
{/DesignOne}
  TDataFlow =class;
  TController =class;
  TControllers =class(TList)
  public
    destructor Destroy; override;
  end;
{DesignOne}
{CodeTemplate}
{<Object ObjectMapType=AllObjects>
  T[Objectname] = class(TBaseObject)  //[ObjectDisplayName]
  private
   <ObjectShip ObjectShipMapType=ParentObjects ObjectName=[ObjectName]>
   f[ObjectShipName] : T[ObjectShipName];  //[ObjectShipDisplayName]
   </ObjectShip>
   <ObjectShip ObjectShipMapType=ChildObjects ObjectName=[ObjectName]>
   f[ObjectShipName]List : T[ObjectShipName]List;  //[ObjectShipDisplayName]
   </ObjectShip>
   <Property PropertyMapType=AllPropertys ObjectName=[ObjectName]>
   f[Propertyname] : [VarType];
   </Property>
   <Property PropertyMapType=AllPropertys ObjectName=[ObjectName]>
   procedure Set[Propertyname](const Value : [VarType]);
   </Property>
  public
    constructor create;
    destructor Destroy;override;
    procedure Cloneto(ADest:T[Objectname];ADeepClone:Boolean);
    function GetDataBuffer(var ABuffer: PChar; var len: integer): Boolean;
    function GetDataObject(ABuffer: PChar): Boolean;
    <ObjectShip ObjectShipMapType=ParentObjects ObjectName=[ObjectName]>
    property [ObjectShipName] : T[ObjectShipName] read f[ObjectShipName] write f[ObjectShipName]; //[ObjectShipDisplayName]
   </ObjectShip>
   <ObjectShip ObjectShipMapType=ChildObjects ObjectName=[ObjectName]>
    property [ObjectShipName]List : T[ObjectShipName]List read f[ObjectShipName]List;  //[ObjectShipDisplayName]
   </ObjectShip>
    <Property PropertyMapType=AllPropertys ObjectName=[ObjectName]>
    property [Propertyname] : [VarType] read f[Propertyname] write Set[Propertyname];  //[PropertyDisplayName]
    </Property>
   end;
   TOnInsert[ObjectName]Event   =procedure(index:integer;AData: T[ObjectName]) of Object;
   TOnAdd[ObjectName]Event   =procedure(AData: T[ObjectName]) of Object;
   TOnDelete[ObjectName]Event=procedure(AData: T[ObjectName]) of Object;
   TOnChange[ObjectName]Event=procedure(AData: T[ObjectName]) of Object;
    T[ObjectName]List=class(TBaseObjectList)
    private
      FDataFlow:TDataFlow;
      FControllers : TControllers;
      FAdd[ObjectName]Event: TOnAdd[ObjectName]Event;
      FChange[ObjectName]Event: TOnChange[ObjectName]Event;
      FDelete[ObjectName]Event: TOnDelete[ObjectName]Event;
      FInsert[ObjectName]Event: TOnInsert[ObjectName]Event;
      function GetCount: integer;
      function GetItems(index: integer): T[ObjectName];
      procedure SetItems(index: integer; const Value: T[ObjectName]);
      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  New[ObjectName]: T[ObjectName];     //新建立一个[ObjectDisplayName]对象
      function  Add[ObjectName](A[ObjectName]: T[ObjectName]):integer;  //添加一个[ObjectDisplayName]对象
      procedure Delete[ObjectName](index:integer);                      //删除一个[ObjectDisplayName]对象
      function Remove[ObjectName](A[ObjectName]: T[ObjectName]):integer; //移除一个[ObjectDisplayName]对象
      function  Indexof(A[ObjectName]: T[ObjectName]):integer;
      procedure ClearList;
      procedure Cloneto(ADest:T[ObjectName]List;ADeepClone:Boolean);    //拷贝一个[ObjectDisplayName]对象
      procedure Insert(index:Integer;A[ObjectName]: T[ObjectName]);     //插入一个[ObjectDisplayName]对象
      procedure Exchange(index1,index2:Integer);
      procedure Update(AObject:TBaseObject;PropertyIdent:integer);override;
      <Property PropertyMapType=AllPropertys ObjectName=[ObjectName]>
      function Findby[Propertyname](A[Propertyname]:[VarType]):T[ObjectName]; //查找[PropertyDisplayname] = A[Propertyname]的对象,返回第一个
      </Property>
      property Count: integer read GetCount;
      property Items[index:integer]: T[ObjectName] read GetItems write SetItems;
      property OnInsert[ObjectName]Event    :TOnInsert[ObjectName]Event read FInsert[ObjectName]Event write FInsert[ObjectName]Event;
      property OnAdd[ObjectName]Event    :TOnAdd[ObjectName]Event read FAdd[ObjectName]Event write FAdd[ObjectName]Event;
      property OnDelete[ObjectName]Event :TOnDelete[ObjectName]Event read FDelete[ObjectName]Event write FDelete[ObjectName]Event;
      property OnChange[ObjectName]Event :TOnChange[ObjectName]Event read FChange[ObjectName]Event write FChange[ObjectName]Event;
      property DataFlow:TDataFlow read FDataFlow write SetDataFlow;  //数据流
      property Controllers : TControllers read FControllers write SetControllers; //事件流控制
    end;
 </Object>}
{/CodeTemplate}
{/DesignOne}
  TDataFlow =class
{DesignOne}
{CodeTemplate}
{<Object ObjectMapType=AllObjects>
  procedure AfterAdd[Objectname](A[Objectname]: T[Objectname]);virtual;  //在加入一个[ObjectDisplayname] 后的处理
  procedure AfterDelete[Objectname](A[Objectname]: T[Objectname]);virtual;  //在删除一个[ObjectDisplayname] 后的处理
   <Property PropertyMapType=AllPropertys ObjectName=[ObjectName]>
   procedure AfterUpdate[Objectname]_[PropertyName](A[Objectname]: T[Objectname]);virtual;  //在更改一个[ObjectDisplayname] 的[PropertyDisplayName]后的处理
   </Property>
 </Object>}
{/CodeTemplate}
{/DesignOne}
  end;
 TController =class
 private
{DesignOne}
{CodeTemplate}
{<Object ObjectMapType=AllObjects>
    fOnAdd[Objectname]: TOnAdd[ObjectName]Event;
    fOnInsert[Objectname]: TOnInsert[ObjectName]Event;
    fOnDelete[Objectname]: TOnDelete[ObjectName]Event;
    fOnChange[Objectname]: TOnChange[ObjectName]Event;
 </Object>}
{/CodeTemplate}
{/DesignOne}
  public
{DesignOne}
{CodeTemplate}
{<Object ObjectMapType=AllObjects>
    property OnAdd[Objectname] : TOnAdd[ObjectName]Event read fOnAdd[Objectname] write fOnAdd[Objectname];   //成功添加一个[ObjectDisplayname] 对象后,发出添加通知
    property OnInsert[Objectname] : TOnInsert[ObjectName]Event read fOnInsert[Objectname] write fOnInsert[Objectname];   //成功插入一个[ObjectDisplayname] 对象后,发出插入通知
    property OnDelete[Objectname] : TOnDelete[ObjectName]Event read fOnDelete[Objectname] write fOnDelete[Objectname];   //成功删除一个[ObjectDisplayname] 对象后,发出删除通知
    property OnChange[Objectname]: TOnChange[ObjectName]Event read fOnChange[Objectname] write fOnChange[Objectname];    //成功修改一个[ObjectDisplayname] 对象的值后,发出改变通知
 </Object>}
{/CodeTemplate}
{/DesignOne}
  end;
//整个数据的管理入口 
  TModelData = class
  private
    FDataFlow: TDataflow;
    fControllers :TControllers;
    {DesignOne}
{CodeTemplate}
{<Object ObjectMapType=TopObjects>
    F[ObjectName]List: T[ObjectName]List;
 </Object>}
{/CodeTemplate}
{/DesignOne}
    procedure SetDataFlow(const Value : TDataflow);
  public
    constructor Create;
    destructor Destroy; override;
    property DataFlow :TDataflow read FDataFlow write SetDataFlow;
    property Controllers :TControllers read FControllers;
{DesignOne}
{CodeTemplate}
{<Object ObjectMapType=TopObjects>
    property [ObjectName]List : T[ObjectName]List read F[ObjectName]List;
 </Object>}
{/CodeTemplate}
{/DesignOne}
  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-1 do
  begin
    obs := FObserverlist.Items[i];
    obs.Update(Self,PropertyIdent);
  end;
end;
{TDataFlow}
{DesignOne}
{CodeTemplate}
{<Object ObjectMapType=AllObjects>
procedure TDataFlow.AfterAdd[Objectname](A[Objectname]: T[Objectname]);begin end;
procedure TDataFlow.AfterDelete[Objectname](A[Objectname]: T[Objectname]);begin end;
   <Property PropertyMapType=AllPropertys ObjectName=[ObjectName]>
procedure TDataFlow.AfterUpdate[Objectname]_[PropertyName](A[Objectname]: T[Objectname]);begin end;
   </Property>
 </Object>}
{/CodeTemplate}
{/DesignOne}
destructor TControllers.Destroy;
var
  C:TController;
begin
  while Count>0 do 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 - 1 do
  begin
    SetLength(Result,i+1);
    Result[i] := 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 - 1 do
  begin
    if Includeit(Flist.Items[i]) 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[i] = 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[i]) 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-1 do
    Result := Filter2By(TFilterParams(AParamsList.Items[i-1]).Ship,
                        Result,FilterBy(AParamsList.Items[i]));
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[i] := AFilters[i];
  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[I]], P)<0)  do
        Inc(I);
      while (Compare(AParams,FList.Items[SortList[J]], P)>0)  do
        Dec(J);
      if I <= J then
      begin
        T := SortList[I];
        SortList[I] := 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[i] := AFilters[i];
  end;
  QuickSort(ASortParams,Low(Result),High(Result),Result);
end;
{DesignOne}
{CodeTemplate}
{<Object ObjectMapType=AllObjects>
constructor T[ObjectName].create;
begin
  inherited;
  ObjectType := dot_[ObjectName];
 <ObjectShip ObjectShipMapType=ChildObjects ObjectName=[ObjectName]>
 f[ObjectShipName]List := T[ObjectShipName]List.Create;
 </ObjectShip>
 <Property PropertyMapType=AllPropertys ObjectName=[ObjectName]>
 f[Propertyname] := [DefaultValue];
 </Property>
end;
destructor T[ObjectName].Destroy;
begin
 <ObjectShip ObjectShipMapType=ChildObjects ObjectName=[ObjectName]>
  f[ObjectShipName]List.Free;
 </ObjectShip>
  inherited;
end;
procedure T[ObjectName].Cloneto(ADest:T[ObjectName];ADeepClone:Boolean);
begin
 <Property PropertyMapType=AllPropertys ObjectName=[ObjectName]>
    ADest.[Propertyname] := f[Propertyname];
 </Property>
  if ADeepClone then
  begin
   <ObjectShip ObjectShipMapType=ChildObjects ObjectName=[ObjectName]>
    f[ObjectShipName]List.Cloneto(ADest.[ObjectShipName]List,ADeepClone);
   </ObjectShip>
  end;
end;
function T[ObjectName].GetDataBuffer(var ABuffer:PChar;var len:integer):Boolean;
var
  alen:Integer;
begin
  Result := False;
  len := 0;
 <Property PropertyMapType=AllPropertys ObjectName=[ObjectName]>
  alen := [PropertyDataSize]([PropertyName]);
  CopyMemory(@ABuffer[len],@alen,SizeOf(alen));
  CopyMemory(@ABuffer[len+SizeOf(alen)],@[PropertyName],alen);
  len := len+alen+SizeOf(alen);
 </Property>
   Result := True;
end;
function T[ObjectName].GetDataObject(ABuffer: PChar): Boolean;
var
  alen:Integer;
  offset:integer;
begin
  Result := False;
  offset := 0;
 <Property PropertyMapType=AllPropertys ObjectName=[ObjectName]>
  CopyMemory(@alen,@ABuffer[offset],SizeOf(alen));
  CopyMemory(@[PropertyName],@ABuffer[offset+SizeOf(alen)],alen);
  offset := alen+SizeOf(alen);
 </Property>
  Result := True;
end;
 <Property PropertyMapType=AllPropertys ObjectName=[ObjectName]>
procedure T[ObjectName].Set[PropertyName](const Value: [VarType]);
begin
  if Value = f[PropertyName] then Exit;
  F[PropertyName] := Value;
  if FChangedNotify then NotifyObserver(dpt_[ObjectName][PropertyName]);
end;
 </Property>
destructor T[ObjectName]List.Destroy;
begin
  ClearList;
  inherited;
end;
procedure T[ObjectName]List.ClearList;
var
  Data : T[ObjectName];
begin
  while FList.Count>0 do begin Data := FList.Items[0]; Data.Detach(Self); data.Free; FList.Delete(0); end;
end;
function T[ObjectName]List.Add[ObjectName](A[ObjectName]: T[ObjectName]): integer;
var
  i:integer;
  C : TController;
begin
  Result := FList.Add(A[ObjectName]);
  A[ObjectName].Attach(Self);
  if Assigned(FDataFlow)  then FDataFlow.AfterAdd[ObjectName](A[ObjectName]);
  if Assigned(FControllers) then
  for i := 0 to FControllers.Count-1 do
  begin
    C := FControllers.Items[i];
    if Assigned(C.OnAdd[ObjectName]) then
      C.OnAdd[ObjectName](A[ObjectName]);
  end;
  if Assigned(FAdd[ObjectName]Event) then FAdd[ObjectName]Event(A[ObjectName]);
end;
procedure T[ObjectName]List.Delete[ObjectName](index: integer);
var
  i:integer;
  C : TController;
begin
  T[ObjectName](FList.Items[index]).Detach(Self);
  if Assigned(FDataFlow)  then FDataFlow.AfterDelete[ObjectName](T[ObjectName](FList.Items[index]));
  if Assigned(FControllers) then
  for i := 0 to FControllers.Count-1 do
  begin
    C := FControllers.Items[i];
    if Assigned(C.OnDelete[ObjectName]) then
      C.OnDelete[ObjectName](FList.Items[index]);
  end;
  if Assigned(FDelete[ObjectName]Event) then FDelete[ObjectName]Event(FList.Items[index]);
  FList.Delete(index);
 end;
function T[ObjectName]List.GetCount: integer;
begin
  Result := FList.Count;
end;
function T[ObjectName]List.GetItems(index: integer): T[ObjectName];
begin
  Result := FList.Items[Index];
end;
function T[ObjectName]List.Indexof(A[ObjectName]: T[ObjectName]): integer;
begin
  Result := FList.IndexOf(A[ObjectName]);
end;
function T[ObjectName]List.Remove[ObjectName](A[ObjectName]: T[ObjectName]): integer;
var
  i:integer;
  C : TController;
begin
  A[ObjectName].Detach(Self);
  if Assigned(FDelete[ObjectName]Event) then FDelete[ObjectName]Event(A[ObjectName]);
  if Assigned(FDataFlow)  then FDataFlow.AfterDelete[ObjectName](A[ObjectName]);
  if Assigned(FControllers) then
  for i := 0 to FControllers.Count-1 do
  begin
    C := FControllers.Items[i];
    if Assigned(C.OnDelete[ObjectName]) then
      C.OnDelete[ObjectName](A[ObjectName]);
  end;
   Result := FList.Remove(A[ObjectName]);
end;
procedure T[ObjectName]List.SetItems(index: integer; const Value: T[ObjectName]);
begin
  FList.Items[index] := Value;
end;
procedure T[ObjectName]List.Cloneto(ADest:T[ObjectName]List;ADeepClone:Boolean);
var
  i:integer;
  A[ObjectName]: T[ObjectName];
begin
  ADest.ClearList;
  for i := 0 to   Count-1 do
  begin
    A[ObjectName]:=T[ObjectName].create;
    ADest.Add[ObjectName](A[ObjectName]);
    Items[i].Cloneto(A[ObjectName],ADeepClone);
  end;
end;
procedure T[ObjectName]List.Insert(index: Integer; A[ObjectName]: T[ObjectName]);
var
  i:integer;
  C : TController;
begin
  FList.Insert(index,A[ObjectName]);
  A[ObjectName].Attach(Self);
  if Assigned(FDataFlow)  then FDataFlow.AfterAdd[ObjectName](A[ObjectName]);
  if Assigned(FControllers) then
  for i := 0 to FControllers.Count-1 do
  begin
    C := FControllers.Items[i];
    if Assigned(C.OnInsert[ObjectName]) then
      C.OnInsert[ObjectName](index,A[ObjectName]);
  end;
  if Assigned(Finsert[ObjectName]Event) then Finsert[ObjectName]Event(index,A[ObjectName]);
end;
procedure T[ObjectName]List.Exchange(index1, index2: Integer);
begin
  FList.Exchange(index1, index2);
end;
<Property PropertyMapType=AllPropertys ObjectName=[ObjectName]>
function T[ObjectName]List.Findby[Propertyname](A[Propertyname]:[VarType]):T[ObjectName];
var
  i:Integer;
  l[ObjectName]:T[ObjectName];
begin
  Result := nil ;
  for i:= 0 to FList.Count-1 do
  begin
    l[ObjectName] := FList.Items[i];
    if [UpperCase](l[ObjectName].[Propertyname]) = [UpperCase](A[Propertyname]) then
    begin
      Result := l[ObjectName];
      Break;
    end;
  end;
end;
</Property>
procedure  T[ObjectName]List.GetCompareValue(AParams: TFilterParams;ADataObject: pointer; var datavalue,paramvalue:Variant);
var
  dataObject : T[ObjectName];
begin
  dataObject := ADataObject;
  paramvalue := AParams.Value;
  case  AParams.Ident of
 <Property PropertyMapType=AllPropertys ObjectName=[ObjectName]>
    dpt_[ObjectName][PropertyName]: datavalue := dataObject.[PropertyName];
 </Property>
  end;
end;
procedure T[ObjectName]List.GetCompareValue(AParams: TSortParams;ADataObject1,ADataObject2:pointer;
                       var datavalue1,datavalue2:Variant);
var
  DataObject1,DataObject2 :T[ObjectName];
begin
  DataObject1 := ADataObject1;
  DataObject2 := ADataObject2;
  case AParams.Ident of
    <Property PropertyMapType=AllPropertys ObjectName=[ObjectName]>
    dpt_[ObjectName][PropertyName]:
    begin
      datavalue1 := DataObject1.[PropertyName];
      datavalue2 := DataObject2.[PropertyName];
    end;
    </Property>
  end;
end;
function T[ObjectName]List.New[ObjectName]: T[ObjectName];
begin
  Result := T[ObjectName].create;
  Add[ObjectName](Result);
end;
procedure T[ObjectName]List.Update(AObject: TBaseObject;PropertyIdent:integer);
var
  i:integer;
  C : TController;
begin
  if Assigned(FDataFlow)  then
  case PropertyIdent of
  <Property PropertyMapType=AllPropertys ObjectName=[ObjectName]>
    dpt_[ObjectName][PropertyName] : FDataFlow.AfterUpdate[ObjectName]_[PropertyName](AObject as T[ObjectName]);
  </Property>
  end;
  if Assigned(FControllers) then
  for i := 0 to FControllers.Count-1 do
  begin
    C := FControllers.Items[i];
    if Assigned(C.OnChange[ObjectName]) then
      C.OnChange[ObjectName](AObject as T[ObjectName]);
  end;
  if Assigned(FChange[ObjectName]Event) then FChange[ObjectName]Event(AObject as T[ObjectName]);
end;
procedure T[ObjectName]List.SetDataFlow(const Value: TDataFlow);
var
 i:integer;
 l[ObjectName]:T[ObjectName];
begin
  if FDataFlow=Value then exit;
  FDataFlow := Value;
   <ObjectShip ObjectShipMapType=ChildObjects ObjectName=[ObjectName]>
    for i := 0 to count-1 do
    begin
      l[ObjectName] := Items[i];
      l[ObjectName].[ObjectShipName]List.DataFlow := Value;
    end;
   </ObjectShip>
end;
procedure T[ObjectName]List.SetControllers(const Value: TControllers);
var
 i:integer;
 l[ObjectName]:T[ObjectName];
begin
  if FControllers=Value then exit;
  FControllers := Value;
   <ObjectShip ObjectShipMapType=ChildObjects ObjectName=[ObjectName]>
    for i := 0 to count-1 do
    begin
      l[ObjectName] := Items[i];
      l[ObjectName].[ObjectShipName]List.Controllers := Value;
    end;
   </ObjectShip>
end;
 </Object>}
{/CodeTemplate}
{/DesignOne}
constructor TModelData.Create;
begin
 fControllers := TControllers.Create;
{DesignOne}
{CodeTemplate}
{<Object ObjectMapType=TopObjects>
    F[ObjectName]List := T[ObjectName]List.Create;
    F[ObjectName]List.Controllers := fControllers;
 </Object>}
{/CodeTemplate}
{/DesignOne}
end;
destructor TModelData.Destroy;
begin
{DesignOne}
{CodeTemplate}
{<Object ObjectMapType=TopObjects>
    F[ObjectName]List.Free;
 </Object>}
{/CodeTemplate}
{/DesignOne}
 fControllers.Free;
  inherited;
end;
procedure TModelData.SetDataFlow(const Value: TDataflow);
begin
  if  FDataFlow = Value then exit;
  FDataFlow := Value;
 {DesignOne}
{CodeTemplate}
{<Object ObjectMapType=TopObjects>
    F[ObjectName]List.DataFlow := Value;
 </Object>}
{/CodeTemplate}
{/DesignOne}
end;
end.
模型文件下载地址：
http://www.onewone.com/designone/xDOM.dom
欢迎交流！
一个简单的Ｄelphi框架－xDom－１ 内存对象

一个简单的Ｄelphi框架－xDom－１　内存对象
