📄 boprototypemanagerunit.pas
字号:
//-------------------------------------------------------------------------------
// BusinessObject对象管理器
// 1.单例模式:
//
//------------------------------------------------------------------------------
unit BOPrototypeManagerUnit;
interface
uses
Windows, Classes, SysUtils, Contnrs, Dialogs;
type
TBOPrototype = class (TPersistent)
private
FBOClassList: TList;
FBOList: TObjectList;
procedure setBOClassList(tmpList :TList);
function getBOClassList: TList;
procedure setBOList(tmpObjList :TObjectList);
function getBOList: TObjectList;
protected
Constructor CreateInstance;
class function GetInstance(iParam: Integer): TBOPrototype;
published
//--TBOClassList--
function findRegClsName(fClass: String): TClass;
function findRegObj(fObj: String): TObject;
//--TBOlist--
function AddItem(index: integer; AObject: TObject ):Integer; virtual;
function DelItem(index: integer; AObject: TObject ):Integer; virtual;
function GetItem(index: integer ): TObject; virtual; function CountItem:Integer; virtual;
public
property PBOClsList: TList read getBOClassList write setBOClassList;
property PBOList: TObjectList read getBOList write setBOList;
constructor Create;
class function CreateEx: TBOPrototype;
destructor Destroy; override;
class procedure ReleaseInstance;
end;
var
BOPrototype: TBOPrototype;
implementation
{$J+}
constructor TBOPrototype.Create;
begin
inherited Create;
Raise Exception.CreateFmt('请调用创建%s类!', [ClassName]);
end;
procedure TBOPrototype.setBOClassList(tmpList :TList);
begin
FBOClassList := tmpList;
end;
function TBOPrototype.getBOClassList: TList;
begin
Result := FBOClassList;
end;
procedure TBOPrototype.setBOList(tmpObjList :TObjectList);
begin
FBOList := tmpObjList;
end;
function TBOPrototype.getBOList: TObjectList;
begin
Result := FBOList;
end;
Constructor TBOPrototype.CreateInstance;
begin
inherited Create;
FBOClassList := TList.Create;
FBOList := TObjectList.Create;
end;
class function TBOPrototype.CreateEx: TBOPrototype;
begin
Result := self.GetInstance(1);
end;
class function TBOPrototype.GetInstance(iParam: Integer): TBOPrototype;
const
FInstance: TBOPrototype = nil;
begin
case iParam of
0: ;
1: if not Assigned(FInstance) then
FInstance := CreateInstance;
2: FInstance := nil;
else
raise Exception.CreateFmt('%d是CreateEx的非法调用参数。', [iParam]);
end;
Result := FInstance;
end;
destructor TBOPrototype.Destroy;
begin
if self.GetInstance(0) = self then self.GetInstance(2);
inherited Destroy;
end;
class procedure TBOPrototype.ReleaseInstance;
begin
GetInstance(0).Free;
end;
//--TBOClassList--
function TBOPrototype.findRegClsName(fClass: String): TClass;
var
i_i: Integer;
tmpClass: TClass;
className: String;
begin
Result := nil;
for i_i:=0 to PBOClsList.Count-1 do
begin
tmpClass := PBOClsList.Items[i_i];
className := tmpClass.ClassName;
if SameText(ClassName, fClass) then
begin
Result := tmpClass;
break;
end;
end;
end;
function TBOPrototype.findRegObj(fObj: String): TObject;
var
i_i: Integer;
tmpClass: TClass;
className: String;
begin
Result := nil;
for i_i:=0 to CountItem-1 do
begin
if GetItem(i_i).ClassName = fObj then
begin
Result := GetItem(i_i);
break;
end;
end;
end;
//--TBOlist--
function TBOPrototype.AddItem(index: integer; AObject: TObject ):Integer;
begin Result := PBOList.Add(AObject);end;
function TBOPrototype.DelItem(index: integer; AObject: TObject ):Integer;
begin
Result := PBOList.Remove(AObject);
end;
function TBOPrototype.GetItem(index: integer ): TObject;
begin Result := nil; if (index>=PBOList.Count) or (index<0) then exit else Result := PBOList.Items[index];end;
function TBOPrototype.CountItem: Integer;
begin
Result := PBOList.Count;
end;
initialization
BOPrototype := TBOPrototype.CreateEx;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -