tsheyongcong/tslediter
0
0
Fork 0
forked from liujianjun/tslediter
Code Issues Pull Requests Projects Releases Wiki Activity

设计器

Browse Source 
实现窗口继承
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
Download Patch File Download Diff File Expand all files Collapse all files
designer/tslvcldesigner.tsf
+14 -6
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
designer/udesignerproject.tsf
+286 -58
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
designer/utslcodeeditor.tsf
+4 -3
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
designer/utslvcldcomponents.tsf
+18 -6
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;