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

Compare commits

base: liujianjun:831166df5f5ca7ab20f7f671415309134952410b
Branches Tags
liujianjun:main
...
compare: liujianjun:533f6fef6149e847d3a1e1a13659be0999e560a5
Branches Tags
liujianjun:main

2 Commits
831166df5f ... 533f6fef61

Author SHA1 Message Date
JianjunLiu 533f6fef61 设计器 
打开多个
 2022-09-28 17:48:31 +08:00
JianjunLiu c33057b131 设计器 
修正bug
 2022-09-26 09:59:29 +08:00
5 changed files with 578 additions and 231 deletions
Show Stats Expand all files Collapse all files

357
designer/tslvcldesigner.tsf
View File

@ -12,9 +12,10 @@ type TVclDesigner = class(tvcform)
@explan(说明) 控件设计器 对象 %%
**}
private
fcwindowinfo;
fwindowinfos;
fcutcopyinfo;//复制的信息
FChmHelper; //帮助文档
tmpcanvas; //canvas
FImageList; //图标
FViewBitmap;
FCTrans;
@ -26,8 +27,7 @@ type TVclDesigner = class(tvcform)
FParser;
//********************************
FToolBars;
FTree;
FCurrentTreeNode;
FTree; //当前的树
FObjInspector;
FPropGrid;
FEventGrid;
@ -105,11 +105,17 @@ type TVclDesigner = class(tvcform)
// height := 90+32{+24}+5;
end
function TreeNode2tfmsub(lib,node,itemnames);//tmf文件字符串
function TreeNode2tfmsub(lib,node,itemnames,nd);//tmf文件字符串
begin
if not(node) then
begin
it := FTree.RootItem;
tr := ftree;
if nd then
begin
tr := fwindowinfos.gettreebyid(nd);
end
if not tr then return ;
it := tr.RootItem;
node := (it.items)[0];
end
if not ifarray(itemnames) then itemnames := array();
@ -232,35 +238,51 @@ type TVclDesigner = class(tvcform)
function cutnode(node);
begin
fcutcopyinfo := getnodeinfodata(node,1);
fcutcopyinfo[2] := true;
end
function pasttonode(nd);
begin
if fcutcopyinfo then
begin
r := pastinfotonode(nd,fcutcopyinfo);
if fcutcopyinfo["name"] and not(r) then fcutcopyinfo := nil; //如果失败就不清除内容
end
if not fcutcopyinfo then return ;
ifc := fcutcopyinfo[2];
r := pastinfotonode(nd,fcutcopyinfo,1,not(ifc));
if ifc and not(r) then fcutcopyinfo := nil; //如果失败就不清除内容
end
function pastinfotonode(nd,data);
function pastinfotonode(nd,data,fst,notcute);
begin
tc := data[0];
if ifstring(tc) then tc := class(TDComponent).GetClassItem(tc);
if (tc is class(TDRootComponent)) and not( tc is class(TDMenu)) then
begin
nd := (FTree.RootItem.items)[0];
tr := nd.owner;
nd := (tr.RootItem.items)[0];
end
nnd := tc.ComponentCreater(nd,nd.Component.Cwnd);
pwnd := nd.Component.Cwnd;
nnd := tc.ComponentCreater(nd,pwnd);
if not nnd then return 1; //加入失败处理
nnd.CreateName();
FVariableSelecter.additem(nnd);
BindCwndMessage(nnd.Cwnd);
if fst and (pwnd is class(TWinControl)) then
pclt := pwnd.ClientRect; //获得父节点区域
for i,v in data do
begin
if ifstring(i) then
vi := v;
if not ifstring(i) then continue;
///////////////////////
if pclt and ( (i = "left") or (i= "top") ) then //特殊位置处理
begin
//if i in array("left","top") then continue;
nnd.SetComponentProperties(i,v);
if notcute then //复制
begin
vi+=6;
end
pidx := 2;
if i = "top" then pidx := 3 ; //位置判断
if vi>pclt[pidx] then
begin
vi := integer(pclt[pidx]+(pclt[pidx-2]/2)-5); //位置处理
end
end
nnd.SetComponentProperties(i,vi);
end
for i,v in data[1] do
begin
@ -273,8 +295,8 @@ type TVclDesigner = class(tvcform)
r := array();
if tc is class(TDComponent) then
begin
r[0] := tc;
if f then r["name"] := tc.name;
r[0] := tc.dclassname() ;
//if f then r["name"] := tc.name;
cr := tc.GetChangedPublish(2);
for i,v in cr do
begin
@ -390,12 +412,12 @@ type TVclDesigner = class(tvcform)
if it then itt := it.Component;
if itt then itt.Cwnd.Enabled := f;
end
function TreeNode2tfm(lib,itemnames); //转换文件
function TreeNode2tfm(lib,itemnames,nd); //转换文件
begin
{**
@explan(说明) 将结构转换为文件格式 %%
**}
r := TreeNode2tfmsub(lib,nil,itemnames);
r := TreeNode2tfmsub(lib,nil,itemnames,nd);
if itemnames then itemnames := itemnames[1:];
return r;
end
@ -562,7 +584,7 @@ type TVclDesigner = class(tvcform)
else
begin //工程处理
FProjectManager.StopProject();
FProjectManager.CloseCurrentEdit();
FProjectManager.CloseCurrentEdit("all");
end
end
function CompClose(o,e); //隐藏控件
@ -656,7 +678,7 @@ type TVclDesigner = class(tvcform)
t := n.Component;
if not t then exit;
mu := t.CreateMenu();
FTree.PopupMenu := mu;
n.owner.PopupMenu := mu;
FPropGrid.Component := t;
FEventGrid.Component := t;
wd := t.cwnd ;
@ -670,9 +692,16 @@ type TVclDesigner = class(tvcform)
@explan(说明)右键菜单 %%
**}
nd := o._tag;
tr := nd.owner;
if not(tr.visible) then
begin
wnd := fwindowinfos.getnodebytree(tr);
FProjectManager.senodesel(wnd);
return ;//
end
if FCurrentNode<>nd then
begin
FTree.SetSel(nd);
nd.owner.SetSel(nd);
TreeNodeSelected(nd);
end
cp := nd.Component;
@ -757,11 +786,18 @@ type TVclDesigner = class(tvcform)
@explan(说明) 组件被点击 %%
**}
nd := o._tag;
tr := nd.owner;
if not(tr.visible) then
begin
wnd := fwindowinfos.getnodebytree(tr);
FProjectManager.senodesel(wnd);
return ;//
end
if FCurrentNode<> nd then
begin
wd := o;//nd.Component.Cwnd;
//if wd is class(TWincontrol) then _wapi.BringWindowToTop(wd.Handle);
FTree.SetSel(nd);
tr.SetSel(nd);
TreeNodeSelected(nd);
end;
setcomponentfocus(o,true);
@ -770,7 +806,7 @@ type TVclDesigner = class(tvcform)
//SetSysParam("cpos_screan",array(e.lolparam,e.hilparam));
if FComponentCreater is class(TDRootComponent) then
begin
FCurrentNode := (FTree.RootItem.items)[0];
FCurrentNode := (tr.RootItem.items)[0];
if not FCurrentNode then exit;
O1 := FCurrentNode.Component.Cwnd;
if not o1 then exit;
@ -818,13 +854,7 @@ type TVclDesigner = class(tvcform)
**}
cct := o._tag;
//if FComponentCreater=cct then exit;
FComponentCreater := cct;
return ;
fm := (FTree.RootItem.items)[0];
if not fm then exit;
O1 := fm.Component.Cwnd;
o1.show();
FComponentCreater := cct;
end
function CloseShowForm(); //主窗口关闭
@ -832,7 +862,7 @@ type TVclDesigner = class(tvcform)
{**
@explan(说明)关闭当前工程窗口%%
**}
FProjectManager.CloseCurrentEdit();
FProjectManager.CloseCurrentEdit(nil,true);
end
public
function BindCwndMessage(wnd);
@ -857,46 +887,152 @@ type TVclDesigner = class(tvcform)
//WM_NCLBUTTONUP wnd.
if (wnd is class(TVCForm)) then
begin
{wnd.Onclose := function(o,e)begin
e.skip := true;
CloseShowForm();
end ;}
wnd.OnMinimize := thisfunction(CompClose);
end
end
end
function UnLoadTreeNode();
function UnLoadTreeNode(wndnode);
begin
{**
@explan(说明) 卸载tree的节点%%
**}
fcutcopyinfo := nil;
node := FTree.RootItem;
//fcutcopyinfo := nil;
if wndnode = "all" then
begin
for i,v in fwindowinfos.fdata.data do
begin
FProjectManager.saveCurrentEdit(v.fnode);
UnLoadTreeNode(v.fnode);
end
return ;
end
nd := fwindowinfos.getdata(wndnode);
if not nd then return ;
hidenatree(nd);
tr := nd.ftree;
node := tr.RootItem;
if node.ItemCount>0 then
begin
DeleteNode((Node.items)[0]);
end
FVariableSelecter.clean();
FEventGrid.Component := array();
FPropGrid.Component := array();
//清除TemporaryNotName
class(TDComponent).TemporaryNotName := array();
fwindowinfos.deletedata(wndnode);
tr.Recycling();
end
private
FLoadInheritedName;
function hidenatree(nd);
begin
FCurrentNode := nil;
if nd then
begin
tr := nd.ftree;
tr.visible := false;
nd.fvars := FVariableSelecter.getlistds();
FEventGrid.Component := array();
FPropGrid.Component := array();
nd.ffuncs := FFunctionSelecter.List.data;
nd.fnames := class(TDComponent).TemporaryNotName;
class(TDComponent).TemporaryNotName:= array();
end
end
function showtree(nd);
begin
FCurrentNode := nil;
tr := nd.ftree;
tr.visible := false;
FTree.visible := true;
FVariableSelecter.setlistds(nd.fvars);
FFunctionSelecter.additems(nd.ffuncs);
class(TDComponent).TemporaryNotName := nd.fnames;
end
function switchtree(nd);
begin
FCurrentNode := nil;
if nd<>fcwindowinfo then
begin
if fcwindowinfo then //处理就有的
begin
hidenatree(fcwindowinfo);
end
fcwindowinfo := nd;
FTree := fcwindowinfo.ftree;
showtree(fcwindowinfo);
rnd := FTree.RootItem;
nnd := rnd.GetNodeByIndex(0);
if nnd then
begin
cp := nnd.Component;
if not cp then return ;
wd := cp.Cwnd;
if wd.visible then
begin
wd.visible := false;
wd.visible := true;
FPropGrid.Component := cp;
FEventGrid.Component := cp;
end
end
end
end
public
function LoadTreeNode(Ptfm,inh);
function ExecuteCommand(cmd,p);override;
begin
case cmd of
"allopendnod":
begin
r := array();
for i,v in fwindowinfos.fdata.data do
begin
r[i] := v.fnode;
end
return r;
end
"hiddrennode":
begin
hidenatree(fcwindowinfo);
fcwindowinfo := nil;
end
"renamefile": //修改名字
begin
node := FTree.RootItem;
nnd := node.GetNodeByIndex(0);
if nnd then
begin
nnd.Component.dclassname(p);
cp := nnd.caption;
pidx := pos(":",cp);
if pidx then cp[pidx:] := ":"+p;
nnd.caption := cp;
end
end
else
return inherited;
end ;
end
function LoadTreeNode(Ptfm,inh,wndnode);
begin
{**
@explan(说明) 加载tree节点 %%
**}
FLoadInheritedName := inh;
UnLoadTreeNode();
//UnLoadTreeNode();
if FTree and FTree.Loading then return ;
cwindowinfo := fwindowinfos.getorcreate(wndnode,ifold);
if cwindowinfo = fcwindowinfo then
begin
return ;//重复导入
end
switchtree(cwindowinfo);
//处理新的
if ifold then
begin
return ;//
end
FTree.Loading := true;
try
prs := array();
obarray := array();
loadtfmtotree(Ptfm,Ptfm.gettree,FTree.RootItem,FTree,prs,obarray);
loadtfmtotree(Ptfm,Ptfm.gettree,FTree.RootItem,FTree,prs,obarray,const inh);
for i,v in prs do
begin
va := obarray[v[2]];
@ -910,7 +1046,7 @@ type TVclDesigner = class(tvcform)
end ;
FTree.Loading := nil;
end
function loadtfmtotree(p,d,node,wr,prs,obarray);
function loadtfmtotree(p,d,node,wr,prs,obarray,inhname);
begin
{**
@explan(说明) 导入tfm文件 %%
@ -921,17 +1057,16 @@ type TVclDesigner = class(tvcform)
it := class(TDComponent).GetClassItem(dcls);
if not it then
begin
if ("tdcreateform" in FLoadInheritedName) then
if ("tdcreateform" in inhname) then
begin
it := NEW TDForm();
end else
if "tdcreatepanel" in FLoadInheritedName then
if "tdcreatepanel" in inhname then
begin
it := new TDPanelForm();
end else return ;
it.dclassname(d["class"]);
it.Imgs := FImageList.GetImageId("tdcreateform");
FLoadInheritedName := array();
end
comp := it.ComponentCreater(node,wr);
comp.name := d["name"];
@ -976,7 +1111,7 @@ type TVclDesigner = class(tvcform)
end
for i,v in d["object"] do
begin
call(thisfunction,p,v,comp.TreeNode,comp.Cwnd,prs,obarray);
call(thisfunction,p,v,comp.TreeNode,comp.Cwnd,prs,obarray,inhname);
end
for i,v in lazy do
begin
@ -993,15 +1128,15 @@ type TVclDesigner = class(tvcform)
FFunctionSelecter.additem("(none)");
for i,vi in v do
begin
if vi in array("create","destroy","recycling","loadfromtfm") then continue;
if vi in array("(none)","create","destroy","recycling","loadfromtfm") then continue;
FFunctionSelecter.additem(vi);
end
end
function create(AOwner);
begin
inherited;
tmpcanvas := new tcanvas(AOwner);
inherited;
top := 10;
left := 10;
rect := _wapi.GetScreenRect();
@ -1031,9 +1166,9 @@ type TVclDesigner = class(tvcform)
tparent.border := false;
pparent := new TPairSplitterSide(self);
//**********树************************
FTree := new TComponentTree(self);
FTree.onselchanged := thisfunction(ClickTreeNode);
FTree.align := alClient;
//FTree := new TComponentTree(self);
//FTree.onselchanged := thisfunction(ClickTreeNode);
//FTree.align := alClient;
//*************属性修改器**********************
pedits := new TPageControl(self);
pedits.align := alclient;
@ -1057,7 +1192,7 @@ type TVclDesigner = class(tvcform)
FObjInspector.parent := self;
tparent.parent := FObjInspector;
pparent.parent := FObjInspector;
FTree.parent := tparent;
//FTree.parent := tparent;
pedits.parent := pparent ;
FProp.parent := pedits;
FEvent.parent := pedits;
@ -1071,7 +1206,8 @@ type TVclDesigner = class(tvcform)
onactivate := thisfunction(OnDesignerActivate);
FImageList := new TDesigImageList(self);
FTree.Imagelist := FImageList;
//FTree.Imagelist := FImageList;
fwindowinfos := new tfilesinfo(self,thisfunction(ClickTreeNode),FImageList,tparent);
//******************toolbar ***************
tlbar := FProjectManager.FTslEditer.gettoolbar();
savebtn := FProjectManager.FTslEditer.gettoolbarbtn();
@ -1214,6 +1350,97 @@ end
implementation
type tfileinfonode = class()
fnode;
ftree;
ffuncs;
fvars;
fnames;
end
type tfilesinfo = class()
private
fdesginer;
fcompclick;
fimg;
fparent;
public
function create(dser,clk,img,fp);
begin
FData := new tnumindexarray();
fimg := img;
fcompclick := clk;
fdesginer := dser;
fparent := fp;
end
function getdata(id); //获得节点信息
begin
if not id then return fdata;
for i,v in fdata.data do
begin
if v.fnode = id then return v;
end
end
function gettreebyid(id);
begin
if not id then return fdata;
for i,v in fdata.data do
begin
if v.fnode = id then return v.FTree;
end
end
function getnodebytree(tr);
begin
for i,v in fdata.data do
begin
if v.ftree = tr then return v.fnode;
end
end
function getorcreate(id,ifold);
begin
nd := getdata(id);
ifold := true ;
if not nd then
begin
tr := new TComponentTree(fdesginer);
tr.visible := false;
tr.Align := tr.alClient;
tr.parent := fparent;
tr.onselchanged := fcompclick;
nd := add(id,tr,array(),array());
ifold := false;
end
return nd;
end
function add(nd,tr,fcs,vs);
begin
for i,v in FData.data do
begin
if v.fnode=nd then return 0;
end
nnd := new tfileinfonode();
FData.Push(nnd);
nnd.fnode := nd;
nnd.ftree := tr;
nnd.ffuncs := fcs;
nnd.fvars := vs;
return nnd;
end
function deletedata(id); //删除
begin
for i,v in FData.data do
begin
if v.fnode = id then
begin
r := v;
FData.splice(i,1);
return r;
end
end
end
ftreeparnet;
fdata;
end
type TPropEditGrid = class(TPropGrid)
{**
@explan(说明) 属性编辑 %%
@ -1559,7 +1786,7 @@ begin
o := class(TDComponent);
o.RegestorClassItems(its);
its := array();
o.class(TPropGrid);
o.class(TPropGrid);
for i,v in ini.ReadSectionValues("properties") do //属性
begin
if v then

308
designer/udesignerproject.tsf
View File

@ -361,7 +361,7 @@ type TProjectView = class(TVCForm) //
end
FTslEditer.OnFormCodeSave := function(o,e)
begin
if FOpendFormTSFfilename then FDesigner.EditerCodeChanged();
if FCurrentOpend and (FCurrentOpend["type"] in array("panel","form")) then FDesigner.EditerCodeChanged();
end
//FTslEditer.Parent := AOwner;
FTmfParser := new TTmfParser();
@ -476,8 +476,11 @@ type TProjectView = class(TVCForm) //
FWrapFolder.Caption := "打包工程到目录";
return;
end
function OpenTreeNode();
function senodesel(nd);
begin
ftree.setsel(nd);
end
function OpenTreeNode(); //打开当前节点
begin
if not FCProjectPath then return Messageboxa("工程没打开","提示",0,self);
cn := FTree.CurrentNode;
@ -495,45 +498,50 @@ type TProjectView = class(TVCForm) //
end
function TreeNodeChanged(o,e); //节点切换
begin
if not FTree.PopUpMenu then return;
it := e.itemnew;
if it then
begin
if it.FType="dir" then
if FTree.PopUpMenu then
begin
it := e.itemnew;
if it then
begin
FDelMenu.Enabled := true;
FAddMenu.Enabled := true;
end else
begin
FDelMenu.Enabled := true;
FAddMenu.Enabled := false;
if it.FType="dir" then
begin
FDelMenu.Enabled := true;
FAddMenu.Enabled := true;
end else
begin
FDelMenu.Enabled := true;
FAddMenu.Enabled := false;
end
if((it.FType="form")and(it.FName <> FMainForm)and(it.FPath()=""))then
begin
FSetMainMenu.parent := FTreePopUpMenu;
end else
begin
FSetMainMenu.parent := nil;
//FAddMenu.visible := false;
end
if(it.FType="tsl")and(it.FName <> FExecEntry)and(it.FPath()="")then
begin
FSetEntryMenu.parent := FTreePopUpMenu;
end else
FSetEntryMenu.parent := nil;
if((it.FType="form")and(it.FName <> FMainForm))or(it.FType="tsl")and(it.FName <> FExecEntry)or(it.FType="tsf")or(it.FType="panel") {or((it.FType = "dir") and it.parent<>FTree.RootNode)}then
begin
FRenameMenu.parent := FTreePopUpMenu;
if CreateMoveDirMenus()then FMoveMenu.parent := FTreePopUpMenu;
else FMoveMenu.parent := nil;
end else
begin
FRenameMenu.parent := nil;
FMoveMenu.parent := nil;
end
cn := FTree.CurrentNode;
OpenFileByName(cn.FName);
end
if((it.FType="form")and(it.FName <> FMainForm)and(it.FPath()=""))then
begin
FSetMainMenu.parent := FTreePopUpMenu;
end else
begin
FSetMainMenu.parent := nil;
//FAddMenu.visible := false;
end
if(it.FType="tsl")and(it.FName <> FExecEntry)and(it.FPath()="")then
begin
FSetEntryMenu.parent := FTreePopUpMenu;
end else
FSetEntryMenu.parent := nil;
if((it.FType="form")and(it.FName <> FMainForm))or(it.FType="tsl")and(it.FName <> FExecEntry)or(it.FType="tsf")or(it.FType="panel") {or((it.FType = "dir") and it.parent<>FTree.RootNode)}then
begin
FRenameMenu.parent := FTreePopUpMenu;
if CreateMoveDirMenus()then FMoveMenu.parent := FTreePopUpMenu;
else FMoveMenu.parent := nil;
end else
begin
FRenameMenu.parent := nil;
FMoveMenu.parent := nil;
end
end
end
//OpenTreeNode();
end
function Add_dir();
function Add_dir(); //添加目录
begin
if not FCProjectPath then return Messageboxa("工程没打开","提示",0,self);
if FInput.ShowModal()then
@ -643,21 +651,24 @@ type TProjectView = class(TVCForm) //
end
function ShowCurrentFormCode();
begin
if FOpendFormTSFfilename then FTslEditer.OpenAndGotoFileByName(FOpendFormTSFfilename);
if FCurrentOpend then r := FCurrentOpend.gettsfname();
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
begin
FTslEditer.Addfiled(FOpendFormTSFfilename,n);
r := FCurrentOpend.gettsfname();
FTslEditer.Addfiled(r,n);
end
end
function adduses(lbs); //添加成员
begin
if (lbs) and FCurrentOpend and(FCurrentOpend["type"] in array("form","panel"))then
begin
FTslEditer.adduses(FOpendFormTSFfilename,lbs);
r := FCurrentOpend.gettsfname();
FTslEditer.adduses(r,lbs);
end
end
@ -665,7 +676,8 @@ type TProjectView = class(TVCForm) //
begin
if ifstring(n) and FCurrentOpend and (FCurrentOpend["type"]in array("form","panel"))then
begin
FTslEditer.Delfiled(FOpendFormTSFfilename,n,nn);
r := FCurrentOpend.gettsfname();
FTslEditer.Delfiled(r,n,nn);
end
end
function AddAFunction(ff); //添加函数
@ -673,55 +685,55 @@ type TProjectView = class(TVCForm) //
if ifarray(ff) and ifstring(ff["name"])and FCurrentOpend and(FCurrentOpend["type"] in array("form","panel"))then
begin
s := createtslfunction(ff);
r := FTslEditer.AddFunction(FOpendFormTSFfilename,ff["name"],s);
fn := FCurrentOpend.gettsfname();
r := FTslEditer.AddFunction(fn,ff["name"],s);
ShowEditor();
return r;
end
end
function GoToAFunction(n); //跳转到函数
begin
r := FTslEditer.GoToFunction(FOpendFormTSFfilename,n);
r := FTslEditer.GoToFunction(FCurrentOpend.gettsfname(),n);
ShowEditor();
return r;
end
function OpenFileByName(n); //打开文件
begin
fio := ioFileseparator();
nopend := FTree.NameInTree(lowercase(n),nil,true);
if nopend then nopend := nopend.FFileInfo;
if not nopend then return 0;
if not(n and ifstring(n)) then return 0;
nopend := FTree.NameInTree(n,nil,true);
if not nopend then
begin
FDesigner.ExecuteCommand("hiddrennode",nil);
return ;
end
if nopend=FCurrentOpend then
begin
if FCurrentOpend["type"]in array("tsf","tsl","form","panel")then
{if FCurrentOpend["type"]in array("tsf","tsl","form","panel")then
begin
dir := FCurrentOpend["dir"];
if dir then dir += fio;
else dir := "";
FTslEditer.OpenAndGotoFileByName(FCProjectPath+dir+FCurrentOpend["name"]+"."+((FCurrentOpend["type"]in array("tsf","tsl"))?(FCurrentOpend["type"]):("tsf")));
fn := FCurrentOpend.geteditfilename();
FTslEditer.OpenAndGotoFileByName(fn);
ShowEditor(); //FTslEditer.Show();
end
end}
return 0;
end
CloseCurrentEdit();
FCurrentOpend := nopend;
case FCurrentOpend["type"]of
"tsl","tsf":
begin
dir := FCurrentOpend["dir"];
if dir then dir += fio;
else dir := "";
it := FTslEditer.OpenAndGotoFileByName(FCProjectPath+dir+FCurrentOpend["name"]+"."+FCurrentOpend["type"]);
FDesigner.ExecuteCommand("hiddrennode",nil);
fn := FCurrentOpend.geteditfilename();
it := FTslEditer.OpenAndGotoFileByName(fn);
if not it then return FCurrentOpend := nil;
FOpendScriptFileName := FCProjectPath+dir+FCurrentOpend["name"]+"."+FCurrentOpend["type"];
ShowEditor(); //FTslEditer.Show();
end
"form","panel":
begin
//打开class
dir := FCurrentOpend["dir"];
if dir then dir += fio;
else dir := "";
it := FTslEditer.OpenAndGotoFileByName(FCProjectPath+dir+FCurrentOpend["name"]+".tsf");
fn := FCurrentOpend.gettsfname();
it := FTslEditer.OpenAndGotoFileByName(fn);
if not it then
begin
FCurrentOpend := nil;
@ -740,20 +752,18 @@ type TProjectView = class(TVCForm) //
return messageboxa("非窗口类,或者该文件已经损坏","错误",0,self);
end
//打开界面
FOpendFormTSFfilename := FCProjectPath+dir+FCurrentOpend["name"]+".tsf";
FOpendScriptFileName := FOpendFormTSFfilename;
FDesigner.caption := "TVCL界面设计器 "+FprojName+"->"+FCurrentOpend["name"];
FCurrentTfmName := FCProjectPath+"resource.tfm"+fio+FCurrentOpend["name"]+".tfm";
FTmfParser.ScriptPath := FCurrentTfmName;
FTmfParser.ScriptPath := FCurrentOpend.gettmfname();
FTfmComponets := array();
FTmfParser.GetAllSubObjects(nil,FTfmComponets);
FDesigner.LoadTreeNode(FTmfParser,inh);
FDesigner.LoadTreeNode(FTmfParser,inh,FCurrentOpend);
FDesigner.EditerCodeChanged();
//FTslEditer.Show();
end else
begin
FDesigner.ExecuteCommand("hiddrennode",nil);
messageboxa("目前不支持打开该文件格式","提示",0,self);
FCurrentOpend := nil;
return;
end
end
@ -770,7 +780,7 @@ type TProjectView = class(TVCForm) //
return false; //
end
fio := ioFileseparator();
CloseCurrentEdit(); //保存当前信息
CloseCurrentEdit("all",true); //保存当前信息
FTslEditer.SaveAndClose();
FTree.ClearTree();
p := GetPathFromFullName(F,n,t);
@ -789,6 +799,7 @@ type TProjectView = class(TVCForm) //
FTree.InitDirs(d["dir"]);
FTree.RootDir := n;
FCProjectPath := p+fio;
FTree.fprojectpath := FCProjectPath;
FprojName := n;
FDesigner.caption := "TVCL界面设计器 "+FprojName;
FTree.ProjectNode.Expand();
@ -809,7 +820,7 @@ type TProjectView = class(TVCForm) //
FTslEditer.setExecuteEditerSetcmdline(d["commandline"]);
OpenMainForm(); //打开主窗口2
//设置选中节点 20210413 添加
mnode := FTree.NameInTree(lowercase(FMainForm),nil,true);
mnode := FTree.NameInTree((FMainForm),nil,true);
if FTree.CurrentNode <> mnode then
begin
FTree.SetSel(mnode);
@ -840,6 +851,7 @@ type TProjectView = class(TVCForm) //
cn := FTree.CurrentNode;
if cn.FType="dir" then DeleteCurrentDir();
else DeleteCurrentFile();
FCurrentOpend := nil;
end
function DeleteCurrentDir(); //删除当前目录;
begin
@ -850,7 +862,7 @@ type TProjectView = class(TVCForm) //
begin
if FCurrentOpend and FTree.FileNameInCurrentNode(FCurrentOpend["name"])then
begin
CloseCurrentEdit();
CloseCurrentEdit(nil,true);
end
if IDOK=Messageboxa("是否删除文件夹及其类容:"+cn.Caption,"提示",1,self)then
begin
@ -864,14 +876,13 @@ type TProjectView = class(TVCForm) //
function DeleteCurrentFile(); //删除当前的文件
begin
nd := FTree.CurrentNode;
if nd then d := nd.FFileInfo;
if not ifarray(d)then return;
d := nd;
fio := ioFileseparator();
if lowercase(d["name"]+".tsf")=lowercase(FMainForm+".tsf")then return Messageboxa("主窗口不能删除","提示",0,self);
if lowercase(d["name"]+".tsl")=lowercase(FExecEntry+".tsl")then return Messageboxa("执行入口文件不能删除","提示",0,self);
if IDOK=Messageboxa("即将从工程中移除:"+d["name"],"提示",1,self)then
begin
if FCurrentOpend and FCurrentOpend["name"]=d["name"]then CloseCurrentEdit();
CloseCurrentEdit(nd,true);
ml := d["dir"];
if ifstring(ml)and ml then ml := ml+fio;
else ml := "";
@ -892,7 +903,6 @@ type TProjectView = class(TVCForm) //
end
"tsf":
begin
//echo FCProjectPath+ml+d["name"]+"."+d["type"]+"\r\n";
FileDelete("",FCProjectPath+ml+d["name"]+"."+d["type"]);
end
end;
@ -1014,7 +1024,7 @@ type TProjectView = class(TVCForm) //
begin
if not LegalVariableName(n)then return MessageboxA("名字不合法,请重试","提示",0,self);
if FTree.NameInTree(lowercase(n),nil,false)then return MessageboxA("重复的文件名","提示",0,self);
CloseCurrentEdit();
//CloseCurrentEdit();
cn := FTree.CurrentNode;
if cn.FType="dir" then return;
fio := ioFileseparator();
@ -1080,6 +1090,7 @@ type TProjectView = class(TVCForm) //
cn.FFileInfo := cnifno;
cn.caption := n;
SaveProjInfo();
FDesigner.ExecuteCommand("renamefile",lowercase(n));
end else
return MessageboxA("更名错误","提示",0,self);
end
@ -1228,36 +1239,51 @@ type TProjectView = class(TVCForm) //
//FTslEditer.Show();
ShowEditor();
end
function saveCurrentEdit(); //保存正在编辑
function saveCurrentEdit(nd); //编辑的节点,不送入保存当前节点
begin
if FCurrentOpend then
if not nd then nd := FCurrentOpend;
if nd then
begin
case FCurrentOpend["type"]of
case nd["type"]of
"form","panel":
begin
//保存tfm
if FCurrentTfmName then
fn := nd.gettmfname();
if fn then
begin
tfm := FDesigner.TreeNode2tfm(lib,items);
ReWriteString(FCurrentTfmName,tfm);
tfm := FDesigner.TreeNode2tfm(lib,items,nd);
ReWriteString(fn,tfm);
end
end
end;
FTslEditer.SaveFileByName(FOpendScriptFileName);
FTslEditer.SaveFileByName(nd.geteditfilename());
end
end
function CloseCurrentEdit(); //关闭当前的编辑
function CloseCurrentEdit(nd,st); //关闭当前的编辑
begin
if FCurrentOpend then
if nd="all" then
begin
saveCurrentEdit();
r := FDesigner.ExecuteCommand("allopendnod",nil);
for i,v in r do
begin
CloseCurrentEdit(v,true);
end
return ;
end
if not nd then
begin
nd := FCurrentOpend;
end
if nd then
begin
saveCurrentEdit(nd);
//FTslEditer.CloseEditor();
FDesigner.caption := "TVCL界面设计器 "+FprojName;
FDesigner.UnLoadTreeNode();
//class(TDComponent).TemporaryNotName := array();
FCurrentOpend := nil;
FOpendFormTSFfilename := nil;
FOpendScriptFileName := nil;
if st then
begin
FDesigner.UnLoadTreeNode(nd);
if nd = FCurrentOpend then FCurrentOpend := nil;
end
end
end
private
@ -1268,7 +1294,7 @@ type TProjectView = class(TVCForm) //
begin
nd := FTree.CurrentNode;
if nd then
d := nd.FFileInfo;
d := nd.FFileInfo;
cp := nd.caption;
fio := ioFileseparator();
if not ifarray(d) then return ;
@ -1277,7 +1303,10 @@ type TProjectView = class(TVCForm) //
ndr := (o.caption="<主目录>")?"":(o.caption+fio);
if IDOK=Messageboxa("即将移动文件:"+d["name"]+" 到目录 "+ (ndr?ndr:"主目录"),"提示",1,self) then
begin
if FCurrentOpend and FCurrentOpend["name"] = d["name"] then CloseCurrentEdit();
if FCurrentOpend and FCurrentOpend["name"] = d["name"] then
begin
CloseCurrentEdit(nil,true);
end
ml := d["dir"];
if ifstring(ml) and ml then ml := ml+fio;
else ml := "";
@ -1451,8 +1480,6 @@ type TProjectView = class(TVCForm) //
end
private //私有成员变量
FWrapFolder;
FOpendFormTSFfilename;
FOpendScriptFileName;
FDesigner;
FCurrentOpend;
FOpenProjectFile;
@ -1489,7 +1516,8 @@ type TProjectView = class(TVCForm) //
FAddMenuTsl;
FOpenMenu;
public
FTslEditer;
FTslEditer;
private
end
type TTslEditer = class(TEditer)
@ -1675,7 +1703,13 @@ type TFileTree = class(TTreeCtl)
function Create(AOwner);override;
begin
inherited;
fio := AOwner.fio;
end
function operator[](idx);
begin
if ifarray(FFFileInfo) then
return FFFileInfo[idx];
end
property FType read FFType write SetFtype; //类型
function SetFtype(v);
begin
@ -1689,17 +1723,74 @@ type TFileTree = class(TTreeCtl)
ml := Owner.GetNodePath(self);
if FFType="dir" then
begin
if FName and ml then return ml+"\\"+FName;
if FName and ml then return ml+fio+FName;
return FName;
//return FName?():ml;
end else
return ml;
end
function FPath2();
begin
ml := Owner.GetNodePath(self);
if FFType="dir" then
begin
if FName and ml then return ml+fio+FName;
return FName;
//return FName?():ml;
end else
if ml then return ml+fio;
return ml;
end
function geteditfilename(nn);//获得编辑的文件名
begin
r := gettsfname(nn);
if r then return r;
r := gettslname(nn);
return r;
end
function gettsfname(nn); //获得tsf
begin
if FFType in array( "tsf","form","panel") then
begin
if not(ifstring(nn) and nn) then nn := Fname;
return Owner.fprojectpath+FPath2()+nn+".tsf";
end
end
function gettslname(nn); //获得tsl
begin
if FFType in array( "tsl") then
begin
if not(ifstring(nn) and nn) then nn := Fname;
return Owner.fprojectpath+FPath2()+nn+".tsl";
end
end
function gettmfname(nn);//tfm文件名
begin
if FFType in array( "form","panel") then
begin
if not(ifstring(nn) and nn) then nn := Fname;
return Owner.fprojectpath+"resource.tfm"+fio+nn+".tfm";
end
end
property FFileInfo read FFFileInfo write setfileinfo;
fio;
fdtree;
//function SetType()
FName; // a
FFType; //dir
FFileInfo;
private
function setfileinfo(v);
begin
FFFileInfo := v;
if ifarray(v) then
begin
FName := v["name"];
end
end
FFFileInfo;
end
fprojectpath;
fio;
function CreateTreeNode();override;
begin
return New TTNode(self);
@ -1710,7 +1801,7 @@ type TFileTree = class(TTreeCtl)
dir := array();
files := array();
GetNodeLeafs(FPNode,leafs);
fio := ioFileseparator();
//fio := ioFileseparator();
for i,v in leafs do
begin
ph := GetNodePath(v);
@ -1765,9 +1856,18 @@ type TFileTree = class(TTreeCtl)
end
end
end
function treefilename(n);
begin
{$ifdef linux}
return n;
{$endif}
return lowercase(n);
end
function NameInTree(n,nd,iffile); //名字是否在数上面
begin
//n为小写
if not ifstring(n)then return nil;
if not nd then nd := FPNode;
for i := 0 to nd.ItemCount-1 do
@ -1775,9 +1875,9 @@ type TFileTree = class(TTreeCtl)
ind := nd.GetNodeByIndex(i);
if(iffile)then
begin
if ind.FType <> "dir" and ind.FName=n then return ind;
if ind.FType <> "dir" and treefilename(ind.FName)=treefilename(n) then return ind;
end else
if ind.FName=n then return ind;
if treefilename(ind.FName) = treefilename(n) then return ind;
if ind.FType="dir" then
begin
r := NameInTree(n,ind,iffile);
@ -1788,6 +1888,8 @@ type TFileTree = class(TTreeCtl)
function Create(AOwner);override;
begin
inherited;
fprojectpath := "";
fio := ioFileseparator();
ImageList := CreateaImageList(self,FImageIdName);
hasline := true;
FPNode := CreateTreeNode();

130
designer/utslvcldcomponents.tsf
View File

@ -824,6 +824,7 @@ type TComponentTree = class(TTreeView) //
function create(AOwner);override;
begin
inherited;
asdomain := true;
FDesigner := AOwner;
end
function GetRootNode();override; //根节点
@ -854,7 +855,12 @@ type TDForm = class(TDComponent)
private
static FClassName;
static FParser;
function savecurrentform(o,e);
function closecurrentform(o,e); //关闭当前窗口
begin
cp := o.Component;
cp.Cwnd._send_(o.WM_CLOSE,0,0,1);
end
function savecurrentform(o,e);//保存当前窗口
begin
cp:=o.Component;
if not cp then exit;
@ -863,7 +869,6 @@ type TDForm = class(TDComponent)
if d then
begin
d.saveCurrentForm();
//d.openclassfile();
end
end
function OpenClass(o,e);
@ -882,9 +887,11 @@ type TDForm = class(TDComponent)
begin
r := array();
//r[0] := array("type":"menu","caption":"保存窗口");
r[0] := array("type":"menu","caption":"打开tsf文件","onclick":thisfunction(OpenClass));
r[1] := array("type":"menu","caption":"保存当前窗口","onclick":thisfunction(savecurrentform));
r[2] := array("type":"menu","caption":"粘贴","onclick":thisfunction(pasteclick));
idx := 0;
r[idx++] := array("type":"menu","caption":"打开tsf文件","onclick":thisfunction(OpenClass));
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));
//r[2] := array("type":"menu","caption":"打开工程目录","onclick":thisfunction(openProjectDir));
return r;
end
@ -958,6 +965,63 @@ type TDPanelForm = class(TDForm)
inherited;
end
end
type TDMenu = class(TDMenuBase)
{**
@explan(说明) 普通菜单设计器控件 %%
**}
function HitTip();override;
begin
return inherited;
return "menu通过右键添加";
end
function classification();override;
begin
return "非点击添加控件" ;
end
function InToolBar();override;
begin
return false;
end
function WndClass();override;
begin
return class(tmenu);
end
function Create(AOwner);override;
begin
inherited;
end
function CheckParent(p,pwnd);override;
begin
r := (p is class(TDMenu)) or
(p is class(TDMainMenu)) or
(p is class(TDPopUpMenu));
Pwnd := p.GetTrueComponent;
return r;
end
private
function ifmainmenunode(pwnd);
begin
if pwnd is class(tmainmenu) then return true;
if pwnd is class(tmenu) then
begin
return ifmainmenunode(pwnd.parent);
end
return false;
end
public
function SetViewParent(wnd,pwnd);override;
begin
if ifmainmenunode(pwnd) then wnd.parent := pwnd;
end
function ComponentCreater(node,owner);override;
begin
r := inherited;
node.owner.expand(node);
return r;
end
end
implementation
type TComponentMenu= class(tmenu) //设计器右键菜单
@ -1935,63 +1999,7 @@ type TDMainMenu = class(TDMenuBase)
end
type TDMenu = class(TDMenuBase)
{**
@explan(说明) 普通菜单设计器控件 %%
**}
function HitTip();override;
begin
return inherited;
return "menu通过右键添加";
end
function classification();override;
begin
return "非点击添加控件" ;
end
function InToolBar();override;
begin
return false;
end
function WndClass();override;
begin
return class(tmenu);
end
function Create(AOwner);override;
begin
inherited;
end
function CheckParent(p,pwnd);override;
begin
r := (p is class(TDMenu)) or
(p is class(TDMainMenu)) or
(p is class(TDPopUpMenu));
Pwnd := p.GetTrueComponent;
return r;
end
private
function ifmainmenunode(pwnd);
begin
if pwnd is class(tmainmenu) then return true;
if pwnd is class(tmenu) then
begin
return ifmainmenunode(pwnd.parent);
end
return false;
end
public
function SetViewParent(wnd,pwnd);override;
begin
if ifmainmenunode(pwnd) then wnd.parent := pwnd;
end
function ComponentCreater(node,owner);override;
begin
r := inherited;
node.owner.expand(node);
return r;
end
end
type TDAction = class(TDComponent)
{**
@explan(说明) action设计器控件 %%

1
designer/utslvcldebuger.tsf
View File

@ -723,6 +723,7 @@ type TTslDebuga=class(TCustomControl)
if n then
begin
//echo "\r\n====add:",usr,"====",n,"===",idx;
//echo "\r\n>>",(idx+1)," ",item.ScriptPath;
dbgsetbreak(FConnectchannel,usr,n,idx+1);
end
end

13
designer/utslvcldpropertytypes.tsf
View File

@ -573,10 +573,19 @@ type TListVariableFilter = class(TListVariable)
FDesigner.AddusesFromEdit(v.libs());
FDesigner.AddFiledFromEdit(v.name+":"+v.dclassname);
FDesigner.EditerCodeChanged();
//echo "\r\nadd:",v.name;
//echo "\r\n variable count:",FVlist.Count;
end
property Filter Write SetFilter;
function getlistds();
begin
r := array();
for i := 0 to FVlist.Count-1 do r[i] := FVlist[i];
return r;
end
function setlistds(d);
begin
FVlist.clean();
for i,v in d do FVlist.add(v);
end
private
FDesigner;
end