tslediter/funcext/tvclib/tcomponent.tsf

646 lines
19 KiB
Plaintext

type tcomponent = class(TSLUIBASE)
uses utslvclauxiliary,UVCPropertyTypesPersistence,utslvclbase;
{**
@explan(说明) 可视化组件基类 %%
@date(20220505) 分离tcomponent基类
**}
private
{**
@param(FOwner)(tcomponent) 所有者 %%
@param(FComponents)( TFpList ) 子项 %%
@param(FComponentState)( array of integer) 节点状态 %%
@param(FComponentStyle)( array of integer) 节点样式 %%
@param(FFreeNotifies)( TFpList) 销毁通知节点 %%
**}
FOwner;
FName;
FComponents;
FFreeNotifies: TFpList;
FComponentState;
FComponentStyle;
FComponentCreated;
FLoader;
function ComponentGetParent();virtual;
begin
end
function ComponentSetParent();virtual;
begin
end
#!begin //private methods
function GetLoader();
begin
m2 := class(tUIglobalData).uigetdata("G_T_TTFM2COMPONET_");
if not m2 then return 0;
if not FLoader then FLoader := createobject(m2);
return FLoader;
end
function GetPropInfo();
begin
o := self(true);
r := getPropInfo2(o);
ret := array();
ii := 0;
for i,v in r do
begin
ret[ii++]:= v;
end
return select * from ret order by["name"] end;
end
static FClassDigestB;
class function GetClassDigestB(idx,d);
begin
if not ifarray(FClassDigestB)then FClassDigestB := array();
if ifnil(d)then return FClassDigestB[idx];
else FClassDigestB[idx]:= d;
end
function getPropInfo2(o);
begin
if not(o is class(tcomponent))then return array();
t := o.classinfo;
idx := getmsgd_Crc32(tostm(t))+"&&";
r := GetClassDigestB(idx);
if ifarray(r)then return r;
r := array();
hs := t["inherited"];
for i,v in hs do
begin
r union=static call(thisfunction,findclass(v,o))name v+"&&_&&";
end
for i,v in t["properties"] do
begin
n := v["name"];
if((v["access"]in array(2,3))or(not(v["read"])))or not(v["type"])then
begin
deleteindex(r,n);
continue;
end
if v["read"]and v["type"]then
begin
r union=array(n:v[array("name","type","write","parser")]);
end
end
for i,v in t["members"] do
begin
n := v["name"];
if(v["access"]in array(2,3))or not(v["type"])then
begin
deleteindex(r,n);
continue;
end
tr := v[array("name","type","write","parser")];
tr["write"]:= true;
r union=array(n:tr);
end
GetClassDigestB(idx,r);
return r;
end
function GetComponent(AIndex);
begin
{**
@explan(说明) 获取子节点 %%
@param(AIndex)( integer ) 子项序号 %%
**}
return FComponents.geti(AIndex);
end
function SetComponentState(v);
begin
if ifarray(v)then FComponentState := v;
end
function GetComponentCount();
begin
{**
@explan(说明) 获取子节数量%%
@return(AIndex)( integer ) 数量 %%
**}
return FComponents.count();
end
function GetComponentIndex();
begin
{**
@explan(说明) 获取子节序号%%
@return(AIndex)( integer ) 子项序号 %%
**}
if FOwner is class(tcomponent)then
begin
return FOwner.Components.findvid(self);
end
return-1;
end
procedure Insert(AComponent:TComponent); //此处需要修改
begin
{**
@explan(说明)添加子节点 %%
**}
FComponents.Add(AComponent);
AComponent.FOwner := Self(true);
end
procedure Remove(AComponent:TComponent);
begin
{**
@explan(说明)移除子节点 %%
**}
if FComponents.Remove(AComponent)>0 then
begin
AComponent.FOwner := Nil;
return true;
end
return false;
end;
procedure RemoveNotification(AComponent:TComponent);
begin
r := FFreeNotifies.Remove(AComponent);
if FFreeNotifies.count()<1 then includestate(FComponentState,csFreeNotification);
return r;
end
#!end
protected
#!begin //protected methods
function SetName(v);virtual;
begin
if ifstring(v)and length(v)>1 and v <> FName then
begin
if isKeyWords(v)then return;
nv := lowercase(v);
if new TCharDiscrimi().IsVariableName(v)then
begin
r := RootOwner().FindComponentByName(nv);
if not r then
begin
FName := nv;
end
end
end
end
Procedure SetAncestor(Value:Boolean);
begin
If Value then includestate(FComponentState,csAncestor)else excludestate(FCOmponentState,csAncestor);
For Runner := 0 To FComponents.Count-1 do
begin
FComponents.geti(Runner).SetAncestor(Value);
end
end;
function ValidateContainer(AComponent:TComponent);virtual;
begin
if AComponent is class(tcomponent)then return AComponent.ValidateInsert(Self);
end
function ValidateInsert(AComponent:TComponent);virtual;
begin
return true;
end
public
function ExecuteCommand(cmd,p);virtual;
begin
end
function relnotification(Operation);//通知关联的组件
begin
ac := self(self);
ow := ac;
while ow do
begin
nw := ow.Owner;
if not nw then
begin
break;
end
ow := nw;
end
if ow<>ac then
ow.Notification(ac,Operation);
end
function Notification(AComponent,Operation);virtual;
begin
{**
@explan(说明) 通知处理 %%
@param(AComponent)(tcomponent) 改变的对象 %%
@param(Operation)(member of TOperation) 通知码 %%
**}
If(Operation=opRemove)then
begin
RemoveFreeNotification(AComponent);
end
data := FComponents.data();
C := length(data)-1;
While(C >= 0) do
begin
data[c].Notification(AComponent,Operation);
c--;
end;
end;
private
Procedure SetDesignInstance(Value);
begin
If Value then
includestate(FComponentState,csDesignInstance)
else
excludestate(FComponentState,csDesignInstance);
end;
public
procedure RemoveFreeNotification(AComponent:TComponent);
begin
RemoveNotification(AComponent);
AComponent.RemoveNotification(self);
end;
Procedure SetDesigning(Value,SetChildren);virtual;
begin
{**
@explan(说明) 设计器使用方法,设置为设计状态,或者解除设置状态 %%
@param(Value)(bool) 状态值 %%
@param(SetChildren)(bool) 是否修改子控件状态 %%
**}
if ifnil(SetChildren)then SetChildren := true;
If Value then
includestate(FComponentState,csDesigning);
else
excludestate(FComponentState,csDesigning);
if SetChildren then
begin
items := FComponents.data;
For Runner := 0 To length(items)-1 do
begin
items[Runner].SetDesigning(Value);
end
end
end;
protected
function SetParentComponent(Value);virtual;
begin
end
function GetChildren();virtual;
begin
end
procedure Updating;virtual;
begin
includestate(FComponentState,csUpdating);
end
procedure Updated;virtual;
begin
excludestate(FComponentState,csUpdating);
end
#!end
public
#!begin //public methods
function create(AOwner);virtual;
begin
class(TSLUIBASE).create();
FComponents := NEW TFpList();
FFreeNotifies := NEW TFpList();
FComponentStyle := array(csInheritable);
FComponentstate := array();
SetOwner(AOwner);
FEventsProperties := array();
FVariableProperties := array();
FComponentCreated := true;
return;
If AOwner is class(tcomponent)then
begin
FOwner := AOwner;
AOwner.InsertComponent(Self);
end
end
function RootOwner();
begin
if not(FOwner is class(TComponent))then return self(true);
return FOwner.RootOwner();
end
function FindComponentByName(n);
begin
if n and n=FName then return self(true);
cps := Components;
for i := 0 to cps.Count-1 do
begin
r := cps[i].FindComponentByName(n);
if r then return r;
end
return false;
end
function isDescendant(cd);
begin
{**
@explan(说明) 判断节点是否为其子节点 %%
@param(cd)(tcomponent) 等判断节点 %%
@return(bool) true 为子节点 false 非子节点 %%
**}
if cd=self then return true;
for i := 0 to FComponents.count()-1 do
begin
if FComponents[i].isDescendant(cd) then return true;
end
return false;
end
function SetOwner(AOwner);
begin
{**
@explan(说明) 设置所有者,注意只能成功设置一次,之后设置无效 %%
@param(AOwner)(tcomponent) 所有者 %%
**}
if (ifnil(FOwner)) and (AOwner is class(tcomponent))then
begin
if isDescendant(AOwner)then exit;
FOwner := AOwner;
AOwner.InsertComponent(self(true));
end
end
function Recycling();override;
begin
if not FComponentCreated then exit;
Destroying();
//////////////////////////
relnotification("recycling");
///////////////////////
DestroyComponents();
If FOwner is class(tcomponent)Then FOwner.RemoveComponent(self(true)); //self
inherited;
end
function Destroy();virtual;
begin
inherited;
end;
function Destroying();
begin
If csDestroying in FComponentstate Then Exit;
includestate(FComponentState,csDestroying);
if not FCOmponents then exit;
data := FCOmponents.data();
for i,v in data do v.Destroying();
end;
function ExecuteAction(act:TBasicAction):Boolean;virtual;
begin
{**
@explan(说明)执行action %%
**}
if act.HandlesTarget(Self)then
begin
act.ExecuteTarget(Self);
return True;
end else
return False;
end
function UpdateAction(act:TBasicAction):Boolean;virtual;
begin
{**
@explan(说明) 更新action %%
**}
if act.HandlesTarget(Self)then
begin
act.UpdateTarget(Self);
return True;
end else
return False;
end
function DestroyComponents();
begin
{**
@explan(说明)删除子项 %%
**}
if not FComponents then exit;
FName := nil;
data := FComponents.data();
FComponents.clean();
for i,Acomponent in data do
begin
Acomponent.Recycling();
end
end;
Procedure FreeNotification(AComponent:TComponent);
begin
{**
@explan(说明) 关联对象,在释放的时候相互通知 %%
@param(AComponent)(TComponent) 对象 %%
**}
if not(AComponent is class(tcomponent))then exit;
If(Owner <> Nil)and(AComponent=Owner)then exit;
If FFreeNotifies.IndexOf(AComponent)=-1 then
begin
FFreeNotifies.Add(AComponent);
AComponent.FreeNotification(self(true)); //添加当前的
end;
end;
//function GetParentComponent(); virtual;begin end
//function HasParent(); virtual;begin end
function InsertComponent(AComponent);virtual;
begin
{**
@explan(说明)插入节点 %%
**}
if AComponent.ValidateContainer(Self)then
begin
self.Insert(AComponent);
If csDesigning in FComponentState then AComponent.SetDesigning(true);
Notification(AComponent,opInsert);
end
end;
Procedure RemoveComponent(AComponent);
begin
{**
@explan(说明)移除子节点 %%
**}
Notification(AComponent,opRemove);
if Remove(AComponent)then Acomponent.Setdesigning(False);
end;
function Assigned(o);virtual;
begin
return ifobj(o);
end
#!end
private
FEventsProperties;
FChangedProperties;
FVariableProperties;
function GetPublishInfo();
begin
r := publishs();
rr := array();
ri := 0;
for i,v in r do
begin
if ifstring(v) then rr[ri++] := lowercase(v);
end
return rr;
end
function OrderPublish(r,od); //排序发布的东西
begin
if od then
begin
r1 := array();
for i,v in od do
begin
vi := r[v];
if vi then r1[v]:= vi;
end
r := r1;
end
end
public
function publishs();virtual;
begin
//return array("currentcolor","lazyitems","range","firstdayofweek","align","mbbtnstyle","textalign","text","imagelist","canvs","images","items","bkbitmap","icon","popupmenu","mainmenu","cursor","height","width","left","top","enabled","visible","caption","color","font","onclick","rootfolder","initialdir");
end
function GetPublishproperties();virtual;
begin
{**
@explan(说明) 获得properties,设计器使用%%
**}
ps := GetPropInfo();
r := array();
pps := GetPublishInfo();
for i,v in ps do
begin
typ := v["type"];
if typ="eventhandler" then continue;
otype :=GetComponentPropertyType(typ);// GetPropertyType(typ);
if otype then
begin
n := v["name"];
if pps and not(n in pps)then continue;
if typ in array("variable","popupmenu","syscursor","tmainmenu")then
begin
r[n]:= otype.FormatEdit(FVariableProperties[n],v["write"]?true:false);
end else
r[n]:= otype.FormatEdit(invoke(self(true),n),v["write"]?true:false);
end
end
//次序处理
////////////////////
OrderPublish(r,pps);
////////////////////
return r;
end
function GetPublishEvents();virtual;
begin
{**
@explan(说明) 获得event值,设计器使用 %%
@return(array)
**}
ps := GetPropInfo();
r := array();
pps := GetPublishInfo();
for i,v in ps do
begin
typ := v["type"];
if typ <> "eventhandler" then continue;
otype :=GetComponentPropertyType(typ);// GetPropertyType(typ);
if otype then
begin
n := v["name"];
if pps and not(n in pps)then continue;
ne := FEventsProperties[n];
r[n]:= otype.FormatEdit(ne,v["write"]?true:false);
end
end
OrderPublish(r,pps);
return r;
end
function GetChangedPropertiesn(n);virtual;
begin
return FChangedProperties[n];
end
function GetChangedPublish();virtual;
begin
{**
@explan(说明)获取修改过的publish,设计器使用 %%
**}
r := array();
if not FChangedProperties then return r;
ps := GetPropInfo();
for i,vi in ps do
begin
n := vi["name"];
vv := FChangedProperties[n];
if ifnil(vv)then continue;
vit := vi["type"];
otype := GetComponentPropertyType(vit);//GetPropertyType(vit);
if vi["write"]and otype then
begin
r[n]:= otype.FormatTMF(vv);
end
end
return r;
end
function SetChangedPublish(n,v);virtual;
begin
{**
@explan(说明) 设计器相关函数 %%
**}
if not ifarray(FChangedProperties)then FChangedProperties := array();
//reindex(FChangedProperties,array(n:nil));
FChangedProperties[n]:= v;
end
function DeleteChangedPublish(n);virtual;
begin
if n and ifstring(n)then
begin
if not ifarray(FChangedProperties)then FChangedProperties := array();
reindex(FChangedProperties,array(n:nil));
end
end
function SetPublish(n,v);virtual;
begin
{**
@explan(说明) 修改单个值,设计器使用 %%
@param(n)(string) 名称 %%
@param(v)(any) 值 %%
**}
ps := GetPropInfo();
for i,vi in ps do //获取信息
begin
if n=vi["name"]then
begin
vit := vi["type"];
otype := GetComponentPropertyType(vit);//GetPropertyType(vit); //获得转换对象
if ifobj(otype)then
begin
iv := otype.UnformatEdit(v); //反转换
SetChangedPublish(n,iv); //保存
if vit="eventhandler" then //分类保存
begin
FEventsProperties[n]:= iv;
end else
begin
if vit in array("variable","popupmenu","syscursor","tmainmenu")then //分类保存
begin
FVariableProperties[n]:= iv;
if vit="tmainmenu" then
begin
try
invoke(self(true),n,1,iv);
except
return false;
end;
end
end else
//if not ifnil(iv) then //设置到设计控件
begin
try
//if n="visible" and (not((self(true) is class(tform)) and (self(true) is class(tpanelform)))) then
//else
invoke(self(true),n,1,iv);
except
return false;
end;
end
end
end
return true;
end
end
end
property Owner:tcomponent read FOwner;
{**
@param(Owner)(tcomponent) 所有者 %%
@param(ComponentState)() 状态集合 %%
@param(ComponentStyle)() 样式结合 %%
@param(ComponentCreated)(bool) 样式结合 %%
**}
//property DesignInfo read FDesignInfo write FDesignInfo;
property ComponentCreated read FComponentCreated;
property Components read FComponents;
property ComponentState read FComponentState write SetComponentState;
property ComponentStyle read FComponentStyle;
property Name:string read FName write SetName;
property Parent read ComponentGetParent write ComponentSetParent;
property Loader read GetLoader;
end