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

最新推荐文章于 2024-07-11 15:26:39 发布

design1

最新推荐文章于 2024-07-11 15:26:39 发布

阅读量1.5k

点赞数

分类专栏：技术之美文章标签：框架 integer list delphi class filter

本文链接：https://blog.csdn.net/design1/article/details/2901834

版权

本文介绍了一个基于DesignOne模板技术设计的Delphi框架-xDOM，该框架包含对象层、存储层和显示层。核心组件包括TBaseObject、TBaseObjectList、TController等，支持数据对象管理、快速排序、搜索等功能。提供了数据模型设计的完整代码示例。

摘要由CSDN通过智能技术生成

从现在开始,着手实现一个简单而实用的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;
                 