diff --git a/designer/tslvcldesigner.tsf b/designer/tslvcldesigner.tsf index d29edc0..6c7acf3 100644 --- a/designer/tslvcldesigner.tsf +++ b/designer/tslvcldesigner.tsf @@ -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 diff --git a/designer/udesignerproject.tsf b/designer/udesignerproject.tsf index 8ec2bf7..8a3c698 100644 --- a/designer/udesignerproject.tsf +++ b/designer/udesignerproject.tsf @@ -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 diff --git a/designer/utslcodeeditor.tsf b/designer/utslcodeeditor.tsf index 2f6726b..1e62982 100644 --- a/designer/utslcodeeditor.tsf +++ b/designer/utslcodeeditor.tsf @@ -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 diff --git a/designer/utslvcldcomponents.tsf b/designer/utslvcldcomponents.tsf index 4588aee..feac2c8 100644 --- a/designer/utslvcldcomponents.tsf +++ b/designer/utslvcldcomponents.tsf @@ -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; diff --git a/funcext/tvclib/tcomponent.tsf b/funcext/tvclib/tcomponent.tsf index 618c41f..87001df 100644 --- a/funcext/tvclib/tcomponent.tsf +++ b/funcext/tvclib/tcomponent.tsf @@ -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; diff --git a/funcext/tvclib/tslvcl.tsf b/funcext/tvclib/tslvcl.tsf index 573283e..e4fe31e 100644 --- a/funcext/tvclib/tslvcl.tsf +++ b/funcext/tvclib/tslvcl.tsf @@ -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(); diff --git a/funcext/tvclib/utslvclmenu.tsf b/funcext/tvclib/utslvclmenu.tsf index 83f0f0c..7cdc0c9 100644 --- a/funcext/tvclib/utslvclmenu.tsf +++ b/funcext/tvclib/utslvclmenu.tsf @@ -802,7 +802,7 @@ private end end public - function SetChangedPublish(n,v);virtual; + function SetChangedPublish(n,v,pp);virtual; begin {** @explan(说明) 设计器相关函数 %% diff --git a/funcext/tvclib/uvcpropertytypespersistence.tsf b/funcext/tvclib/uvcpropertytypespersistence.tsf index 9c61560..96e37f2 100644 --- a/funcext/tvclib/uvcpropertytypespersistence.tsf +++ b/funcext/tvclib/uvcpropertytypespersistence.tsf @@ -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 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");