liujianjun
/
tslediter
3
0
Fork 1
Code Issues Pull Requests Projects Releases Wiki Activity

设计器 

实现窗口继承
This commit is contained in:
JianjunLiu 2022-10-18 17:02:40 +08:00
parent 791217a4b1
commit e2cc54dcbc
8 changed files with 657 additions and 115 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
designer/tslvcldesigner.tsf
View File

@ -391,6 +391,10 @@ type TVclDesigner = class(tvcform)
begin
FProjectManager.ShowCurrentFormCode();//ShowEditor();
end
function opentfm(); //´ò¿ª×ÊÔ´Îļþ
begin
FProjectManager.ShowCurrenttfm();
end
function TreeNode2tfm(lib,itemnames,nd); //ת»»Îļþ
begin
{**
@ -1000,13 +1004,13 @@ type TVclDesigner = class(tvcform)
try
prs := array();
obarray := array();
loadtfmtotree(Ptfm,Ptfm.gettree,FTree.RootItem,FTree,prs,obarray,const inh);
loadtfmtotree(Ptfm,Ptfm.gettree2,FTree.RootItem,FTree,prs,obarray,const inh);
for i,v in prs do
begin
va := obarray[v[2]];
if va then
begin
v[0].SetComponentProperties(v[1],va.GetTrueComponent());
v[0].SetComponentProperties(v[1],va.GetTrueComponent(),v[3]);
end
end
@ -1034,9 +1038,12 @@ type TVclDesigner = class(tvcform)
it := new TDPanelForm();
end else return ;
it.dclassname(d["class"]);
it.Imgs := fdimagelist.GetImageId("tdcreateform");
end
comp := it.ComponentCreater(node,wr);
comp.isinherited := d["inherited"];
comp.inheritedparent := d["parent"];
comp.name := d["name"];
obarray[d["name"]] := comp;
FVariableSelecter.additem(comp);
@ -1064,18 +1071,19 @@ type TVclDesigner = class(tvcform)
cls := v["class"];
et := GetComponentPropertyType(cls);//GetPropertyType(cls);
if not et then continue;
pp := ddpv["pp"];
setddpv := et.TmfToNode(p.SampleValue(ddpv));
if et.IfComponent() then
begin
prs[length(prs)]:= array(comp,n,setddpv);
prs[length(prs)]:= array(comp,n,setddpv,pp);
continue;
end
if et.LazyProperty() then
begin
lazy[length(lazy)] := array(n,setddpv);
lazy[length(lazy)] := array(n,setddpv,pp);
continue;
end
comp.SetComponentProperties(n,setddpv);
comp.SetComponentProperties(n,setddpv,pp);
end
for i,v in d["object"] do
begin
@ -1083,7 +1091,7 @@ type TVclDesigner = class(tvcform)
end
for i,v in lazy do
begin
comp.SetComponentProperties(v[0],v[1]);
comp.SetComponentProperties(v[0],v[1],v[2]);
end
//comp.DoControlAlign();
end

344
designer/udesignerproject.tsf
View File

@ -194,6 +194,7 @@ app.run(); //
end
type TProjectView = class(TVCForm) //工程文件浏览
private
FAddtoolbtn;
FTreePopUpMenu;
type TMyToolBar=class(TToolBar)
function Create(AOwner);override;
@ -339,6 +340,8 @@ type TProjectView = class(TVCForm) //
width := 300; //350
height := max(400,rc[3]-200);
FInput := new TNameInput(self);
finheritedinput := new tinheritedimput(self);
finheritedinput.parent := self;
FInput.visible := false;
FInput.parent := self;
FTslEditer := new TTslEditer(AOwner);
@ -391,6 +394,10 @@ type TProjectView = class(TVCForm) //
btn.ImageId := imgs.ImageCount-1;
btn.parent := FTreeTool;
btn.Onclick := thisfunction(ToolClick);
if i="添加" then
begin
FAddtoolbtn := btn;
end
end
FTreeTool.ImageList := imgs;
//**************目录树筛选功能***********************************
@ -460,6 +467,10 @@ type TProjectView = class(TVCForm) //
FAddMenuDir.bitmap := bmps["dir"];
FAddMenuDir.parent := FAddMenu;
FMoveMenu := new TMenu(self);
faddinherited := new TMenu(self);
faddinherited.Caption := "通过继承";
faddinherited.parent := FAddMenu;
FMoveMenu := new TMenu(self);
FMoveMenu.caption := "移动到:";
FMoveMenu.bitmap := bmps["移动"];
FRenameMenu := new TMenu(self);
@ -471,6 +482,7 @@ type TProjectView = class(TVCForm) //
FAddMenuTsf.OnClick := thisfunction(Add_tsf);
FAddMenuTsl.OnClick := thisfunction(add_tsl);
FAddMenuDir.OnClick := thisfunction(Add_dir);
faddinherited.OnClick := thisfunction(add_inherited);
FOpenMenu := new TMenu(self);
FOpenMenu.Caption := "打开";
FOpenMenu.bitmap := EditToolBmps["打开"];
@ -510,9 +522,23 @@ type TProjectView = class(TVCForm) //
if FTree.PopUpMenu then
begin
it := e.itemnew;
if it=ftree.RootNode then return FDesigner.ExecuteCommand("hiddrennode",nil);
if it=ftree.RootNode then
begin
if FAddtoolbtn then FAddtoolbtn.Enabled := false;
return FDesigner.ExecuteCommand("hiddrennode",nil);
end
if it then
begin
if FAddtoolbtn then
begin
if it.FType = "dir" then
begin
FAddtoolbtn.Enabled := true;
end else
begin
FAddtoolbtn.Enabled := false;
end
end
if it.FType="dir" then
begin
if (it=FTree.ProjectNode) then
@ -566,6 +592,16 @@ type TProjectView = class(TVCForm) //
AddDirToCurrentNode(FInput.GetEditV());
end
end
function add_inherited();
begin
if not FCProjectPath then return Messageboxa("工程没打开","提示",0,self);
finheritedinput.setinfo();
if finheritedinput.ShowModal() then
begin
//echo tostn(finheritedinput.GetInfo());
AddinheritdToCurrentDir(finheritedinput.GetInfo());
end
end
function DoRename();
begin
if not FCProjectPath then return Messageboxa("工程没打开","提示",0,self);
@ -679,7 +715,12 @@ type TProjectView = class(TVCForm) //
if r then FTslEditer.OpenAndGotoFileByName(r);
ShowEditor();
end
function ShowCurrenttfm();
begin
if FCurrentOpend then r := FCurrentOpend.gettmfname();
if r then FTslEditer.OpenAndGotoFileByName(r);
ShowEditor();
end
function AddAFiled(n); //添加成员
begin
if ifstring(n)and FCurrentOpend and(FCurrentOpend["type"] in array("form","panel"))then
@ -728,6 +769,7 @@ type TProjectView = class(TVCForm) //
ShowEditor();
return r;
end
function OpenFileByName(n); //打开文件
begin
fio := ioFileseparator();
@ -767,20 +809,15 @@ type TProjectView = class(TVCForm) //
FCurrentOpend := nil;
return messageboxa("文件不存在","错误",0,self);
end
classinfo := FTslEditer.GetClassInfo(it);
if not(ifarray(classinfo)and classinfo)then
begin
FCurrentOpend := nil;
return messageboxa("非窗口类,或者该文件已经损坏","错误",0,self);
end
inh := classinfo["inherited"];
inh := getwindowinherited(n);
if not(ifarray(inh)and(inh intersect array("tdcreateform","tdcreatepanel")))then
begin
begin
FCurrentOpend := nil;
return messageboxa("非窗口类,或者该文件已经损坏","错误",0,self);
end
//打开界面
FDesigner.caption := "TVCL界面设计器 "+FprojName+"->"+FCurrentOpend["name"];
FTmfParser.fssourdirs := FCurrentOpend.gettmfdirs();
FTmfParser.ScriptPath := FCurrentOpend.gettmfname();
FTfmComponets := array();
FTmfParser.GetAllSubObjects(nil,FTfmComponets);
@ -796,6 +833,36 @@ type TProjectView = class(TVCForm) //
end
end
end
function getwindowinherited2(fn);
begin
it := FTslEditer.OpenAndGoLineByName(fn);
classinfo := FTslEditer.GetClassInfo(it);
if not(ifarray(classinfo)and classinfo) then return 0;
inh := classinfo["inherited"];
for i,v in inh do
begin
if v = "tdcreateform" then return array("tdcreateform");
else if v = "tdcreatepanel" then return array("tdcreatepanel");
end
for i,v in inh do
begin
r := getwindowinherited(v);
if r then return r;
end
end
function getwindowinherited(n);//获得继承
begin
nopend := FTree.NameInTree(n,nil,false);
if not nopend then return 0;
case FCurrentOpend["type"] of
"form","panel":
begin
fn := nopend.gettsfname();
return getwindowinherited2(fn);
end
end
end
function OpenMainForm(); //打开主函数
begin
nd := FTree.NameInTree(FMainForm,nil,true);
@ -929,9 +996,7 @@ type TProjectView = class(TVCForm) //
end
end;
end
//FTree.DeleteNode(nd);
FTree.DeleteCurrentNode();
//nd.Recycling();
SaveProjInfo();
end
end
@ -951,6 +1016,49 @@ type TProjectView = class(TVCForm) //
if cn then FTree.InvalidateItem(cn);
SaveProjInfo();
end
function AddinheritdToCurrentDir(info);
begin
n := info[1];
if not(LegalVariableName(n))then return MessageboxA("名字不合法,请重试","提示",0,self);
if FTree.NameInTree(lowercase(n),nil,true)then return MessageboxA("重复的文件名","提示",0,self);
nd := info[0];
if not ifobj(nd) then return MessageboxA("父窗口错误","提示",0,self);
ph := FTree.CurrentNode.FPath;
fio := ioFileseparator();
fn := array("name":n,"type":nd.FType,"dir":ph);
cprojpath := FCProjectPath;
if ph then ph += fio;
else ph := "";
ph := cprojpath+ph+n+".tsf";
if not(FileExists("",ph))then
begin
r := format(%%
type %s=class(%s)
function create(AOwner);
begin
inherited;
end
end
%%,n,nd.Fname);
ReWriteString(ph,r);
FTmfParser.ScriptPath := nd.gettmfname();
r := FTmfParser.inheritedcoy(n+"1",n,nd.Fname);
ReWriteString((FCProjectPath+"resource.tfm"+fio+n+".tfm"),r);
end else
begin
FTslParser.ScriptPath := ph;
cc := FTslParser.GetClassAbstract();
if ifarray(cc)then
begin
inh := cc["inherited"];
end
end
FTree.SetFileToNode(fn);
SaveProjInfo();
end
function AddFormToCurrentDir(n); //添加窗口
begin
if not(LegalVariableName(n))then return MessageboxA("名字不合法,请重试","提示",0,self);
@ -970,29 +1078,18 @@ type TProjectView = class(TVCForm) //
ReWriteString((FCProjectPath+"resource.tfm"+fio+n+".tfm"),r);
end else //已经存在
begin
FTslParser.ScriptPath := ph;
cc := FTslParser.GetClassAbstract();
if ifarray(cc)then
inh := getwindowinherited2(ph);
if inh = array("tdcreateform") then
begin
inh := cc["inherited"];
if ifarray(inh)and lowercase(n)=cc["name"]then
begin
if("tdcreateform"=inh[0])and FileExists("",(FCProjectPath+"resource.tfm"+fio+n+".tfm"))then
begin
fn["type"]:= "form";
end else
if("tdcreatepanel"=inh[0])and FileExists("",(FCProjectPath+"resource.tfm"+fio+n+".tfm"))then
begin
fn["type"]:= "panel";
end else
begin
fn["type"]:= "tsf";
end
end else
begin
fn["type"]:= "tsf";
end
end
fn["type"]:= "form";
end else
if inh = array("tdcreatepanel") then
begin
fn["type"]:= "panel";
end else
begin
fn["type"]:= "tsf";
end
end
FTree.SetFileToNode(fn);
SaveProjInfo();
@ -1016,29 +1113,18 @@ type TProjectView = class(TVCForm) //
ReWriteString((FCProjectPath+"resource.tfm"+fio+n+".tfm"),r);
end else
begin
FTslParser.ScriptPath := ph;
cc := FTslParser.GetClassAbstract();
if ifarray(cc)then
inh := getwindowinherited2(ph);
if inh = array("tdcreateform") then
begin
inh := cc["inherited"];
if ifarray(inh)and lowercase(n)=cc["name"]then
begin
if("tdcreateform"=inh[0])and FileExists("",(FCProjectPath+"resource.tfm"+fio+n+".tfm"))then
begin
fn["type"]:= "form";
end else
if("tdcreatepanel"=inh[0])and FileExists("",(FCProjectPath+"resource.tfm"+fio+n+".tfm"))then
begin
fn["type"]:= "panel";
end else
begin
fn["type"]:= "tsf";
end
end else
begin
fn["type"]:= "tsf";
end
end
fn["type"]:= "form";
end else
if inh = array("tdcreatepanel") then
begin
fn["type"]:= "panel";
end else
begin
fn["type"]:= "tsf";
end
end
FTree.SetFileToNode(fn);
SaveProjInfo();
@ -1429,6 +1515,9 @@ type TProjectView = class(TVCForm) //
if parseregexpr(format("object\\s+\\w+:(%s)\\s*",brs),s,"mibes",result,mpos,mlen)=1 then
begin
end else
if parseregexpr(format("inherited\\s+\\w+:(%s)\\s*",brs),s,"mibes",result,mpos,mlen)=1 then
begin
end else
begin
return false;
end
@ -1510,6 +1599,7 @@ type TProjectView = class(TVCForm) //
FDelDirBtn;
FOpenBtn;
FInput;
finheritedinput;
FScriptHandle;
FTmfParser;
@ -1524,13 +1614,15 @@ type TProjectView = class(TVCForm) //
FRenameMenu;
FAddMenu;
FAddMenuDir;
faddinherited;
FAddMenuForm;
FAddMenuPanel;
FAddMenuTsf;
FAddMenuTsl;
FOpenMenu;
public
FTslEditer;
FTslEditer;
property tree read ftree;
private
end
@ -1796,6 +1888,13 @@ type TFileTree = class(TTreeCtl)
return Owner.fprojectpath+"resource.tfm"+fio+nn+".tfm";
end
end
function gettmfdirs();//获得tmfdir
begin
if FFType in array( "form","panel") then
begin
return array( Owner.fprojectpath+"resource.tfm"+fio);
end
end
property FFileInfo read FFFileInfo write setfileinfo;
fio;
fdtree;
@ -1925,7 +2024,11 @@ type TFileTree = class(TTreeCtl)
Rnd := RootNode;
GetLeafNodeByName(Rnd,nds,n);
end
function GetNodesBytype(nds,n);
begin
Rnd := RootNode;
getleafnodebytype(Rnd,nds,n);
end
function GetLeafNodeByName(nd,nds,n);
begin
if not ifarray(nds) then nds := array();
@ -1944,6 +2047,24 @@ type TFileTree = class(TTreeCtl)
end
end
end
function getleafnodebytype(nd,nds,ns);
begin
if not ifarray(nds) then nds := array();
for i:= 0 to nd.ItemCount-1 do
begin
cnd := nd.GetNodeByIndex(i);
tp := cnd.FType;
if tp = "dir" then
begin
getleafnodebytype(cnd,nds,ns);
end else
if ifarray(ns) and (tp in ns) then
begin
nds[length(nds)] := cnd;
end
end
end
function NodeSelChanged(o,e); //切换
begin
it := e.ItemNew;
@ -2344,6 +2465,113 @@ type TKeyValueList = class(TListBox) //kvalue list
private
FCurrentIndex;
end
type tinheritedimput = class(TVCForm)
function Create(AOwner);override;
begin
inherited;
info := %%
object tinheritedinput1:tinheritedinput
visible = false
caption="通过继承构建窗口"
height=338
left=420
top=232
width=300
minmaxbox=false
object label3:tlabel
left=6
top=9
caption="父类窗口"
end
object listbox1:tlistbox
caption="listbox1"
height=178
left=6
top=40
visible=true
width=274
end
object btn1:tbtn
caption="取消"
height=25
left=79
top=262
end
object btn2:tbtn
caption="确定"
height=27
left=187
top=261
end
object label1:tlabel
left=7
top=225
width=53
height=24
caption="名称"
end
object edit1:tedit
caption="edit1"
left=62
top=226
width=208
end
end
%%;
WSSizebox := false;
loader.LoadFromTfmScript(self,info);
rc := _wapi.GetScreenRect();
left :=(rc[2]-rc[0])/2-280;
top :=(rc[3]-rc[1])/2-230;
Onclose := thisfunction(CloseEndModalForm);
btn1.onClick := function(o,e)
begin
Endmodal(0);
end
btn2.onClick := function(o,e);
begin
Endmodal(1);
end
end
function CloseEndModalForm(o,e);
begin
e.skip := true;
o.Endmodal(0);
end
function getinfo();
begin
return array(fnds[listbox1.getCurrentSelection()],edit1.text);
end
function setinfo();
begin
if parent then
begin
tr := parent.tree;
fnds := array();
tr.GetNodesBytype(fnds,array("form","panel"));
ss := array();
for i,v in fnds do
begin
ss[i] := v.Fname;
end
end
listbox1.Items := ss;
edit1.ExecuteCommand("ecselall");
end
public //成员变量
fnds;
label3;
listbox1;
btn1;
btn2;
label1;
edit1;
end
type TNameInput=class(TCustomControl) //输入文件名窗口
function Create(AOwner);override;
begin

7
designer/utslcodeeditor.tsf
View File

@ -1425,7 +1425,7 @@ type TPageEditerItem=class(TPageItem)
FEditer.ChangedFlag := false;
if not FTslSynText then return;
if not(s)then return;
r := tsl_tokenizeex_2_(s,1);
{r := tsl_tokenizeex_2_(s,1);
cs := r["class"];
if ifarray(cs)and cs[0]then
begin
@ -1438,8 +1438,9 @@ type TPageEditerItem=class(TPageItem)
end;
return; //返回
end
end
FTslParser := nil;
end}
if not FTslParser then FTslParser := new ttslscripparser(); #! end
//FTslParser := nil;
end
function GetClassInfo(); //获得信息
begin

24
designer/utslvcldcomponents.tsf
View File

@ -469,7 +469,7 @@ type TDComponent = class()
FTreeNode := nil;
FCwnd := nil;
end
function SetComponentProperties(n,v);
function SetComponentProperties(n,v,pp);
begin
{**
@explan(说明)修改属性%%
@ -480,7 +480,7 @@ type TDComponent = class()
begin
return SetComponentName(v);
end else
return FCwnd.SetPublish(n,v);
return FCwnd.SetPublish(n,v,pp);
end
end
function GetTrueComponent();virtual;
@ -753,7 +753,7 @@ type TDVirutalWindow = class(TCustomControl) //
end
return r;
end
function SetPublish(n,v);override; //设置属性
function SetPublish(n,v,pp);override; //ÉèÖÃÊôÐÔ
begin
if n in FWindowFileds then
begin
@ -761,7 +761,7 @@ type TDVirutalWindow = class(TCustomControl) //
end
if FBindComponent then
begin
return FBindComponent.SetPublish(n,v);
return FBindComponent.SetPublish(n,v,pp);
end
end
function DesigningSizer();override; //鼠标改变大小
@ -885,6 +885,17 @@ type TDForm = class(TDComponent)
d.openclassfile();
end
end
function opentfm(o,e);
begin
cp:=o.Component;
if not cp then exit;
nd := cp.TreeNode;
if nd then d := nd.owner.Designer;
if d then
begin
d.opentfm();
end
end
public
function menus();override;
begin
@ -892,6 +903,7 @@ type TDForm = class(TDComponent)
//r[0] := array("type":"menu","caption":"保存窗口");
idx := 0;
r[idx++] := array("type":"menu","caption":"打开tsf文件","onclick":thisfunction(OpenClass));
r[idx++] := array("type":"menu","caption":"´ò¿ªtfmÎļþ","onclick":thisfunction(opentfm));
r[idx++] := array("type":"menu","caption":"关闭窗口","onclick":thisfunction(closecurrentform));
r[idx++] := array("type":"menu","caption":"保存窗口","onclick":thisfunction(savecurrentform));
r[idx++] := array("type":"menu","caption":"粘贴","onclick":thisfunction(pasteclick));
@ -1230,7 +1242,7 @@ type TGraphicLabelWindow = class(TDVirutalWindow)
al := BindComp.TextAlign;
BindComp.CanvasDrawAlignText(self.canvas,self.ClientRect,self.caption,al);
end
function SetPublish(n,v);override;
function SetPublish(n,v,pp);override;
begin
r := inherited;
if n="bkbitmap" then bkbitmap := v;
@ -1262,7 +1274,7 @@ type TGraphicsplitterWindow = class(TDVirutalWindow)
//al := BindComp.TextAlign;
//BindComp.CanvasDrawAlignText(self.canvas,self.ClientRect,self.caption,al);
end
function SetPublish(n,v);override;
function SetPublish(n,v,pp);override;
begin
r := inherited;
//if n="color" then color := v;

12
funcext/tvclib/tcomponent.tsf
View File

@ -450,6 +450,7 @@ public //
#!end
private //设计器中属性事件相关
FEventsProperties;
FChangedPropertiesflg;
FChangedProperties;
FVariableProperties;
function GetPublishInfo();//属性获取
@ -551,6 +552,7 @@ public //
for i,vi in ps do
begin
n := vi["name"];
if ifarray(FChangedPropertiesflg) and FChangedPropertiesflg[n] then continue;
vv := FChangedProperties[n];
if ifnil(vv)then continue;
vit := vi["type"];
@ -568,14 +570,18 @@ public //
end
return r;
end
function SetChangedPublish(n,v);virtual;//设置属性
function SetChangedPublish(n,v,pp);virtual;//ÉèÖÃÊôÐÔ
begin
{**
@explan(说明) 设计器相关函数 %%
**}
if not ifarray(FChangedProperties)then FChangedProperties := array();
if not ifarray(FChangedPropertiesflg)then FChangedPropertiesflg := array();
if pp then FChangedPropertiesflg[n] := true;
//reindex(FChangedProperties,array(n:nil));
if FChangedProperties[n]=v then return ;
FChangedProperties[n]:= v;
if not(pp) then reindex(FChangedPropertiesflg,array(n:nil));
end
function DeleteChangedPublish(n);virtual;//删除属性
begin
@ -585,7 +591,7 @@ public //
reindex(FChangedProperties,array(n:nil));
end
end
function SetPublish(n,v);virtual;//设置属性
function SetPublish(n,v,pp);virtual;//ÉèÖÃÊôÐÔ
begin
{**
@explan(说明) 修改单个值,设计器使用 %%
@ -602,7 +608,7 @@ public //
if ifobj(otype)then
begin
iv := otype.UnformatEdit(v); //反转换
SetChangedPublish(n,iv); //保存
SetChangedPublish(n,iv,pp); //±£´æ
if vit="eventhandler" then //分类保存
begin
FEventsProperties[n]:= iv;

36
funcext/tvclib/tslvcl.tsf
View File

@ -208,7 +208,7 @@ type Ttfm2Component = class(TTmfParser)
self.Script := s;
lazydata := array();
//lazydata[0] := array();
darray := gettree();
darray := gettree2();
SetTfmData(owner,owner,darray,lazydata);
for i,v in lazydata do
begin
@ -228,6 +228,17 @@ type Ttfm2Component = class(TTmfParser)
Loadinherited(owner); //µ¼Èë
end
private
function hastfmfile(phs,cn);
begin
for i,v in phs do
begin
pi := v+cn+".tfm";
if fileexists("",pi) then
begin
return true;
end
end
end
function Loadtfmtoform(o,phs,cn);
begin
for i,v in phs do
@ -252,22 +263,23 @@ type Ttfm2Component = class(TTmfParser)
o2 := o;
phs := static GetSourceDirs();
objs := array();
fssourdirs := phs;
while true do
begin
ci := o2.classinfo();
cn := ci["classname"];
if cn="tdcreateform" or cn="tdcreatepanel" then return ;
if hastfmfile(phs,cn) then
begin
Loadtfmtoform(o2,phs,cn);
return ;
end
ic := ci["inherited"][0];
if((cn<>"tdcreateform") and (cn<>"tdcreatepanel")) then
begin
objs[length(objs)] := cn;
o2 := findclass(ic,o2);
end else break;
end
for i := length(objs)-1 downto 0 do
begin
Loadtfmtoform(o,phs,objs[i]);
end
end
if ic then
o2 := findclass(ic,o2);
else return ;
end
end
function GetSourceDirs();
begin
lps := GetLibPaths();

2
funcext/tvclib/utslvclmenu.tsf
View File

@ -802,7 +802,7 @@ private
end
end
public
function SetChangedPublish(n,v);virtual;
function SetChangedPublish(n,v,pp);virtual;
begin
{**
@explan(说明) 设计器相关函数 %%

327
funcext/tvclib/uvcpropertytypespersistence.tsf
View File

@ -90,7 +90,7 @@ type TTmfParserToken = class(TTmfParserbase)
FSyms; //符号
FNumberChar;
FHexChar;
Function SetScript(S);
Function SetScript(S);//设置文本
begin
IF FScript <> S then
begin
@ -105,7 +105,7 @@ type TTmfParserToken = class(TTmfParserbase)
end
end
public
class function sinit();override;
class function sinit();override;//初始化
begin
inherited;
end
@ -130,7 +130,7 @@ type TTmfParserToken = class(TTmfParserbase)
begin
return FCurrent<FScriptLen;
end
class function delct(r,ct,len,n);
class function delct(r,ct,len,n);//处理字符
begin
{**
@explan(说明) 处理当前字符 %%
@ -147,7 +147,7 @@ type TTmfParserToken = class(TTmfParserbase)
ct := "";
end
end
function GetNumber(len);
function GetNumber(len);//解析数字
begin
c := cchar();
r := "";
@ -218,7 +218,7 @@ type TTmfParserToken = class(TTmfParserbase)
goto parnb;
end
end
function GetBinary(len);
function GetBinary(len); //二进制数据
begin
r := "";
while whileok() do
@ -236,7 +236,7 @@ type TTmfParserToken = class(TTmfParserbase)
r += c;
end
end
function gettokens();
function gettokens();//解析字符
begin
{**
@explan(说明) 解析token %%
@ -335,7 +335,7 @@ type TTmfParserToken = class(TTmfParserbase)
end
return r;
end
function PHexNumber();
function PHexNumber();//16进制解析
begin
{**
@explan(说明)解析16进制数
@ -406,12 +406,14 @@ type TTmfParser = class(TTmfParserbase)
{**
@explan(说明)tmf文件解析 %%
**}
fssourdirs;
private
FCurrent;
FTokens;
FTokenlen;
FParsers;
FTree;
ftreeobj;
FS;
function SetScriptPath(fn);
begin
@ -421,18 +423,19 @@ type TTmfParser = class(TTmfParserbase)
if readFile(rwraw(),"",fn,0,size,data)then
begin
Script := data;
end
end else Script := "";
end
end
function SetScript(s);
begin
if fs <> s then
if (fs <> s) and ifstring(s) then
begin
FParsers.Script := s;
FTokens := FParsers.gettokens();
FTokenlen := length(FTokens);
FCurrent := 0;
FTree := nil;
ftreeobj := nil;
end
end
public
@ -535,21 +538,6 @@ type TTmfParser = class(TTmfParserbase)
return v;
end else
return tostn(v);
{sa := ord("a");
sz := ord("z");
s0 := ord("0");
s9 := ord("9");
IsVariableName
for i := 1 to length(v) do
begin
vi := v[i];
ov := ord(vi);
if not((ov>=sa and ov<=sz)or( ov>=s0 and ov<=s9)or(vi="_") ) then
begin
return tostn(v);
end
end
return v;}
end else
return tostn(v);
end
@ -563,6 +551,7 @@ type TTmfParser = class(TTmfParserbase)
r[length(r)]:= v["name"];
call(thisfunction,v,r);
end
return r;
end
function gettree();
begin
@ -574,6 +563,84 @@ type TTmfParser = class(TTmfParserbase)
return array();
//return echo tostn(CreateObj());
end
function gettree2(); //获得继承关系树
begin
d := gettreeasobject();
if d then
begin
d.setinhertedpaths(fssourdirs);//设置路径
d.initinherited();
return object2tree2(d);
end
end
function inheritedcoy(n,t,ht);
begin
d := gettreeasobject();
if d then
begin
d.setinhertedpaths(fssourdirs);//设置路径
d.initinherited();
return d.inheritedstr(n,t,ht,0);
end
return "";
end
function object2tree2(t); //获得继承关系
begin
r := array();
r["inherited"] := t.ifinherited;
r["class"] := t.fnodetype;
r["name"] := t.fnodename;
r["parent"] := t.finheritedname;
ps := array();
vps := t.getallpropertys();
for i,v in vps.IndexNames() do
begin
vi := vps[v];
ps[v] := array("name":v,"value":vi.fvalue,"type":vi.ftype,"pp":vi.finh);
end
objs := array();
fos := t.fobjects;
for i,v in fos.IndexNames() do
begin
objs[v] := object2tree2(fos[v]);
end
r["property"] := ps;
r["object"] := objs;
return r;
end
function gettreeasobject();
begin
if ftreeobj then return ftreeobj;
gettree();
if FTree then
begin
//ttfmnode
ftreeobj := createndeobjects(FTree);
return ftreeobj;
end
return nil;
end
function createndeobjects(d);
begin
if ifarray(d) then
begin
r := new ttfmnode(d["class"],d["name"]);
r.ifinherited := d["inherited"];
r.finheritedname := d["parent"];
for i,v in d["property"] do
begin
r.setprovalue(v["name"],v["value"],v["type"]);
end
for i,v in d["object"] do
begin
vi := createndeobjects(v);
r.addobject(vi);
end
return r;
end
end
function TSLasItem(d);
begin
if not ifarray(d)then return totfmstr(d);
@ -641,7 +708,13 @@ type TTmfParser = class(TTmfParserbase)
while whileok() do
begin
ctoken(tv,tt);
if tv="object" and(tt <> TT_STR)then return getobject();
if (tv="object" or tv="inherited") and(tt <> TT_STR) then
begin
r := getobject();
if tv="inherited" then
r["inherited"] := true;
return r;
end
end
end
function getobject();
@ -660,6 +733,7 @@ type TTmfParser = class(TTmfParserbase)
rt := getmembers();
r["property"]:= rt["property"];
r["object"]:= rt["object"];
r["parent"] := rt["parent"];
return r;
end
function GetSampleValue();
@ -727,9 +801,11 @@ type TTmfParser = class(TTmfParserbase)
while whileok() do
begin
ctoken(tv,tt);
if tv="object" and tt <> TT_STR then
if (tv="object" or tv="inherited") and tt <> TT_STR then
begin
ro := getobject();
if (tv="inherited") then
ro["inherited"] := true;
r["object"][objlen++]:= ro;
end else
if tv="end" and tt <> TT_STR then
@ -756,6 +832,15 @@ type TTmfParser = class(TTmfParserbase)
end
pp := tv;
end else
if tt=TT_SIG and tv="(" then
begin
while whileok() do
begin
ctoken(tv,tt);
if tt=TT_SIG and tv=")" then break;
r["parent"] := tv;
end
end else
PError("其他错误",1);
end
return r;
@ -1997,6 +2082,196 @@ end
//////////////////////////////////////////////////////////////////////////
implementation
type tproper = class()
function create(t,v);
begin
fvalue := v;
ftype := t;
end
fvalue;
ftype;
finh;
end
type ttfmnode = class()
function setinhertedpaths(phs);
begin
finheritedpaths := phs;
end
function create(t,n);
begin
fnodename := n;
fnodetype := t;
fpropertys := new tstrindexarray();
fobjects := new tstrindexarray();
finheritedpaths := array();
end
function initinherited();
begin
s := finheritedname;
if s and ifstring(s) then
begin
for i,v in finheritedpaths do
begin
fv := v+s+".tfm";
if fileexists("",fv) then
begin
oa := new TTmfParser();
oa.ScriptPath := fv;
nd := oa.gettreeasobject();
if ifobj(nd) then
begin
nd.setinhertedpaths(finheritedpaths);
nd.initinherited();
end
finheritednode := nd;
addinheritednode(nd);
return ;
end
end
end
end
function addinheritednode(nd); //处理继承的节点
begin
for i,v in fobjects.IndexNames() do
begin
ov := fobjects[v];
if ov.ifinherited then
begin
if ifobj(nd) then
begin
fd := nd.getnodebyname(ov.fnodename);
if fd then
begin
ov.finheritednode :=fd;
end else //不在
begin
fobjects.deleteindex(v);
end
end else
begin
fobjects.deleteindex(v);
end
end
ov.addinheritednode(nd);
end
end
function getnodebyname(sb);//获得节点
begin
if fobjects.HaveIndex(sb) then
begin
o := fobjects[sb];
return o;
end
for i,v in fobjects.IndexNames() do
begin
o := fobjects[v];
r := o.getnodebyname(sb);
if r then return r;
end
end
function addobject(nd);
begin
if nd then
begin
fobjects[nd.fnodename] := nd;
end
end
function delnodebyname(sb);//删除节点
begin
if fobjects.HaveIndex(sb) then
begin
o := fobjects[sb];
fobjects.deleteindex(sb);
return o;
end
for i,v in fobjects.IndexNames() do
begin
o := fobjects[v];
r := delnodebyname(sb);
if r then return r;
end
end
function setprovalue(p,v,t);//设置属性
begin
if not ifstring(p) then return ;
if ifnil(v) then fpropertys.deleteindex(p);
vobj := fpropertys[p];
if not vobj then
begin
vobj := new tproper(nil,true);
fpropertys[p] := vobj;
end
vobj.fvalue := v;
vobj.ftype := t;
end
function setobjpropvalue(sb,p,v,t);//设置值
begin
if fobjects.HaveIndex(sb) then
begin
o := fobjects[sb];
o.setprovalue(p,v,t);
return o;
end
for i,v in fobjects.IndexNames() do
begin
o := fobjects[v];
r := o.setobjpropvalue(sub,p,v,t);
if r then return r;
end
end
function getallpropertys();//获得所有属性
begin
if not exts then exts := array();
if finheritednode then
begin
r := finheritednode.getallpropertys();
for i,v in r.IndexNames() do
begin
r[i].finh := true;
end
end
if not r then r := new tstrindexarray();
for i,v in fpropertys.IndexNames() do
begin
r[i] := fpropertys[v];
end
return r;
end
function inheritedstr(n,t,ht,h);
begin
if ifnil(n) then n := fnodename;
if ifnil(t) then t := fnodetype;
ws := "";
if not(h>=0) then h := 0;
for i:= 0 to h-1 do
begin
ws+=" ";
end
r := ws+"inherited "+n+":"+t;
if ht then r+="("+ht+")";
r+="\r\n";
for i,v in fobjects.IndexNames() do
begin
vo := fobjects[v];
r+=vo.inheritedstr(nil,nil,nil,h+1);
end
r+="\r\n";
r+=ws+"end\r\n";
return r;
end
ifinherited;
finheritedname;
finheritednode;
fnodetype; //属性,对象
fnodename;
fobjects;
private
fpropertys;
finheritedpaths;
end
function tablelines(str,n);
begin
lines := str2array(str,"\r\n");