liujianjun
/
tslediter
3
0
Fork 1
Code Issues Pull Requests Projects Releases Wiki Activity
tslediter/designer/udesignerproject.tsf

3354 lines
109 KiB
Plaintext
Raw Blame History

Unit UDesignerProject;
interface
{**
@param(说明) 设计器工程相关工具,包括历史工程,工程目录管理,代码编辑器 %%
@date(20220518)
**}
uses utslvclauxiliary,tslvcl,utslmemo,UTslSynMemo,UVCPropertyTypesPersistence,UtslCodeEditor,utslvclsyntaxparser;
function SetWndPostWithMouse(wnd,lft);
type TProjectManagerForm = class(TVCForm) //工程管理 TCustomControl
function Create(AOwner);override;
begin
inherited;
minmaxbox := false;
Border := false;
FProjectCoder := new TDesignerProjectsRecoder();
FDesigner := AOwner;
visible := false;
WsSizeBox := true;
caption := "历史工程";
WsPopUp := true;
WsSysMenu := true;
rc := _wapi.GetScreenRect();
l :=(rc[2]-rc[0])/2-280;
t :=(rc[3]-rc[1])/2-230;
SetBoundsRect(array(l,t,480+l,300+t));
FList := new TProgValueList(self);
FList.Border := false;
d := GetAllProjects();
p := array();
for i,v in d do p[i]:= array("caption":v["name"],"value":v["file"]);
FList.SetData(p);
if p then FList.SetCurrentSelection(0);
FLinea := new TLabel(self);
FLinea.caption := "";
FLinea.height := 2;
FLinea.left :=-1;
FLinea.Color := rgb(30,144,255);
FLinea.parent := self;
FList.parent := self;
FList.OnDblClick := thisfunction(OpenSelectedObject);
FDelBtn := new TBtn(self);
FOpenBtn := new TBtn(self);
FDelBtn.caption := "移除(D)";
FOpenBtn.height := 28;
FDelBtn.height := 28;
FOpenBtn.caption := "打开(O)";
FDelBtn.parent := self;
FOpenBtn.parent := self;
FDelBtn.OnClick := function(o,e)
begin
cid := FList.getCurrentSelection();
if cid<0 then return;
it := FList.GetItem(cid);
if it then n := it["value"];
if not n then return;
if IDOK=Messageboxa("即将移除历史工程:"+n,"提示",1)then
begin
FProjectCoder.DeleteProject(it["caption"]);
FList.deleteItem(cid);
FList.SetCurrentSelection(0);
end
end
FOpenBtn.OnClick := thisfunction(OpenSelectedObject);
end
function OpenSelectedObject();
begin
visible := false;
cid := FList.getCurrentSelection();
if cid<0 then return;
it := FList.GetItem(cid);
if it then n := it["value"];
if not n then return;
FDesigner.LoadProject(n);
end
function OpenFileFromTpjFile(f); //从文件导入工程
begin
if not FileExists("",f)then return;
p := GetPathFromFullName(F,n,t);
if not(LegalVariableName(n)and t="tpj")then return;
ln := lowercase(n);
ls := GetAllProjects();
add := true;
for i,v in ls do
begin
if v["name"]=ln then
begin
add := false;
break;
end
end
if add then
begin
FProjectCoder.AddProject(ln,f);
//添加到list 中
FList.AppendItem(array("caption":ln,"value":f));
end
FDesigner.LoadProject(f);
end
function GetCurrentProjectName(); //获得工程名
begin
cid := FList.getCurrentSelection();
if cid<0 then return;
it := FList.GetItem(cid);
if it then n := it["value"];
return n;
end
function DoControlAlign();override;
begin
if FList and FDelBtn and FOpenBtn and FLinea then
begin
rc := ClientRect;
rc1 := rc;
rc1[3]-= 35;
FList.SetBoundsRect(rc1);
FLinea.top := rc1[3]+2;
tp := rc1[3]+5;
FDelBtn.Top := tp;
FDelBtn.left := rc[2]-200;
FOpenBtn.Top := tp;
FOpenBtn.left := rc[2]-100;
if rc[2]>FLinea.width then FLinea.width := rc[2];
end
end
function CreateTpjFomFile(f);
begin
if AddAproject(F)then
begin
OpenFileFromTpjFile(F);
end
end
private
function AddAproject(F); //添加一个工程
begin
if not ifstring(f)then return "工程名不合法";
if FileExists("",f)then return "工程已经存在";
p := GetPathFromFullName(f,n,t);
fio := ioFileseparator();
if length(FileList("",p+fio+"*"))>2 then
begin
if IDOK <> Messageboxa("文件夹非空,点击确定继续\r\n点击取消退出","文件夹非空",1)then return false;
end
if not(LegalVariableName(n))then return "工程名不合法"; // 名不合法
if findfunction(n)or findclass(n)then return "和现有的函数重名";
cprojpath := p+fio;
fn := f;
CreateDirWithFileName(cprojpath+"resource.tfm"+fio+"abc.tfm"); //构建窗口信息文件
info := array();
info["name"]:= n;
info["version"]:= "1.2.0";
info["dir"]:= array();
mfn := n+"main";
info["files"]:= array(
mfn:("name":mfn,"type":"form"),
n:("name":n,"type":"tsl")
);
info["mainform"]:= mfn;
info["time"]:= datetimetostr(now());
r := FormatTslData(info);
if 1 <> ReWriteString(cprojpath+n+".tpj",r)then
begin
return "无访问权限";
end
//ReWriteString(cprojpath+n+".cmd",format(%% tsl.exe %s.tsl -libpath .\ %%,n));
r := format(%% //工程%s界面库主程序
uses tslvcl; //引入界面库
app := InitializeApplication(); //获得界面管理器
app.CreateForm(get_main_wnd(),fm); //构造主窗口
fm.show(); //显示主窗口
app.run(); //开始消息循环
function get_main_wnd(); //获得主窗口,切换主窗口工程会修改该函数
begin
return class(%s);
end
%%,n,n+"main");
ReWriteString(cprojpath+n+".tsl",r);
ReWriteString(cprojpath+n+"main.tsf",CreateAForm(n+"main"));
ReWriteString(cprojpath+"resource.tfm"+fio+format("%smain.tfm",n),CreateAtfm(n+"main",n+"main"));
//写入缓存
FProjectCoder.AddProject(n,f);
//添加到list 中
FList.AppendItem(array("caption":n,"value":f));
return 1;
end
function GetAllProjects(); //获得工程名
begin
ls := FProjectCoder.ListProjects();
return ls;
end
FLinea;
FList;
FDelBtn;
FOpenBtn;
FOnOpenProject;
FDesigner;
FProjectCoder;
end
type TProjectView = class(TVCForm) //工程文件浏览
private
fseltimer;
FAddtoolbtn;
FTreePopUpMenu;
//**************目录树筛选功能***********************************
FFilter;
FFilterList;
FFilterNodes;
Fhighlightpath;
function ShowFilterList(d);
begin
if not FFilterList.visible then
begin
xy := FFilter.clienttoscreen(FFilter.left,FFilter.height);
rec := xy;
rec[2] := xy[0]+FFilter.width;
rec[3] := xy[1]+200;
FFilterList.SetBoundsRect(rec);
FFilterList.Show(SW_SHOWNOACTIVATE);
end
FFilterList.SetData(d);
end
function saveformcode(fn); //保存当前class
begin
if ifstring(fn) and fn then
begin
it := FTslEditer.OpenAndGoLineByName(fn);
end else
it := FTslEditer.GetCurrentItem();
FTslEditer.SavePageItem(it);
end
public
function FilterKillFocus(o,e);
begin
fseltimer.timeout(thisfunction(seltimerdo),500);
//if FFilterList.visible then FFilterList.visible := false;
end
function FilterChanged(o,e);
begin
s := o.text;
if s then
begin
s := lowercase(s);
FFilterNodes := array();
FTree.GetNodesByName(FFilterNodes,s);
if FFilterNodes then
begin
ndsn := array();
for i,v in FFilterNodes do
begin
ndsn[i] := v.Fname ;
end
return ShowFilterList(ndsn);
end
end
FFilterList.visible := false;
end
function filterselect();
begin
if FFilterList.visible then
begin
FFilterList.visible := false;
FFilter.text := "";
idx := FFilterList.getCurrentSelection();
if idx >= 0 then
begin
FTree.SetSel(FFilterNodes[idx]);
end
end
end
function Filterclksel();
begin
if FFilterList.visible then
begin
FFilterList.visible := false;
FFilter.text := "";
idx := FFilterList.getCurrentSelection();
if idx >= 0 then
begin
FTree.SetSel(FFilterNodes[idx]);
end
end
end
function FilterKeyDown(o,e);
begin
cc := e.CharCode;
if cc=13 then
begin
filterselect();
end else
if cc =VK_DOWN then
begin
if FFilterList.visible then
begin
idx := FFilterList.getCurrentSelection();
ct := length(FFilterNodes);
nidx := (idx+1) mod ct ;
FFilterList.SetCurrentSelection(nidx);
FFilterList.InsureIdxInClient(nidx);
end
end else
if cc=VK_UP then
begin
e.skip := true;
if FFilterList.visible then
begin
idx := FFilterList.getCurrentSelection();
ct := length(FFilterNodes);
nidx := (idx-1+ct) mod ct ;
FFilterList.SetCurrentSelection(nidx);
FFilterList.InsureIdxInClient(nidx);
end
end
end
function FilterKeyPress(o,e);
begin
cc := e.CharCode;
if cc=95 or (cc>=65 and cc<(65+32)) or (cc>96 and cc<(96+32)) or (cc=8) then
begin
end
else e.skip := true;
end
function seltimerdo(o,e);
begin
if FFilterList.visible then FFilterList.visible := false;
end
//**************目录树筛选功能***********************************
//////////////////构造函数//////////////////////////////
function Create(AOwner);override;
begin
inherited;
fseltimer := new TTimer(self);
//
minmaxbox := false;
FDesigner := AOwner;
//visible := false;
onclose := thisfunction(CloseHidden);
WsPopup := true;
WsSysMenu := true;
WsSizeBox := true;
caption := "管理工程文件";
rc := _wapi.GetScreenRect();
left := 20;
top := 150;
width := 300; //350
height := max(400,rc[3]-200);
FInput := new TNameInput(self);
finheritedinput := new tfm_inheritedwnd(self);
finheritedinput.parent := self;
FInput.visible := false;
FInput.parent := self;
FTslEditer := new TTslEditer(AOwner);
FTslEditer.FExecuteEditer.cannotadd := true;
FTslEditer.FExecuteEditer.onsaveclk := function(o,e)
begin
SaveProjInfo();
end
FTslEditer.ReadOnlyDirs := array(GetVCLdir());
fio := ioFileseparator();
bpath := TS_GetUserProfileHome();
FTslEditer.TslCacheDir := bpath+"designer"+fio+"cmpCaches";
FCodeblockPath := bpath+"editer"+fio+"BlockManager.tsm";
Fhighlightpath := bpath+"editer"+fio+"highlight.tsm";
if 1=importfile(ftstream(),"",FCodeblockPath,blockd)and blockd and ifarray(blockd)then
begin
class(TTSLCompletion).FCodeBlocks := blockd;
end
if importfile(ftstream(),"",Fhighlightpath,wdtd)=1 and ifarray(wdtd)then
begin
FTslEditer.hltcolor := wdtd;
end
if importfile(ftstream(),"",bpath+"editer"+fio+"tabwidpath.tsm",wdtd)=1 and(wdtd>0)then
begin
FTslEditer.TabWidth := wdtd;
end
if 1=Importfile(ftstream(),"",bpath+"editer"+fio+"tslformat.tsm",FMTDATA)and ifarray(FMTDATA)then
begin
FTslEditer.SetCodeFormatInfo(FMTDATA);
end
FTslEditer.OnFormCodeSave := function(o,e) ;//TFTSLScriptcustomMemo
begin
nd := FTree.CurrentNode;
if nd and (nd["type"] in array("panel","form")) then FDesigner.EditerCodeChanged(nd);
end
//FTslEditer.Parent := AOwner;
FTmfParser := new TTmfParser();
FTslParser := new ttslscripparser();
FTreeTool := new TToolBar(self);
FTreeTool.parent := self;
imgs := New TControlImageList(self);
imgs.width := 24;
imgs.height := 24;
imgs.DrawBmpFirst := true;
EditToolBmps := array();
for i,v in GetToolBtns() do
begin
bmp := new TBitmap();
bmp.ReadVCon(HexFormatStrToTsl(v));
imgs.AddBmp(bmp);
EditToolBmps[i]:= bmp;
btn := new TToolButton(self);
btn.caption := i;
btn.ImageId := imgs.ImageCount-1;
btn.parent := FTreeTool;
btn.Onclick := thisfunction(ToolClick);
if i="添加" then
begin
FAddtoolbtn := btn;
end
end
FTreeTool.ImageList := imgs;
//**************目录树筛选功能***********************************
FFilter := new TEdit(self);
FFilterList := new TListBox(self);
FFilterList.color := 0xdcF8ff;
FFilterList.visible := false;
FFilterList.WsPopUp := TRUE;
FFilterList.parent := FFilter;
FFilter.Align := alTop;
FFilter.parent := self;
FFilter.OnKeyPress := thisfunction(FilterKeyPress);
FFilter.onkeydown := thisfunction(FilterKeydown);
FFilter.OnChange := thisfunction(FilterChanged);
FFilter.onSetFocus := thisfunction(FilterChanged);
FFilter.onKillFocus := thisfunction(FilterKillFocus);
FFilterList.onmouseup := thisfunction(Filterclksel);
//************************************************************
FTree := new TFileTree(self);
FTree.Align := alClient;
FTree.Parent := self;
//菜单处理
fpm := new TPopUpMenu(self);
FTreePopUpMenu := fpm;
bmps := array();
for i,v in GetTreeIcons() do
begin
bi := new TBitmap();
bi.ReadVCon(HexFormatStrToTsl(v));
bmps[i]:= bi;
end
FAddMenu := new TPopUpMenu(self);
FAddtoolbtn.PopUpMenu := FAddMenu;
FAddMenu.bitmap := EditToolBmps["添加"];
FAddMenu.Caption := "添加";
FSetMainMenu := new TMenu(self);
FSetMainMenu.caption := "设置为主窗口";
FSetMainMenu.bitmap := bmps["主窗口"];
FSetMainMenu.OnClick := thisfunction(SetAsMainWind);
//FSetEntryMenu := new TMenu(self);
//FSetEntryMenu.Caption := "设置为入口脚本";
//FSetEntryMenu.bitmap := bmps["入口"];
//FSetEntryMenu.OnClick := thisfunction(SetAsMainWind);
FDelMenu := new TPopUpMenu(self);
FDelMenu.bitmap := EditToolBmps["删除"];
FDelMenu.Caption := "删除";
FDelMenu.Onclick := thisfunction(DeletCTNode);
FAddMenu.parent := fpm;
FDelMenu.Parent := fpm;
FAddMenuForm := new TMenu(self);
FAddMenuForm.Caption := "添加窗口";
FAddMenuForm.bitmap := bmps["form"];
FAddMenuForm.parent := FAddMenu;
FAddMenuPanel := new TMenu(self);
FAddMenuPanel.Caption := "添加面板";
FAddMenuPanel.bitmap := bmps["panel"];
FAddMenuPanel.parent := FAddMenu;
FAddMenuTsf := new TMenu(self);
FAddMenuTsf.Caption := "添加函数";
FAddMenuTsf.bitmap := bmps["tsf"];
FAddMenuTsf.parent := FAddMenu;
FAddMenuTsl := new TMenu(self);
FAddMenuTsl.Caption := "添加脚本";
FAddMenuTsl.bitmap := bmps["tsl"];
FAddMenuTsl.parent := FAddMenu;
FAddMenuDir := new TMenu(self);
FAddMenuDir.Caption := "添加目录";
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);
FRenameMenu.caption := "重命名";
FRenameMenu.bitmap := bmps["重命名"];
FRenameMenu.OnClick := thisfunction(DoRename);
FAddMenuForm.OnClick := thisfunction(Add_form);
FAddMenuPanel.OnClick := thisfunction(Add_panel);
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["打开"];
FOpenMenu.OnClick := thisfunction(OpenTreeNode);
FOpenMenu.parent := fpm;
FTree.OnSelChanged := thisfunction(TreeNodeChanged);
ftree.OnSelChanging := thisfunction(treenodechanging);
FTree.OnDblClick := function(o,e)
begin
OpenTreeNode();
end
FWrapFolder := new TFolderChooseADlg(self);
FWrapFolder.Caption := "打包工程到目录";
fnewmenu := new TMenu(self);
fgoformmenu := new TMenu(self);
fgoformmenu.caption := "回到设计器";
fgoformmenu.ShortCut := "f12";
fgoformmenu.OnClick := thisfunction(filetoform);
fnewmenu.Enabled := false;
fgoformmenu.Enabled := false;
fnewmenu.caption := "新建";
for i,v in array("form","panel","script","tsf") do
begin
it := new TMenu(self);
it.caption := v;
it.parent := fnewmenu;
it.OnClick := thisfunction(newadd);
end
return;
end
function setnodesel(nd);
begin
if fopenbuzy then return ;
ftree.setsel(nd);
end
function OpenTreeNode(); //打开当前节点
begin
if not FCProjectPath then return Messageboxa("工程没打开","提示",0,self);
cn := FTree.CurrentNode;
fio := ioFileseparator();
if cn.FType="dir" then
begin
n := cn.FPath;
CreateDirWithFileName(FCProjectPath+n+fio+"1.txt");
//_wapi.WinExec('cmd.exe /C start "" "'+FCProjectPath+n,1);
_wapi.openresourcemanager(FCProjectPath+n);
end else
begin
OpenFileByName(cn.FName);
end
end
function treenodechanging(o,e);
begin
if fopenbuzy then
begin
e.skip := true;
end
end
function TreeNodeChanged(o,e); //节点切换
begin
if FTree.PopUpMenu then
begin
it := e.itemnew;
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
begin
FDelMenu.Enabled := false;
end else
FDelMenu.Enabled := true;
FAddMenu.Enabled := true;
end else
begin
if ((lowercase(it["name"]+".tsf")=lowercase(FMainForm+".tsf")) or (lowercase(it["name"]+".tsl")=lowercase(FExecEntry+".tsl"))) then
begin
FDelMenu.Enabled := false;
end else 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(it)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
end
//OpenTreeNode();
end
function newadd(o,e);
begin
cnd := getdefaultdir();
if not cnd then return ;
case o.caption of
"tsf":
begin
AddTsfToCurrentDir(createnamea("func"),"tsf",cnd);
end
"script":
begin
AddTsfToCurrentDir(createnamea("tsl"),"tsl",cnd);
end
"panel":
begin
AddPanelToCurrentDir(createnamea("pal"),cnd);
end
"form":
begin
AddFormToCurrentDir(createnamea("form"),cnd);
end
end
end
function Add_dir(); //添加目录
begin
if not FCProjectPath then return Messageboxa("工程没打开","提示",0,self);
if FInput.ShowModal()then
begin
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);
if FInput.ShowModal()then
begin
RenameCurrentDir(FInput.GetEditV(1));
end
end
function add_exist(); //添加
begin
if not FCProjectPath then return Messageboxa("工程没打开","提示",0,self);
if not ffileadder then
begin
ffileadder := new TOpenFileADlg(self);
ffileadder.parent := self;
end
if not ffileadder.OpenDlg() then return ;
fn := ffileadder.filename;
if 1=parseregexpr("(.+)(\\W)(\\w+)\\.tsl$",fn,"",m,mp,ml) then
begin
//return "add tsl";
addexisttsl(m);
end
if 1=parseregexpr("(.+)(\\W)([A-Za-z]\\w+)\\.tsf$",fn,"",m,mp,ml) then
begin
//return "add tsf";
addexisttsf(m);
end
//
end
function addexisttsl(m);
begin
//检查变量名是否合规
//拷贝文件
//添加信息
end
function addexisttsf(m,cnd);
begin
//检查变量名是否合规
c_n := lowercase(m[0,3]);
if FTree.NameInTree(c_n,nil,true)then return MessageboxA("已经存在同名的文件","提示",0,self);
if cnd then
begin
ph := cnd.FPath;
end else
begin
ph := FTree.CurrentNode.FPath;
end
fn := array("name":n,"type":"tsf","dir":ph);
if fileexists("",m[0,1]+m[0,2]+m[0,3]+".tfm") then
begin
pr := new ttslscripparser();
pr.ScriptPath := m[0,0];
abt := pr.GetClassAbstract();
if abt and (lowercase(abt["name"]) = c_n) then
begin
hi := abt["inherited",0];
if ifstring(hi) then
begin
case lowercase(hi) of
"tdcreatepanel":
begin
end
"tdcreateform":
begin
end else
begin
ns := array();
FTree.GetNodesByName(ns,hi) ;
for i,v in ns do
begin
if lowercase(v.Fname)=hi then
begin
return ;
end
end
end
end
end
end
end
//添加普通tsf文件
end
function Add_form();
begin
if not FCProjectPath then return Messageboxa("工程没打开","提示",0,self);
return AddFormToCurrentDir(createnamea("form"));
if FInput.ShowModal()then
begin
AddFormToCurrentDir(FInput.GetEditV(1));
end
end
function Add_panel();
begin
if not FCProjectPath then return Messageboxa("工程没打开","提示",0,self);
return AddPanelToCurrentDir(createnamea("pal"));
if FInput.ShowModal()then
begin
AddPanelToCurrentDir(FInput.GetEditV(1));
end
end
function Add_tsf();
begin
if not FCProjectPath then return Messageboxa("工程没打开","提示",0,self);
return AddTsfToCurrentDir(createnamea("func"),"tsf");
if FInput.ShowModal()then
begin
AddTsfToCurrentDir(FInput.GetEditV(1),"tsf");
end
end
function add_tsl();
begin
if not FCProjectPath then return Messageboxa("工程没打开","提示",0,self);
return AddTsfToCurrentDir(createnamea("tsl"),"tsl");
if FInput.ShowModal()then
begin
AddTsfToCurrentDir(FInput.GetEditV(1),"tsl");
end
end
function ToolClick(o,e); //工具条点击
begin
if not FCProjectPath then return Messageboxa("工程没打开","提示",0,self);
case o.Caption of
"添加":
begin
nd := FTree.CurrentNode;
if not(nd)or(nd.FType <> "dir")then return Messageboxa("请选择目录节点然后添加","提示",0,self);
FTreeTool.DoClick(FTreeTool,e);
end
"删除":
begin
DeletCTNode();
end
"打开":
begin
OpenTreeNode();
end
"上移":
begin
nd := FTree.CurrentNode;
if nd then
begin
pnd := nd.parent;
idx := pnd.indexof(nd);
nd.MoveUp();
if idx <> pnd.indexof(nd)then
begin
SaveProjInfo();
end
end
end
"下移":
begin
nd := FTree.CurrentNode;
if nd then
begin
pnd := nd.parent;
idx := pnd.indexof(nd);
nd.movedown();
if idx <> pnd.indexof(nd)then
begin
SaveProjInfo();
end
end
end else
begin
o.Enabled := false;
end
end
end
function GetFormClassInfo(nd); //获得编辑器中类的变量信息
begin
if nd then
begin
f1 := nd.gettsfname();
it := FTslEditer.GetCurrentItem();
f2 := it.ScriptPath;
if f1<>f2 then return ;
end
return FTslEditer.GetClassInfo();
end
function filetoform();
begin
it := FTslEditer.GetCurrentItem();
if not it then return ;
f := it.ScriptPath;
r := getnodebyfilename(f,FTree.RootNode) ;
if not r then return ;
if r=FTree.CurrentNode then
begin
OpenFileByName(r.Fname);
FDesigner.ExecuteCommand("shownode",nil);
end else
setnodesel(r);
end
function ShowEditor(); //显示函数编辑
begin
FTslEditer.Show(SW_SHOWNOACTIVATE); //
_wapi.bringWindowToTop(FTslEditer.Handle);
end
function hiddeneditor(rc);//隐藏
begin
if FTslEditer.visible then
begin
if ifarray(rc) then
begin
if not(intersectrect(rc,FTslEditer.BoundsRect)) then return;
end
FTslEditer.visible := false;
end
end
function ShowCurrentFormCode();
begin
if FCurrentOpend then r := FCurrentOpend.gettsfname();
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
begin
r := FCurrentOpend.gettsfname();
FTslEditer.Addfiled(r,n);
saveformcode(r);
end
end
function adduses(lbs); //添加成员
begin
if (lbs) and FCurrentOpend and(FCurrentOpend["type"] in array("form","panel"))then
begin
r := FCurrentOpend.gettsfname();
FTslEditer.adduses(r,lbs);
saveformcode(r);
end
end
function DeleteAFiled(n,nn); //删除成员
begin
if ifstring(n) and FCurrentOpend and (FCurrentOpend["type"]in array("form","panel"))then
begin
r := FCurrentOpend.gettsfname();
FTslEditer.Delfiled(r,n,nn);
saveformcode(r);
end
end
function AddAFunction(ff); //添加函数
begin
if ifarray(ff) and ifstring(ff["name"])and FCurrentOpend and(FCurrentOpend["type"] in array("form","panel"))then
begin
s := createtslfunction(ff);
fn := FCurrentOpend.gettsfname();
r := FTslEditer.AddFunction(fn,ff["name"],s);
saveformcode(fn);
ShowEditor();
return r;
end
end
function GoToAFunction(n); //跳转到函数
begin
fn := FCurrentOpend.gettsfname();
r := FTslEditer.GoToFunction(fn,n);
saveformcode(fn);
ShowEditor();
return r;
end
function OpenFileByName(n); //打开文件
begin
if fopenbuzy then return ;
fio := ioFileseparator();
if not(n and ifstring(n)) then return FDesigner.ExecuteCommand("hiddrennode",nil);;
nopend := FTree.NameInTree(n,nil,true);
if not nopend then
begin
FDesigner.ExecuteCommand("hiddrennode",nil);
return ;
end
if nopend=FCurrentOpend then
begin
return 0;
end
FCurrentOpend := nopend;
case FCurrentOpend["type"]of
"tsl","tsf":
begin
FDesigner.ExecuteCommand("hiddrennode",nil);
fn := FCurrentOpend.geteditfilename();
it := FTslEditer.OpenAndGotoFileByName(fn);
if not it then
begin
return FCurrentOpend := nil;
end
ShowEditor(); //FTslEditer.Show();
end
"form","panel":
begin
//打开class
fn := FCurrentOpend.gettsfname();
if FTslEditer.getpageitemcount()<1 then
it := FTslEditer.OpenAndGotoFileByName(fn);
else it := FTslEditer.OpenAndGoLineByName(fn);
if not it then
begin
FCurrentOpend := nil;
return messageboxa("文件不存在","错误",0,self);
end
inh := getwindowinherited(n);
if not(ifarray(inh)and(inh intersect array("tdcreateform","tdcreatepanel")))then
begin
FCurrentOpend := nil;
return messageboxa("非窗口类,或者该文件已经损坏","错误",0,self);
end
//打开界面
fopenbuzy := true;
FDesigner.caption := "TVCL界面设计器 "+FprojName+"->"+FCurrentOpend["name"];
FTmfParser.fssourdirs := FCurrentOpend.gettmfdirs();
tfm := FCurrentOpend.gettmfname();
it := FTslEditer.OpenAndGoLineByName(tfm);
if it then
begin
//FTmfParser.ScriptPath := FCurrentOpend.gettmfname();
sc := it.FEditer.text;
FTmfParser.Script := sc;
FCurrentOpend.ftfmscript := sc;
FTslEditer.CloseScriptByFileName(tfm);
//FTfmComponets := array();
//FTmfParser.GetAllSubObjects(nil,FTfmComponets);
FDesigner.LoadTreeNode(FTmfParser,inh,FCurrentOpend);
xx := FTslEditer.OpenAndGotoFileByName(FCurrentOpend.gettsfname());
FDesigner.EditerCodeChanged(FCurrentOpend);
end
fopenbuzy := false;
end else
begin
FDesigner.ExecuteCommand("hiddrennode",nil);
messageboxa("目前不支持打开该文件格式","提示",0,self);
FCurrentOpend := nil;
return;
end
end
fopenbuzy := false;
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);
FTree.SetSel(nd);
//OpenFileByName(FMainForm);
end
function SetProjectInfo(F); //设置信息 %%
begin
if FOpenProjectFile=F then
begin
if FOpenProjectFile then OpenMainForm();
return false; //
end
fio := ioFileseparator();
CloseCurrentEdit("all",true); //保存当前信息
FTslEditer.SaveAndClose();
FTree.ClearTree();
p := GetPathFromFullName(F,n,t);
FMainForm := nil;
FprojName := "";
FExecEntry := "";
FTree.RootDir := "";
FCProjectPath := "";
FOpenProjectFile := F;
d := ImportProjectInfo();
if not ifarray(d)then d := array();
if d["mainform"]then
begin
FMainForm := d["mainform"];
FTree.SetFileToNodes(d["files"]);
FTree.InitDirs(d["dir"]);
FTree.RootDir := n;
FCProjectPath := p+fio;
FTree.fprojectpath := FCProjectPath;
FprojName := n;
FDesigner.caption := "TVCL界面设计器 "+FprojName;
FTree.ProjectNode.Expand();
FTree.PopUpMenu := FTreePopUpMenu;
fnewmenu.Enabled := true;
fgoformmenu.Enabled := true;
end else
begin
FTree.PopUpMenu := nil;
FOpenProjectFile := "";
messageboxa("打开工程文件错误:"+f,"提示",0,self);
fnewmenu.Enabled := false;
fgoformmenu.Enabled := false;
return;
end
////////////////////从新构造search目录///////////////////////////////
global g_orig_lib_path;
sdir := array(p+fio);
idx := 1;
hdirs := array(p:true);
if ifstring(g_orig_lib_path) then
begin
for i,v in str2array(g_orig_lib_path,";") do
begin
tm := trim(v);
if hdirs[tm] then continue;
hdirs[tm] := true;
if tm then
begin
sdir[idx++] := tm;
end
end
end else
begin
sdir[idx++] := Getfuncextdir();
end
/////////////////////////////////////
FTslEditer.TslSearchDir := sdir;
FExecEntry := FprojName;
if d["entryscript"]then
begin
FExecEntry := d["entryscript"];
end
FTslEditer.setExecuteEditerSetcmdline(d["commandline"]);
OpenMainForm(); //打开主窗口
end
function SetAsMainWind(o,e); //设置主窗口
begin
if o.caption = "设置为主窗口" then
begin
cn := FTree.CurrentNode;
fn := cn.FName ;
FMainForm := fn;
SaveProjInfo();
ftxt := format(%% function get_main_wnd(); //获得主窗口,切换主窗口工程会修改该函数
begin
return class(%s);
end %%,fn);
scriptname := FCProjectPath+FExecEntry+".tsl";
it := FTslEditer.OpenScriptByFileName(scriptname);
if it then
begin
if it.replacemfunc("get_main_wnd",ftxt) then
begin
FTslEditer.SavePageItem(it);
end
end
o.parent := nil;
end else
if o.caption = "设置为入口脚本" then
begin
cn := FTree.CurrentNode;
fn := cn.FName ;
FExecEntry := fn;
SaveProjInfo();
o.parent := nil;
end
end
function DeletCTNode(); //删除当前节点
begin
cn := FTree.CurrentNode;
if cn.FType="dir" then DeleteCurrentDir();
else DeleteCurrentFile();
FCurrentOpend := nil;
end
function DeleteCurrentDir(); //删除当前目录;
begin
cn := FTree.CurrentNode;
if not cn then return;
if cn=FTree.ProjectNode then return Messageboxa("工程目录不能删除","提示",0,self);
if IDOK=Messageboxa("即将从工程中移除文件夹:"+cn.Caption,"提示",1,self)then
begin
if IDOK=Messageboxa("是否删除文件夹及其类容:"+cn.Caption,"提示",1,self)then
begin
dcns := array();
ftree.GetNodeLeafs(cn,dcns);
for i,v in dcns do
begin
if v.FType = "dir" then continue;
FTslEditer.CloseScriptByFileName(v.geteditfilename());
if v.FType in array("form","panel") then
begin
tn := v.gettmfname();
FTslEditer.CloseScriptByFileName(tn);
FileDelete("",tn);
end
end
dp := cn.FPath;
DeleteAllFiles(FCProjectPath+dp);
end
FCurrentOpend := nil;
FTree.DeleteCurrentNode();
SaveProjInfo();
end
end
function DeleteCurrentFile(); //删除当前的文件
begin
nd := FTree.CurrentNode;
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
CloseCurrentEdit(nd,true);
fn := nd.geteditfilename();
FTslEditer.CloseScriptByFileName(fn);
if IDOK=Messageboxa("是否删除文件","提示",1,self)then //移除文件
begin
FileDelete("",fn);
case d["type"]of
"form","panel":
begin
FileDelete("",nd.gettmfname());
end
end;
end
FTree.DeleteCurrentNode();
SaveProjInfo();
end
end
function AddDirToCurrentNode(n); //添加文件夹
begin
if not LegalFolderName(n)then return MessageboxA("名字不合法,请重试","提示",0,self);
cn := FTree.CurrentNode;
if not cn then return;
fio := ioFileseparator();
if cn.parent=FTree.RootNode then
begin
FTree.AddDir(n);
end else
begin
FTree.AddDir(cn.FPath+fio+n);
end
if cn then FTree.InvalidateItem(cn);
SaveProjInfo();
end
function AddinheritdToCurrentDir(info,cnd);
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);
/////////添加uses内容//
r := FTslEditer.getuses(nd.gettsfname());
if ifarray(r) and r then
begin
us := "uses ";
for i,v in r do
begin
us+=v+",";
end
us[length(us)] :=";";
end else
begin
us := "";
end
///////////
if cnd then
begin
ph := cnd.FPath;
end else
begin
ph := FTree.CurrentNode.FPath;
end
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)
%s
function create(AOwner);
begin
inherited;
end
function Recycling();override; //回收变量
begin
inherited;
ci := self.classinfo(); //将成员变量赋值为nil避免循环引用
for i,v in ci["members"] do
begin
if v["const"] then continue;
if v["static"] then continue;
invoke(self,v["name"],nil);
end
end
end
%%,n,nd.Fname,us);
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();
nd.parent.expand();
end
function AddFormToCurrentDir(n,cnd); //添加窗口
begin
if not(LegalVariableName(n))then return MessageboxA("名字不合法,请重试","提示",0,self);
if FTree.NameInTree(lowercase(n),nil,true)then return MessageboxA("重复的文件名","提示",0,self);
if cnd then
begin
ph := cnd.FPath;
end else
begin
ph := FTree.CurrentNode.FPath;
end
fio := ioFileseparator();
fn := array("name":n,"type":"form","dir":ph);
cprojpath := FCProjectPath;
if ph then ph += fio;
else ph := "";
ph := cprojpath+ph+n+".tsf";
tfm := FCProjectPath+"resource.tfm"+fio+n+".tfm";
if not(FileExists("",ph))then
begin
r := CreateAForm(n);
ReWriteString(ph,r);
r := CreateAtfm(n,n);
ReWriteString(tfm,r);
end else //已经存在
begin
if FileExists("",tfm) then
begin
inh := getwindowinherited2(ph);
if inh = array("tdcreateform") then
begin
fn["type"]:= "form";
end else
if inh = array("tdcreatepanel") then
begin
fn["type"]:= "panel";
end else
begin
fn["type"]:= "tsf";
end
end else fn["type"]:= "tsf";
end
nd := FTree.SetFileToNode(fn);
SaveProjInfo();
FTree.SetSel(nd);
end
function AddPanelToCurrentDir(n,cnd); //添加面板
begin
if not LegalVariableName(n)then return MessageboxA("名字不合法,请重试","提示",0,self);
if FTree.NameInTree(lowercase(n),nil,true)then return MessageboxA("重复的文件名","提示",0,self);
if cnd then
begin
ph := cnd.FPath;
end else
begin
ph := FTree.CurrentNode.FPath;
end
fio := ioFileseparator();
fn := array("name":n,"type":"panel","dir":ph);
cprojpath := FCProjectPath;
if ph then ph += fio;
else ph := "";
ph := cprojpath+ph+n+".tsf";
tfm := (FCProjectPath+"resource.tfm"+fio+n+".tfm");
if not FileExists("",ph)then
begin
r := CreateAPanel(n);
ReWriteString(ph,r);
r := CreateAtfm(n,n);
ReWriteString(tfm,r);
end else
begin
if FileExists("",tfm) then
begin
inh := getwindowinherited2(ph);
if inh = array("tdcreateform") then
begin
fn["type"]:= "form";
end else
if inh = array("tdcreatepanel") then
begin
fn["type"]:= "panel";
end else
begin
fn["type"]:= "tsf";
end
end else fn["type"]:= "tsf";
end
nd := FTree.SetFileToNode(fn);
SaveProjInfo();
FTree.SetSel(nd);
end
function RenameCurrentDir(n); //修改目录名
begin
if not LegalVariableName(n)then return MessageboxA("名字不合法,请重试","提示",0,self);
if FTree.NameInTree(n,nil,false)then return MessageboxA("重复的文件名","提示",0,self);
//CloseCurrentEdit();
cn := FTree.CurrentNode;
if cn.FType="dir" then return;
fio := ioFileseparator();
fullsouce := 0;
fllname := cn.geteditfilename();
fllnname := cn.geteditfilename(n);
case cn.FType of
"panel","form":
begin
fullsouce := cn.gettmfname() ;
fullnsouce := cn.gettmfname(n);
FTslEditer.SaveFileByName(fullsouce);
FTslEditer.CloseScriptByFileName(fullsouce);
end
end
FTslEditer.SaveFileByName(fllname);
FTslEditer.CloseScriptByFileName(fllname);
if cn.FType in array("tsf","panel","form")then
begin
size := filesize("",fllname); //获取文件大小
if 1=readFile(rwraw(),"",fllname,0,size,data)then
begin
s := ParserReplace(data,cn.caption,n);
if s then
begin
if 1 <> ReWriteString(fllname,s)then
begin
return MessageboxA("更名错误","提示",0,self);
end
end
end
if(cn.FType in array("panel","form"))and fullsouce then
begin
size := filesize("",fullsouce); //获取文件大小
if 1=readFile(rwraw(),"",fullsouce,0,size,data)then
begin
s := ParserReplace(data,cn.caption,n);
if s then
begin
if 1 <> ReWriteString(fullsouce,s)then
begin
//return MessageboxA("更名错误","提示",0);
end
end
end
end
end
if 1=filerename("",fllname,fllnname)then
begin
if fullsouce then
begin
filerename("",fullsouce,fullnsouce);
end
cnifno := cn.FFileInfo;
cnifno["name"]:= n;
cn.FFileInfo := cnifno;
cn.caption := n;
SaveProjInfo();
FDesigner.ExecuteCommand("renamefile",n);
end else
return MessageboxA("更名错误","提示",0,self);
end
function AddTsfToCurrentDir(n,t,cnd); //添加文件
begin
if not LegalVariableName(n)then return MessageboxA("名字不合法,请重试","提示",0,self);
if FTree.NameInTree(lowercase(n),nil,true)then return MessageboxA("重复的文件名","提示",0,self);
if cnd then
begin
p := cnd.FPath;
end else
begin
p := FTree.CurrentNode.FPath;
end
fn := array("name":n,"type":t,"dir":p);
nnd := FTree.SetFileToNode(fn);
ph := nnd.geteditfilename();
if not FileExists("",ph)then
begin
if t="tsf" then r := CreateATsf(n);
else r := CreateATsl(n);
ReWriteString(ph,r);
end
SaveProjInfo();
FTree.SetSel(nnd);
end
function ShowExeEditer(); //显示调试窗口
begin
if not FMainForm then
begin
messageboxa("工程未打开","提示",0,self);
exit;
end
FTslEditer.ShowExeEditer();
end
function showhltcolor();
begin
FTslEditer.showhltcolor();
end
function RunProject(); //运行工程
begin
if not FMainForm then
begin
messageboxa("工程未打开","提示",0,self);
exit;
end
saveCurrentEdit();
scriptname := FCProjectPath+FExecEntry+".tsl";
//FTslEditer.PopUpAuxiliary();
if not FTslEditer.visible then FTslEditer.Show(SW_SHOWNOACTIVATE);
it := FTslEditer.OpenScriptByFileName(scriptname);
if it then FTslEditer.ExecutepageItem(it,FScriptHandle);
FScriptHandle := 0;
return;
end
function debugproject(); //调试运行
begin
if not FMainForm then
begin
messageboxa("工程未打开","提示",0,self);
exit;
end
saveCurrentEdit();
scriptname := FCProjectPath+FExecEntry+".tsl";
//FTslEditer.PopUpAuxiliary();
if not FTslEditer.visible then FTslEditer.Show(SW_SHOWNOACTIVATE);
it := FTslEditer.OpenScriptByFileName(scriptname);
if it then FTslEditer.DebugPageItem(it);
return;
end
compile_config;
fcompier;
function get_config_info();
begin
f := FCProjectPath+"!buildconfig.stm";
if importfile(ftstream(),"",f,r) =1 then
begin
end
if not ifarray(r) then
begin
r := array();
r["build"] := "--buildexe";
r["buildfile"] := "."+"\\"+FExecEntry+".tsl";
{$ifdef linux}
hz := ".out";
{$else}
hz := ".exe";
{$endif}
r["output"] := "."+"\\"+FExecEntry+hz;
r["exports"] := "";
r["dependsdir"]:=".\\";
r["depends"]:="";
r["excludes"] := "";
r["resourcedir"] := ".\\";
r["resourcepat"] := "*.tfm";
r["extresource"]:="";
r["strong"] := true;
r["buildgui"] := true;
r["buildico"] := "";
end
iof := ioFileseparator();
if iof<>"\\" then
begin
for i,v in mrows(r,1) do
begin
if ifstring(r[v]) then
r[v] := replacetext(r[v],"\\",iof);
end
end
return r;
end
function save_config_info(d);
begin
if not ifarray(d) then return ;
f := FCProjectPath+"!buildconfig.stm";
iof := ioFileseparator();
if iof<>"\\" then
begin
for i,v in mrows(d,1) do
begin
if ifstring(d[v]) then d[v] := replacetext(d[v],iof,"\\") ;
end
end
exportfile(ftstream(),"",f,d);
end
function WrapTo();
begin
if not FMainForm then
begin
messageboxa("工程未打开","提示",0,self);
exit;
end
d := get_config_info();
ShowEditor();
d := FTslEditer.build_with_data(FCProjectPath,d);
if d then
begin
save_config_info(d);
end
return ;
fio := ioFileseparator();
if FWrapFolder.opendlg() then
begin
ds := FileList("",FWrapFolder.Folder+fio+"*") ;
if ifarray(ds) then ct := length(ds);
else ct := 0;
if ct>2 then
begin
if IDCANCEL = Messageboxa("文件夹不为空,点击确定将会覆盖文件夹内容!\r\n点击取消退出,","提示",1,self) then
begin
return ;
end
end
CopyUsedTslDllToNewDir(FWrapFolder.Folder+fio+"tsl");//拷贝tsl
CopyDirToDir(pluginpath()+".."+fio+"funcext",FWrapFolder.Folder+"\\tsl\\funcext"); //拷贝funcext
CopyDirToDir(FCProjectPath[1:length(FCProjectPath)-1],FWrapFolder.Folder+"\\"+FprojName);
s := '"%~dp0\\tsl\\tsl.exe" "%~dp0'+FprojName+"\\"+FExecEntry+".tsl"+'" '+'-libpath "%~dp0'+FprojName+'\\"';
exename := SysExecName();
if 1= parseregexpr("\\\\tsl.exe$",exename,"",m1,m2,m3) then
begin
end else
begin
for i := length(exename) downto 2 do
begin
if exename[i]="\\" then
begin
exename := exename[1:i]+"tsl.exe";
break;
end
end
filecopy("",exename,"",FWrapFolder.Folder+"\\tsl\\tsl.exe",false);
end
ReWriteString(FWrapFolder.Folder+"\\start.cmd",s);
_wapi.WinExec('cmd.exe /C start "" "'+FWrapFolder.Folder,1);
//echo "copyfolder:",filecopy("",pluginpath()+"..\\funcext","",FWrapFolder.Folder+"\\tsl\\funcext",false);
//拷贝目录
//echo FWrapFolder.Folder,"\r\n";
end
end
function CopyDirToDir(d1,d2);
begin
fio := ioFileseparator();
for i,v in FileList("",d1+fio+"*") do
begin
vn := v["FileName"];
if vn="." or vn=".." then continue;
if pos("D",v["Attr"]) then //目录
begin
CopyDirToDir(d1+fio+vn,d2+fio+vn);
end else
begin
fn := d2+fio+vn;
CreateDirWithFileName(fn);
filecopy("",d1+fio+vn,"",fn,0)
end
end
end
function StopProject(); //停止工程
begin
r := 1;
if FScriptHandle then
begin
SysTerminate(r,FScriptHandle);
end
FScriptHandle := 0;
end
function OpenEditer(); //打开编辑器
begin
//FTslEditer.Show();
ShowEditor();
end
function saveCurrentEdit(nd); //编辑的节点,不送入保存当前节点
begin
if not nd then nd := FCurrentOpend;
if nd then
begin
if not(FDesigner.isloadednode(nd)) then //判断是否保存
begin
return ;
end
case nd["type"]of
"form","panel":
begin
//保存tfm
fn := nd.gettmfname();
if fn then
begin
tfm := FDesigner.TreeNode2tfm(lib,items,nd);
if nd.ftfmscript<>tfm then //发生了改变
begin
nd.ftfmscript := tfm ;
it := FTslEditer.OpenAndGoLineByName(fn);
if it then
begin
it.FEditer.text := tfm;
FTslEditer.SaveFileByName(fn);
end
end
//ReWriteString(fn,tfm);
end
end
end;
FTslEditer.SaveFileByName(nd.geteditfilename());
end
end
function CloseCurrentEdit(nd,st); //关闭当前的编辑
begin
if nd="all" then
begin
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;
if st then
begin
FDesigner.UnLoadTreeNode(nd);
if nd = FCurrentOpend then FCurrentOpend := nil;
end
end
end
function Recycling();override;
begin
if Fhighlightpath then
begin
d := FTslEditer.hltcolor;
end
inherited;
FMoveMnus := nil;
FMoveMenu := nil;
FOpenMenu := nil;
fnewmenu := nil;
fgoformmenu := nil;
if d then
begin
exportfile(ftstream(),"",Fhighlightpath,d);
end
end
private
FMoveMnus;
FMoveMenu;
function getnodebyfilename(f,nd);//获得编辑器对应节点
begin
if not nd then return 0;
if (nd.gettsfname()=f) or (nd.gettmfname()=f) then return nd;
for i:=0 to nd.ItemCount-1 do
begin
r := getnodebyfilename(f,nd.GetNodeByIndex(i));
if r then return r;
end
end
function getdefaultdir();
begin
cnd := FTree.CurrentNode;
while cnd and cnd<>ftree.RootNode and cnd.FType<>"dir" do
begin
cnd := cnd.parent;
end
return cnd;
end
function createnamea(pre);
begin
idx := 1;
n := pre;
while idx>0 do
begin
n := pre+inttostr(idx);
idx++;
if not LegalVariableName(n) then continue;
if FTree.NameInTree(n,nil,true) then continue;
break;
end
return n;
end
function MoveCurrentFileto(o,e);
begin
nd := FTree.CurrentNode;
if nd then
d := nd.FFileInfo;
cp := nd.caption;
fio := ioFileseparator();
if not ifarray(d) then return ;
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);
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
begin
CloseCurrentEdit(nil,true);
end
ml := d["dir"];
if ifstring(ml) and ml then ml := ml+fio;
else ml := "";
ft := "tsl";
case d["type"] of
"panel","form","tsf":
begin
ft := "tsf";
end
end ;
if FCProjectPath+ml+d["name"]+"."+ft=FCProjectPath+ndr+d["name"]+"."+ft then return ;
FTslEditer.CloseScriptByFileName(FCProjectPath+ml+d["name"]+"."+ft); //关闭编辑器文件
CreateDirWithFileName(FCProjectPath+ndr+fio+d["name"]+"."+ft);
if 1=filerename("",FCProjectPath+ml+d["name"]+"."+ft,FCProjectPath+ndr+d["name"]+"."+ft) then
begin
nd.Recycling();
SaveProjInfo();
//移动成功
FTree.SetSel(o._tag);
case d["type"] of
"form":
begin
AddFormToCurrentDir(cp);
end
"panel":
begin
AddPanelToCurrentDir(cp);
end
"tsf":
begin
AddTsfToCurrentDir(cp,"tsf");
end
"tsl":
begin
AddTsfToCurrentDir(cp,"tsl");
end
end;
SaveProjInfo();
end
//FTree.DeleteNode(nd);
end
end
function GetDirNodes(nd,r,nt);
begin
if not ifarray(r) then r := array();
if not nd then return ;
for i := 0 to nd.ItemCount-1 do
begin
tnd := nd.GetNodeByIndex(i);
if tnd.FType="dir" then
begin
if nt<>tnd then
r[length(r)] := array(tnd.FPath(),tnd);
GetDirNodes(tnd,r,nt);
end
end
end
function CreateMoveDirMenus(it);
begin
ds := array();
rnd := FTree.RootNode.GetNodeByIndex(0);
pit := it.parent;
if rnd<>pit then
ds[length(ds)] := array("<主目录>",rnd);
GetDirNodes(rnd,ds,pit);
if not ifarray(FMoveMnus) then FMoveMnus := array();
if ds then
begin
lends := length(ds);
lengthMenus := length(FMoveMnus);
for i:= length(FMoveMnus) to lends-1 do
begin
FMoveMnus[i] := new Tmenu(self);
end
for i,v in FMoveMnus do
begin
if i<lends then
begin
v.Caption := ds[i][0];
v._tag := ds[i][1];
v.OnClick := thisfunction(MoveCurrentFileto);
v.parent := FMoveMenu;
end else
begin
v.parent := nil;
end
end
FMoveMenu.Handle;
return true;
end
return false;
end
function ParserReplace(s,brs,rs);
begin
if parseregexpr(format("type\\s+(%s)\\s*=\\s*class",brs),s,"mibes",result,mpos,mlen)=1 then
begin
end else
if parseregexpr(format("function\\s+(%s)\\(",brs),s,"mibes",result,mpos,mlen)=1 then
begin
end else
if parseregexpr(format("unit\\s+(%s)\\s*;",brs),s,"mibes",result,mpos,mlen)=1 then
begin
end else
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
s[mpos[0,1]:(mpos[0,1]+mlen[0,1]-1)] := rs;
return s;
end
function GetVCLdir();
begin
return Getfuncextdir()+ioFileseparator()+"tvclib"; //将vcl设置为只读
end
function Getfuncextdir();
begin
tsl := SysExecName();
ios := ioFileseparator();
for i := length(tsl)-1 downto 2 do
begin
vi := tsl[i];
if vi=ios then
begin
tsl[i+1:length(tsl)]:= "funcext";
break;
end
end
return tsl;
end
function SaveProjInfo();
begin
if FMainForm then
begin
d := array();
d["name"]:= FprojName;
d["version"]:= "1.1.2";
FTree.GetInfo(dir,files);
d["dir"]:= dir;
d["files"]:= files;
d["mainform"]:= FMainForm;
d["entryscript"]:= FExecEntry;
//d["time"]:= datetimetostr(now());
d["commandline"]:= FTslEditer.getExecuteEditerSetcmdline();
r := FormatTslData(d);
ReWriteString(FOpenProjectFile,r);
end
end
function ImportProjectInfo(); //导入数据
begin
if ifstring(FOpenProjectFile)then
begin
if importfile(ftstring(),"",FOpenProjectFile,d)=1 then
begin
//echo tostn(d);
try
if ifstring(d) then d := eval(&d);
except
end
if ifarray(d)then
begin
return d;
end
end
end
return array();
end
private //私有成员变量
FWrapFolder;
ffileadder;
FDesigner;
FCurrentOpend;
FOpenProjectFile;
FCurrentTfmName;
FCProjectPath;
FTree;
FList;
FprojPath;
FMainForm;
FExecEntry;
FprojName;
FAddBtn;
FDelFileBtn;
FDelDirBtn;
FOpenBtn;
FInput;
finheritedinput;
FScriptHandle;
FTmfParser;
FTslParser;
FTreeTool;
//设置主窗口
FSetMainMenu;
//FSetEntryMenu;
//删除菜单
FDelMenu;
//********************
FRenameMenu;
FAddMenu;
FAddMenuDir;
faddinherited;
FAddMenuForm;
FAddMenuPanel;
FAddMenuTsf;
FAddMenuTsl;
FOpenMenu;
fnewmenu;
fgoformmenu;
public
property newmenu read fnewmenu;
property goformmenu read fgoformmenu;
FTslEditer;
property tree read ftree;
private
fopenbuzy;
end
type TTslEditer = class(TEditer)
private
FIco;
function GetEditerBmp();
begin
return "0502000000060400000074797065000203000000696D670006040000006461746
10002EA01000089504E470D0A1A0A0000000D4948445200000018000000180806
000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0
BFC6105000000097048597300000EC300000EC301C76FA8640000017F49444154
484BCD944B4B02611885FB412DDBB4ED37740369D1C6F69110B5A89FD0A6562DA
4B21BB8C8F2921214840B4992C0109112BA58511048C55C4FF3CEF78DCE37CD94
CE2478E0C070E6F53CCEFBE90CA0C7EA23C0ED31101D049AF73CE84C22E0709C9
558BE5CE5370C95D658D628F0C0D0E9AC389F5FE637DA1201F661F2E70B2BC94C
3353665D9F2F02F59C384FB943DE80648865DBC3626ED92ADB1AFA99D9E40DB0D
6432BF132894A7D01F64718E42FD39C2F801FF727C06D2D969DB35D03E827FA9B
A8D03EEFEB09E8435E769B75A80FCE80DE416EFF01B2F329CE22BCA8ADFF03D0A
11B52A217D05215F39A147C45F4AAB84901AF1FD0725548A39BA6B57CDDAC0C06
488C016FD7D0AF1A90E78E208776A0A52B26400EC7CD4AFF806CD8D8C71754631
DD244ACF5CD95F934D4833294BD9259E91F505C815E7A845E7E823C136F01A4A9
5DE8C5075E1804504B403BA94159C840BF7B87341983B29485FEDCE4654C22A04
BD141CA912494F502D48D224F45050274A21E03806FF2C7CA7516022D7D000000
0049454E44AE42608200";
end
public
function InitializeWnd();override;
begin
inherited;
if not FIco then
begin
bmp := new TBitmap();
bmp.ReadVCon(HexFormatStrToTsl(GetEditerBmp()));
FIco := bmp.ToIcon();
end
_send_(WM_SETICON,1,FIco.handle,1);
end
{Foh ;
function WMSYSCOMMAND(o,e);override;
begin
if e.wparam=SC_MAXIMIZE then
begin
Foh := o.height;
_send_(WM_USER,123,123,1);
return ;
end else
if e.wparam=SC_RESTORE then
begin
end
return inherited;
end
function db(o,e): WM_NCLBUTTONDBLCLK;virtual;//最大化处理
begin
Foh := o.height;
_send_(WM_USER,123,123,1);
end
function WMUSER(o,e):WM_USER;override;
begin
if e.wparam = 123 and e.lparam=123 then
begin
if o.height>foh then
begin
h := o.height;
w := o.width;
l :=left;
o.SetBoundsRect(array(l,140,w+l,h));
end
end
end }
function Create(AOwner);override;
begin
inherited;
caption := "代码编辑器";
WsDlgModalFrame := true;
visible := false;
Left := 300;
Top := 120;
Width := 1000;
height := 900;
wspopup := true;
WsSizeBox := true;
WsSysMenu := true;
Onclose := thisfunction(CloseHidden);
exe := gettslexe();
fio := ioFileseparator();
global g_orig_lib_path;
FDefaultcmdline := format('"%s" "%s" -libpath "%s"',"$(TSL_EXE)","$(FULL_CURRENT_PATH)","$(SEARCH_PATH)");
end
function getExecuteEditerSetcmdline();
begin
return FExecuteEditer.getcurrentcommandline();
end
function setExecuteEditerSetcmdline(line);
begin
if line and ifstring(line) then
begin
FExecuteEditer.SetData(array(
"items":(("caption":"tsl","exe":line)),
"itemindex":0
));
end else
begin
FExecuteEditer.SetData(array(
"items":(("caption":"tsl","exe":FDefaultcmdline)),
"itemindex":0
));
end
end
function SaveAndClose();
begin
SaveAllPageItems();
CloseAllPageItems();
end
{function WMACTIVATE(o,e):WM_ACTIVATE;override;
begin
echo "\r\nactivate:",e.wparam;
end }
function GoToFunction(fn,n);
begin
it := OpenAndGotoFileByName(fn);
if it then it.GotoFunction(n);
end
function AddFunction(n,fn,finfo); //添加函数
begin
it := OpenAndGotoFileByName(n);
if it then return it.AddFunction(fn,finfo);
end
function Addfiled(fn,n); //添加变量
begin
it := OpenAndGotoFileByName(fn);
if it then
begin
it.AddFiled(n);
end
end
function Adduses(fn,lbs); //添加uses
begin
it := OpenAndGotoFileByName(fn);
if it then
begin
it.adduses(lbs);
end
end
function Delfiled(n,fld,nn);//删除成员变量
begin
it := OpenAndGotoFileByName(n);
if it then return it.Delfiled(fld,nn);
end
function getuses(n);
begin
it := OpenAndGotoFileByName(n);
if it then return it.getuses();
end
function GetClassInfo(n); //获得信息
begin
if n and ifstring(n)then
begin
it := OpenAndGotoFileByName(n);
end else
if ifobj(n) then
begin
it := n;
end
else it := GetCurrentItem();
if it then
begin
return it.GetClassInfo();
end
return nil;
end
function dopageitemsaved(it);override; //保存
begin
calldatafunction(fSetOnFormCodeSave,it,nil);
end
function createparams(p);override;
begin
inherited;
p.style .|= WS_MAXIMIZEBOX .| WS_MINIMIZEBOX;
//p.cstyle := CS_HREDRAW .| CS_VREDRAW .| CS_OWNDC .| CS_DBLCLKS ;
end
property OnFormCodeSave write fSetOnFormCodeSave;
private
fSetOnFormCodeSave;
FDefaultcmdline;
end
//************************************
implementation
//*************工程列表****************************************
type TDesignerProjectsRecoder = class() //工程名记录
function Create();
begin
bpath := TS_GetUserProfileHome();
ph := bpath+"designer"+ioFileseparator()+"ProjectsInfo.ini";
CreateDirWithFileName(ph);
FIni := new TIniFileExta("",ph);
end
function DeleteProject(n); //删除工程名
begin
if ifstring(n)and n then return FIni.EraseSection(n);
end
function ListProjects(); //列出工程
begin
r := FIni.ReadSections();
rr := array();
for i,v in r do
begin
rr[i,"name"]:= lowercase(v);
rr[i,"file"]:= FIni.ReadKey(v,"file");
end
return rr;
end
function AddProject(n,f); //添加工程
begin
return FIni.WriteKey(n,"file",f); //大小写可能有问题
end
private
FIni;
end
//**********tsl parser token****************************
type TFileTree = class(TTreeCtl)
type TTNode=class(TTreeNode) //TTreeCtlNode
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
FFType := v;
img := Owner.GetImageIdByname(v);
self.SelImgId := img;
self.ImgId := img;
end
function FPath();
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
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
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;
//function SetType()
FName; // a
FFType; //dir
ftfmscript;
private
function setfileinfo(v);
begin
FFFileInfo := v;
if ifarray(v) then
begin
FName := v["name"];
end
end
FFFileInfo;
end
fprojectpath;
fio;
function GetInfo(dir,files); //获得信息
begin
leafs := array();
dir := array();
files := array();
GetNodeLeafs(FPNode,leafs);
//fio := ioFileseparator();
for i,v in leafs do
begin
ph := GetNodePath(v);
if v.FType="dir" then
begin
ph :=(ph?(ph+fio+v.Caption):v.Caption);
dir[length(dir)]:= ph;
end else
begin
files[v.FName]:= array("name":v.Caption,"type":v.FType,"dir":ph);
end
end
end
function SetFileToNode(finf); //添加文件到节点
begin
nd := AddDir(finf["dir"]);
if not nd then nd := FPNode;
cnd := NameInTree(lowercase(finf["name"]),nil,true);
if not cnd then
begin
cnd := CreateTreeNode();
cnd.Caption := finf["name"];
cnd.FType := finf["type"];
cnd.FName := lowercase(finf["name"]);
cnd.Parent := nd;
cnd.FFileInfo := finf;
end
return cnd;
end
function SetFileToNodes(d); //添加
begin
for i,v in d do SetFileToNode(v);
end
function FileNameInCurrentNode(n,nd); //文件在当前节点下面
begin
if not ifstring(n)then return false;
ln := lowercase(n);
if not nd then nd := CurrentNode;
if nd then
begin
for i := 0 to nd.ItemCount-1 do
begin
ind := nd.GetNodeByIndex(i);
if ind.FType="dir" then
begin
r := FileNameInCurrentNode(n,ind);
if r then return r;
end else
begin
if ind.FName=n then return true;
end
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
begin
ind := nd.GetNodeByIndex(i);
if(iffile)then
begin
if ind.FType <> "dir" and treefilename(ind.FName)=treefilename(n) then return ind;
end else
if treefilename(ind.FName) = treefilename(n) then return ind;
if ind.FType="dir" then
begin
r := NameInTree(n,ind,iffile);
if r then return r;
end
end
end
function Create(AOwner);override;
begin
inherited;
fprojectpath := "";
fio := ioFileseparator();
ImageList := CreateaImageList(self,FImageIdName);
ImageList.DrawBmpFirst := true;
hasline := true;
nodecreator := class(TTNode);
FPNode := CreateTreeNode();
FPNode.Caption := "当前工程";
FPNode.FType := "dir";
FPNode.parent := RootNode;
//SetSel(FPNode);
end
function GetNodesByName(nds,n);
begin
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();
for i:= 0 to nd.ItemCount-1 do
begin
cnd := nd.GetNodeByIndex(i);
if cnd.FType="dir" then
begin
GetLeafNodeByName(cnd,nds,n);
end else
begin
if pos(n, cnd.FName) then
begin
nds[length(nds)] := cnd;
end
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;
if it then
begin
if it.FType <> "dir" then
begin
FAddMenu.Enabled := false;
end else
begin
if not it.FName then
begin
FAddMenu.Enabled := false;
FDelMenu.Enabled := false;
end else
begin
FAddMenu.Enabled := true;
FDelMenu.Enabled := true;
end
end
end
end
function InitDirs(ds); //初始化目录
begin
for i,v in ds do
begin
AddDir(v);
end
FPNode.Expand();
end
function ClearTree();
begin
FPNode.RecyclingChildren();
end
function DeleteCurrentNode(); //删除节点
begin
C := CurrentNode;
if not c then return false;
if FPNode=c then return false;
//pc := c.parent;
//DeleteNode(c);
//if pc.ItemCount<1 then setsel(pc);
//else setsel(pc.GetNodeByIndex(0));
c.Recycling();
end
function GetNodePath(nd); //获得目录节点的path
begin
if not nd then return "";
if nd=FPNode then return "";
p := nd.Parent;
r := "";
fio := ioFileseparator();
while p and p <> FPNode do
begin
r := p.Caption+(r?(fio+r):"");
p := p.Parent;
end
return r;
end
function AddDir(s); //添加完整目录
begin
if not(ifstring(s)and s)then return false;
fio := ioFileseparator();
if fio <> "\\" then
begin
s := replacetext(s,"\\",fio);
end else
if fio <> "/" then
begin
s := replacetext(s,"/",fio);
end
rs := str2array(s,fio);
vi := "";
ci := nil;
pc := FPNode;
for i,v in rs do
begin
if not v then
begin
return ci;
end
ci := AddDirToNode(v,pc);
pc := ci;
continue;
end
return ci;
end
function AddDirToCurrentNode(n); //添加目录
begin
cn := CurrentNode;
AddDirToNode(n,cn);
end
function AddDirToNode(n,nd); //在节点上面添加目录
begin
if not(ifstring(n) and n)then return nil;
if not nd then return nil;
if nd.FType <> "dir" then return nil;
ci := DirInNode(n,nd);
if ci then return ci;
ci := CreateTreeNode();
ci.FType := "dir";
ci.caption := n;
ci.FName := n;
ci.parent := nd;
return ci;
end
function GetImageIdByname(n); //获得类型图标
begin
return FImageIdName[n];
end
property RootDir read FRootDir write SetRootDir; //根目录名称
property FileCanSel read FFileCanSel write SetFileCanSel; //文件是否可以选择
property ProjectNode read FPNode;
function GetNodeLeafs(nd,fs); //获得叶子节点
begin
if nd.ItemCount<1 then
begin
fs[length(fs)]:= nd;
return;
end
for i := 0 to nd.ItemCount-1 do
begin
GetNodeLeafs(nd.GetNodeByIndex(i),fs);
end
end
private
FImageIdName;
FFileCanSel;
function SetFileCanSel(v);
begin
FFileCanSel := v;
end
function DirInNode(d,nd); //文件夹是否在节点上面
begin
ld := lowercase(d);
for i := 0 to nd.ItemCount-1 do
begin
ci := nd.GetNodeByIndex(i);
if(lowercase(ci.FName)=ld)then
begin
return ci;
end;
end
end
function SetRootDir(c);
begin
FPNode.Caption := c;
FRootDir := c;
end
function CreateaImageList(AOwner,imgns);
begin
imgs := New TControlImageList(AOwner);
imgns := array();
for i,v in GetIcons() do
begin
bmp := new TBitmap();
bmp.ReadVCon(HexFormatStrToTsl(v));
imgs.AddBmp(bmp);
imgns[i]:= k;
k++;
end
return imgs;
end
function GetIcons();
begin
return GetTreeIcons();
end
FRootDir;
FPNode;
end
function GetTreeIcons(); //获得树用到的图标
begin
r := array();
r["dir"]:="0502000000060400000074797065000203000000696D670006040000006461746
10002C301000089504E470D0A1A0A0000000D4948445200000018000000180806
000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0
BFC6105000000097048597300000EC300000EC301C76FA8640000015849444154
484BDD94318A8340144025571052A7509BF429839590CE464825DA0662E301CC0
1C42282E00162E1016C0541888585827D7A4B0FF037F377D4C8EEC2B23369F6C1
C7FF3F3A6F661C468037F30F04AAAA8220085F62BBDD42D775F4B5BFF31CEBFB4
55C2E172E921F0504CFF316ABFA4DC4714CBFFEE4D9E3F71B4EA7134EEA9585A0
2CCBC56C58C3300CF29C05B66D431004B462878A66812CCB70BFDF69C5469665A
069DA2CA8AA0AD6EB35E63C389FCFE0FBFE2C20C5F178C49C07922441DBB6B340
D77508C31073561E8F076C361BCC2781288A50D735E6AC5CAF57B02C0B731490F
D5714051B3C381C0E70BBDD304701B9164CD3C4060FC8987DDF8FB900FBFD1EA2
28C2062B455100B9404750B05AADA0691ADA62C3755DDC911114EC763B5AB2438
E679EE7B4A202C77168C9C6300CD3F11C4141922468658D344DA7E33922902345
7E0AAF20A257E69BEE4DBC5900F00106E8BE867C71B1300000000049454E44AE4
2608200";
r["form"]:="0502000000060400000074797065000203000000696D670006040000006461746
100023E01000089504E470D0A1A0A0000000D4948445200000018000000180806
000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0
BFC6105000000097048597300000EC300000EC301C76FA864000000D349444154
484B63F84F6300B6A0E1C1EFFF0E177EFE6738F09D2A186456FDFD5F080BB44F2
30C5739F9034531084B1EC314C3A60E1983CC845B00139CFFFC0F581004606209
377EFD9FF9EC0F18E353870D83E591155DF9F20F2C08023017D6DFFF0DB700E61
36CEAB0611040B10064D8D39FFFC02E8489F95CFEF9BFEBD16FB04FF0A9C38631
2CA03646B1400DE8556A62AC16C0C29A523C6A01413C6A01413C6A01413C4C2D0
095F5D8149383E54FA05900AB8F411220DB29C1B04A096426DC0250058D5C2F53
8A4166A154FAB403FFFF03001D726C72BDB4F7150000000049454E44AE4260820
0";
r["panel"]:="0502000000060400000074797065000203000000696D670006040000006461746
10002ED00000089504E470D0A1A0A0000000D4948445200000018000000180806
000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0
BFC6105000000097048597300000EC300000EC301C76FA8640000008249444154
484BE5953D0EC0200885BD32377171E06C2E8EDE82E6D9D0C1D80E2DA4D6BEE41
97F90CF306010672D02A8B50A330B119938C628A5941D80C928C8C27878000D8B
9C73235A08B9901355094AB396E6FD0920A5745C5063EF4A1A3707E08EE6008C4
AD3FBAC547AFE2EE0891602B8373BF7760DA2EB87D346477D1D20B201A116DBAE
8765266A0000000049454E44AE42608200";
r["tsf"]:="0502000000060400000074797065000203000000696D670006040000006461746
100021F03000089504E470D0A1A0A0000000D4948445200000018000000180806
000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0
BFC6105000000097048597300000EC300000EC301C76FA864000002B449444154
484BCD95DF4B935118C7FB4BFA23A2B05F8684174A10642534B42E826810DED44
51078D355110ADD84FDD0D9A6369D5BE9DCD4A63257CE5767BA0D37744B673653
866D4BCD4CEDDB79CECEBBF6EE7D5D5E24F48107CE737E3CDF739EE79CF73D840
3E6FF10F8B1BD8B0F4B6918FD716ED4A6BEFD5050A0379AC0A5F6299C691A43B5
3580DAA108B328AEDA8238DD28A1C23C85E185A498ADCD9E020FDFCFE3D40B098
373ABA2470D8DD19CC7D282E851A32970B8DECD779CCFC862929D4642151B9B4B
7E17BDE073698D162A01DAF95DD7ACF0945C64E9AA1B9947BD3786DB7D33A2370
3ADB9D13D2DBC3F280428E7258671E129F1C5D338C9D2B1F17387FB749A7CCA4C
3ED8C2CBC2CBA010A8304F6268FEABF09498024BAA5DE7E35D4CE1323B652E598
1AD9D5D5EB07CF4F6102A3BFC0A9B5DDD10A36A4EB018144B262B1058F9065DA7
7661C9A88872BB10572C7E0457D6849723D016FC827B0311E1290925D650CCEEF
DBAC87F2128462B4BA7CCBE049AD9EBBD69CFDC109A43A7A87186B9E5A78BC629
964C56808EA5EBF40B4FC92D47084FC63FF136A5AAF4E538BC9F53FC45534D72A
13453BA6514452E6E1C139E92A2E7A31863D7942001C3649CB7E94DE40BD045D1
2C3241DF1D89ED8CB8D33F83E4E636C289751C6702BBBF7877B6D8842CB0BE954
66A3381BE689C5FF55C1402AD818F38DBEC413431097DF7104A9A0651D9EE82CE
E28237D68D89C5B75CA0CDFF0ED28203353D76941A9CB04F37703BDAD08F9E488
18746545B47A1EB78C317E8BB3A5165790D83AF291BA4D2DC853A8F91B71F794C
6C8E85B7694DEDA072F7844A80A05D96191DD9A07FB372632F5FA385A60071DF3
D81230D0378E06ED10C4A4663C79EBAD9DCB058A5664F01C21989E15CCB088A9E
0DE37CEB00AE59BB70DDE6C085576E56780FCA4D12FF4016A2A080CC81FD32FF0
5072C00FC0687994836D53FED040000000049454E44AE42608200";
r["tsl"]:="0502000000060400000074797065000203000000696D670006040000006461746
10002D002000089504E470D0A1A0A0000000D4948445200000018000000180806
000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0
BFC6105000000097048597300000EC300000EC301C76FA8640000026549444154
484BA596316BF26010C7FD0A4A45E820EAE0AAE22055870E2E4E7E00371571717
311119DDB8A5014717110071144544429942E56A1ED262E4E2ED6ADA2A0EBBDDE
E51293D4B7BEE9FB8323FC2F77CFFF497289EA40C5D3D313148B45C8E57267239
FCFFF351E1F1FE1E3E3835712501884C361D0E974FF1D6EB71BAAD52AAD2919BC
BDBDD149DCE57C3EA723EAC964C21597D96C36D0EFF7C1E3F150EF6030381994C
B654AE2E22206830152A914AB7FE7F3F313AEAFAFC1EFF79F0C1E1E1EC860BFDF
73066827C16090953662B1189948068D46830C96CB2567002C160BDCDEDEFE3A7
03DC9E0F9F99912EFEFEFA45F5F5FCF36FD14D8FF2D47AB1DC17B8F05C3E19033
DAC0F1C4FEC3E1C01901C9E0EBEB8B0AEAF53A67B4810F16FB67B319670424030
40B0A85022BED188D46E8743AAC041406269309D2E9342B819797978B21E27038
E0FEFE9E9580C2C0E974D278C9C1ABFA29E40638D28944829580C2000B42A1102
BED44A351080402AC0414069148047C3E1F2BED64B359B05AADAC041406994C06
EC763B2B01F55CAB437E8B2A950ADD36390A552A9540AFD7B312907FAA31D49F6
8B941B7DB25031C59118541BBDDA6027C277E037E05B07F3C1E73E66820EE44DC
21162C160B3EAD8DD56A45FDF297F5A8BF8F9E96DF0035D88F1B15D15D5D5D413
29924319D4EA9A0D7EB91D60A6E0CFB47A311678E0638962E978BC47ABDA6D7BD
56AB91D60A4E95CD6683ED76CB99A381F8158DC7E334115EAF17EEEEEEF8F4657
6BB1D3D547CC9709D66B3C96704688A7061B3D94C05780578D41A373737D06AB5
685139D298E265E1BD93CFB83CC42953C7B9BF2A2700FE001125FC161DCF24BC0
000000049454E44AE42608200";
r["主窗口"]:="0502000000060400000074797065000203000000696D670006040000006461746
10002E001000089504E470D0A1A0A0000000D4948445200000020000000200806
000000737A7AF4000000017352474200AECE1CE90000000467414D410000B18F0
BFC6105000000097048597300000EC300000EC301C76FA8640000017549444154
5847ED953D4BC3401CC6FD087E23BF84832E8E4E2E82AB88089D05DF8A6341501
7A122221DAC083AB858284507FB42A4A64A9334689BB6B48FF74F0E43936BE9A5
8716CC0F1E4A42F2E4D7CBE56E067F4C2C100B4CAF80F5D943BEEC2809750D432
87092B530BFA5294DF2C2E0ED838404C8986E78D2DAFCCCE4501775DE159AFC8C
8F506023F50E38ECE2834DE0F612689780C22CD03843DED6B1F478ECFECA409D3
4B241860B10473BC043D61328CEFD08AC3F5FA1D4AC7BD78C09759EDE34F8918F
5060ED5047AED8521AEA1C4BE03AF785C58478225156F6DE4646740F6521F18AF
DF3F0441CFD0A1422F50A0604FA7D3607D81711253DFFFB8F26D0E90095CA6471
1CB72A9A80698A4B6552F7BE96A910905F07628158C0B6C5A532B1BC874613200
CB67CEA6CE78B12FEEF092981E5ED2A3F520775A6EFD988060809681F5DAC2675
ECA60D574645A88B36A4728DADAC01420244CDEC2295B1DC615311EA7AA9B2BD4
18050E0378905FEBB00F00DEE6C35FA45FA2AE60000000049454E44AE42608200";
r["入口"]:="0502000000060400000074797065000203000000696D670006040000006461746
10002A502000089504E470D0A1A0A0000000D4948445200000018000000180806
000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0
BFC6105000000097048597300000EC300000EC301C76FA8640000023A49444154
484BCD95DF2F5C4114C7FB5F493DB42F4DF5A912124985344D9AF0E041080F4D9
AB42A7812CFA40D1AE26715618BAD5DBB6115CBB2586DB17E44AD6A6DFD2E2AC7
9CE38CDED93B7BF74622F149E661CF3933DFB967BE337B076E98DB23103D3986F
05E14FCDB1B707876CAD1C42414E80887E0A9FB03247DAC56C6B3A10EA8087861
746B9D2BF5C41508EE6C290B17F83E4179C003D5A1097831E6842783AD5739148
A8756C01B598587BD753419170D45B739A332125983F48126AA7BE478CF511593
C0C6E11E15E3A496A5598E5A5332E9A6FA32B199584C0295332354DCB038C3117
B147FE9A779AE1F618E5C6212C0A2BCE11EFE05E41A8CB52ECF71440F7EF9839E
5A48132D33BACC2450B3E087656147C9EEE95FC81A6C2391D77E97A545DF4C0E5
11D6E4AA23DE4580EC4A285A37D3439C3D9A22C60A43D3C4F350DDFA7396210A8
FD3A05F7BADE52416A5FA376600EC7DDCE1AED97AC1FEC52FEE5F8678E5C53205
9081C690436C53960FE9568A5C4568B70B7D22599E23C02BF3639A3E258FB4635
D82A8949006FAAF190F10DCA76B5D344BCB156878C9712EBA67F47381223202D9
9E3ED8293F37F4ACCB82B1DB3E269B9DFFD0E1E8B565ADAB494AD5615F471C41E
F2DD6A5A0A72E41293C0CAFE1F48E9ADA7626C971D7033589FEBEDE6C87FB4873
C2C1E312962F5D861AF9F7B3AA90E6FB00EAD0032B7F35379AEF37D0E7153DDF4
5545C25119CEE6AB9CD5F9C41590C4FBC34167954D7914C7E848282041BBA27DD
15556568DC5B6C075B96101800B47754813D0D042980000000049454E44AE4260
8200";
r["重命名"] := "0502000000060400000074797065000203000000696D670006040000006461746
100024402000089504E470D0A1A0A0000000D4948445200000018000000180806
000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0
BFC6105000000097048597300000EC300000EC301C76FA864000001D949444154
484BB595498BC2401085FDFF7812F4E041DC10455C10978B2737545C5011F1268
2B8207A52F054C3AB54679249F7C499CC7C50245DD55D2F5DA9A443F4CFBC25F0
7ABD68B3D9D06432A1ED764BF7FB5D22FEF80A74BB5D8A4422140E875D562A956
8B95CCA2C33DF0AB45A2D4ED66C3669BFDF8B97F8BED16870AC5AAD8A578F5160
3A9D7282D56A251E2F2817E6ACD76BF178D10A3C1E0F5ED8EFF7C563067330F77
2B988C78D7107B55A4DEECC3C9F4FEA743A2C301E8FE97ABDD262B190A885EF4B
368164C964922D9D4E53A552B1C74E5C02B7DB8D0A85C28FDA10C991149D168BC
5E8783C4AC4C22530180CDEAEBD139413EB76BB9D783E7109E47239DE41269311
CFFB98766D0B9CCF677E8AF97CCED7C3E1209160D802A3D18813A333704577F88
179CAB06B5D696D816C364BC56291EFCBE5B2A71B74203192C2208071BD5E97A8
050BA0E51044FD95617C3A9D78920925A0C0BA783C2E230B16180E875A01FCE8B
E4327108D466564C102A954CA53927C3E4F894442467A9480B344ED765BA21621
559E5EAF272E8BD96CC67EC44D20AE339C1B8A107EBDF8CCF1153B41626CD94FC
059228031FC6A9DDD45BF412700E05787D19F0BA81DA80F35B080CE70022A0209
E044C3133BEDEB3F2990803F441F7C8E61D93F70A8A40000000049454E44AE426
08200";
r["移动"] := "0502000000060400000074797065000203000000696D670006040000006461746
10002F501000089504E470D0A1A0A0000000D4948445200000018000000180806
000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0
BFC6105000000097048597300000EC300000EC301C76FA8640000018A49444154
484BB555ABAEC24010DD8FA842F109381469834054E010583CDFD0FE018A20491
A140996104C1D82903A9AA0488346010235F79EC9B49742E963B99CE4B0E93067
0ECB6C67157D1989C17EBFA7F1784C8EE324745D37A1EFFB92590D6C00B1522A9
78661D0E170605115A8DBED46B55A8D9ACD264DA753367BA6E7796C32180C4456
1E2A080216CF66330965A3D3E970DE66B391483928FC4208B1E6E172B9705EBBD
D4EF5E9B957A3D188D6EBB5A82A180093C98473CB10C6402503007979C449ACD7
EBDCD7EBF55ADDA00C70585073BBDD7EC7E0B1A696C16EB7A3E17048F7FB5D226
97C6CB05C2E5963DB369DCF6789A681269F4E27FDBF08C711BA56AB45511449F4
15990670C6731171EEA16D341A1486A1A8898EC7235996C56BA601B6875815C6E
71E4061D334DF1B00782E62BC835EAF27AA5768F7A0A8F8474DC660CC2BFE5853
CB60B55AF17BF00E2983785C2F160BF9FA73601EA1268F8AF8C2E9F7FB349FCF2
5451F78CBBBDDEEDFB04330DED27F3219D7FCF98BAC4B5F872F178EAC5F02D10F
9BD147CD71D3BCE20000000049454E44AE42608200";
return r;
end
type TProgValueList=class(TKeyValueList) //工程列表
function Create(AOwner);override;
begin
inherited;
end
function getItemText(i);override;
begin
r := "";
it := GetItem(i);
if ifarray(it)then r := " "+it["caption"]+" ("+it["value"]+")";
return r;
end
end
type TKeyValueList = class(TListBox) //kvalue list
function Create(AOwner);override;
begin
inherited;
end
function CheckListItem(v);override;
begin
return ifarray(v)and ifstring(v["caption"]);
end
function MouseMove(o,e);override;
begin
inherited;
idx := GetIdxByYpos(e.ypos);
if FCurrentIndex<>idx then
begin
FCurrentIndex := idx;
InValidateRect(nil,false);
end
end
function PaintIdx(idx,rc_,cvs);virtual;
begin
{**
@explan(说明)绘制项 %%
@param(item)(TCustomListItem) 项 %%
@param(rc)(array) 绘制区域%%
@param(cvs)(tcanvas) 画布 %%
**}
inherited;
if idx = FCurrentIndex then
begin
rc := rc_;
rc[2:3]-=1;
cvs.pen.Color := rgb(30, 144, 255);
cvs.draw("Polyline",array(rc[0:1],(rc[2],rc[1]),(rc[2],rc[3]),(rc[0],rc[3]),rc[0:1]));
end
end
function getItemText(i);override;
begin
r := FitemData[i];
if ifarray(r) then r := r["caption"];
if ifstring(r) then return " "+r;
return "";
end
private
FCurrentIndex;
end
type TNameInput=class(TCustomControl) //输入文件名窗口
function Create(AOwner);override;
begin
inherited;
WsPopup := true;
WsSysMenu := true;
caption := "输入名称";
WsDlgModalFrame := true;
rc := _wapi.GetScreenRect();
left :=(rc[2]-rc[0])/2-280;
top :=(rc[3]-rc[1])/2-230;
width := 220;
height := 150;
FEidt := new TEdit(self);
FLabel := new TLabel(self);
FLabel.Caption := "输入名称:";
FBtn := new TBtn(self);
FLabel.SetBoundsRect(array(5,5,200,28));
FEidt.SetBoundsRect(array(5,35,210,60));
FBtn.SetBoundsRect(array(100,70,210,100));
FLabel.parent := self;
FEidt.parent := self;
FBtn.Parent := self;
FBtn.Caption := "确定";
Onclose := thisfunction(CloseEndModalForm);
FBtn.onClick := function(o,e)
begin
Endmodal(1);
end
FEidt.OnKeyPress := function(o,e)
begin
if e.wparam=13 then
begin
e.skip := true;
FBtn.Click();
end
end
end
function sellAllText();
begin
FEidt.SetSel(0,length(FEidt.text));
end
function SetLabelCaption(c);
begin
FLabel.Caption := c;
end
function ShowModal();override;
begin
FEidt.SetFocus();
SetWndPostWithMouse(self);
return inherited;
end
function SetBtnCaption(c);
begin
FBtn.Caption := c;
end
function GetEditV(f);
begin
r := FEidt.text;
if f then return lowercase(r);
return r;
end
private
FEidt;
FLabel;
FSelect;
FBtn;
FOnBtnClk;
end
type TProjectAddDlg=class(TCustomControl) //输入文件名窗口
function Create(AOwner);override;
begin
inherited;
WsPopup := true;
WsSysMenu := true;
caption := "添加";
rc := _wapi.GetScreenRect();
left :=(rc[2]-rc[0])/2-280;
top :=(rc[3]-rc[1])/2-230;
width := 320;
height := 150;
FEidt := new TEdit(self);
FLabel := new TLabel(self);
FLabel.Caption := "输入名称:";
FSelect := new TCombobox();
FSelect.AppendItems(array("dir","tsf","form","panel","tsl"));
FSelect.ItemIndex := 2;
FBtn := new TBtn(self);
FLabel.SetBoundsRect(array(5,5,200,28));
FEidt.SetBoundsRect(array(5,35,200,60));
FSelect.SetBoundsRect(array(215,35,296,60));
FBtn.SetBoundsRect(array(150,70,250,100));
FLabel.parent := self;
FEidt.parent := self;
FSelect.parent := self;
FBtn.Parent := self;
FBtn.Caption := "确定";
Onclose := thisfunction(CloseEndModalForm);
FBtn.onClick := function(o,e)
begin
Endmodal(1);
end
end
function SetLabelCaption(c);
begin
FLabel.Caption := c;
end
function SetBtnCaption(c);
begin
FBtn.Caption := c;
end
function GetSelectv(); //选中的值
begin
return FSelect.getCurrentItemText();
end
function GetEditV();
begin
return FEidt.text;
end
//property OnBtnClk read FOnBtnClk write FOnBtnClk;
private
FEidt;
FLabel;
FSelect;
FBtn;
FOnBtnClk;
end
function ReWriteString(fn,d);
begin
if not ifstring(d)then return 0;
als := "";
if FileExists(als,fn)then
begin
FileDelete(als,fn);
end else
begin
CreateDirWithFileName(fn);
end
spos := 0;
len := length(d);
return writefile(rwraw(),als,fn,spos,len,d);
end
function CreateAForm(n);
begin
r := format(%% type %s=class(tdcreateform)
uses tslvcl;
function Create(AOwner);override; //构造
begin
inherited;
end
function DoControlAlign();override;//对齐子控件
begin
//当窗口大小改变时,该函数会被调用,
//可以通过 clientrect 获取客户区大小,设置子控件的位置以及大小
//如果自己处理了子控件的对齐,就可以去掉 inherited
inherited;
end
function Recycling();override; //回收变量
begin
inherited;
ci := self.classinfo(); //将成员变量赋值为nil避免循环引用
for i,v in ci["members"] do
begin
if v["const"] then continue;
if v["static"] then continue;
invoke(self,v["name"],nil);
end
end
end
%%,n);
return r;
end
function CreateAPanel(n);
begin
r := format(%% type %s=class(tdcreatepanel)
uses tslvcl;
function Create(AOwner);override;//构造
begin
inherited;
end
function DoControlAlign();override;//对齐子控件
begin
//当窗口大小改变时,该函数会被调用,
//可以通过 clientrect 获取客户区大小,设置子控件的位置以及大小
//如果自己处理了子控件的对齐,就可以去掉 inherited
inherited;
end
function Recycling();override;
begin
inherited;
ci := self.classinfo();
for i,v in ci["members"] do
begin
if v["const"] then continue;
if v["static"] then continue;
invoke(self,v["name"],nil);
end
end
end
%%,n);
return r;
end
function CreateAtfm(n,t); //tfm
begin
r := format(%%
object %s1:%s
caption=%s
end
%%,n,t,t);
return r;
end
function CreateATsf(n); //构造一个tsf
begin
r := format(%% function %s();
begin
echo "";
end%%,n);
return r;
end
function CreateATsl(n); //构造一个tsf
begin
r := format(
%% //tsl script :%s
%%,n);
return r;
end
function CloseEndModalForm(o,e); //关闭模式窗口
begin
e.skip := true;
o.Endmodal(0);
end
function CloseHidden(o,e); //隐藏窗口
begin
e.skip := true;
o.visible := false;
if o._tag is class(tmenu) then o._tag.checked := false;
end
function LegalVariableName(n); //别名判断
begin
return ifstring(n) and n and (1=ParseRegExpr("^[A-Za-z_]\\w{2,}$",n,v,vp,vl)) and not(lowercase(n) in static TSL_ReservedKeys2());
end
function LegalFolderName(n); //目录名判断
begin
return ifstring(n) and n and (1=ParseRegExpr("^[A-Za-z_]\\w{2,}$",n,v,vp,vl)) and (lowercase(n)<>"con");
end
function createtslfunction(f);//构造函数
begin
n := f["name"];
p := f["param"];
b := f["body"];
ps := "";
if ifarray(p)then
begin
len := length(p);
for i := 0 to len-1 do
begin
v := p[i];
if ifstring(v)then ps += v;
if i<len-1 then ps += ";";
end
end
hs := nil;
vt := "";
if f["virtual"] then vt := "virtual;";
if ifstring(n) and ifstring(b)then
begin
//hs := "\r\nfunction "+n+"("+ps+");"+vt+"\r\n\tbegin\r\n"+b+"\r\n\tend\r\n";
bs := str2array(b,"\r\n");
bs2 := "";
for i,v in bs do
begin
if not v then continue;
bs2 += " "+v+"\r\n";
end
hs := "\r\n\ function "+n+"("+ps+");"+vt+"\r\n\ begin\r\n"+bs2+"\r\n\ end\r\n";
end
//hs := "\r\n\tfunction "+n+"("+ps+");"+vt+"\r\n\tbegin\r\n"+b+"\r\n\tend\r\n";
return hs;
end
function SetWndPostWithMouse(wnd,lft);
begin
{**
@explan(说明) 将窗口位置移动到鼠标附近
**}
ps := array(x,y);
wnd._wapi.GetCursorPos(ps);
wd := wnd.width;
ht := wnd.height;
if lft then
begin
end else
begin
end
r := array(ps[0]+30,max(50,ps[1]-integer(ht/2)),ps[0]+30+wd,max(50,ps[1]-integer(ht/2))+ht);
wnd.SetBoundsRect(r);
end
function GetToolBtns();
begin
r := array();
r["添加"] := "0502000000060400000074797065000203000000696D670006040000006461746
10002A001000089504E470D0A1A0A0000000D4948445200000018000000180806
000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0
BFC6105000000097048597300000EC300000EC301C76FA8640000013549444154
484B63F84F63407B0B1A36DCFCAF50BAE73F43E2269CF8DCC30F50E5A403066C0
6A2E388E967A0CA4907445900C25F7FFE816A210D106D41FDFA1B502DA401A22D
E04ADF0AD5421A20DA021076E83C4A10874E438D2F922C2016A72DB808359E461
6807C02030CA0C80361507E80B1617C743152300CD03E27A34712B5300CD03E0E
B0292017830C86D13040150B12E69EFFBFF3F2ABFF579F7E866318A0D882CC451
7FF4FDE73EFBF5CC96EB818880D12A3D802F7DEE3FFE71D7E04E7C392288C0F96
8371C8C120C30CEB0F82D9A070DF7FFD3518C3E2022C07E39083375F78012E049
133160CAC3AF5142CC700B3911C0CD2AB5CBEF7BF54E12E381F669E52D91EB01C
C53919549CC07CB4FEEC733086F1C17250751401908B6186C230480C04A856168
15C1B39E32C1823E2E4FF7F00692DA1CADCA230010000000049454E44AE426082
00";
r["删除"]:= "0502000000060400000074797065000203000000696D670006040000006461746
100025002000089504E470D0A1A0A0000000D4948445200000018000000180806
000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0
BFC6105000000097048597300000EC300000EC301C76FA864000001E549444154
484BDD55BF2F4351147E7F8218C560978841224C26B3C560D31889A81F9B28C16
0C020848141D2281184446988D25469DAB451559256D11F54A3AAA5D23472BC73
BD5BEFD67BD297D6E24BBEE6DE73CF39DFE9C979F772F0C7F82702CD3336A8E8D
B034EB5A988D59A43D0AC5F924472E07A97DD92C14A8805CA812BEF36480629A5
1CB85CC7863133B84349E1B870FC10B05E3FC3DD530A0637AE64897D97E29AFD5
E48FB0D46A06AC0488CBAD31023AA8493BB3E92838211689D771063A7D6C50429
21B6580C46607ADF4F8C3543474CD06FACEC3F80B60527ACDAC270E089128AC10
83C26D270114E3209E458DAA1872DE78390461E8C80CD1F27FF426C936299DA20
8403CC196FA065D64E046B874DD0A3733353C808E44BDA86C6718BE43912A70AA
158800662E5B8DF7145C8974CCF27F829421F5C0763EFCA0570D65F5299ECDE71
1B278228B2620D913515E85A3A572EE08DBC921ED37D49BB1EB6CF22243142C58
F3A3DC3CB90AB1B31650DF9309DF980636F8CB1D1CA11E276A13887D5D48FE62F
E28FBE41007B2BECC56DA1D343459AA6AC5FEF41F23D038BE600711253EA1EC2E
AC54910E88B6BFCE8F01CFD70AFB5040B7BD130891CB100E2437E0B00DE3DB9C9
D5FCF45014E54DC6793FF1C5C0C35F3309BEDD621445401E009F1120D4906702B
F970000000049454E44AE42608200";
r["打开"] := "0502000000060400000074797065000203000000696D670006040000006461746
10002E501000089504E470D0A1A0A0000000D4948445200000018000000180806
000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0
BFC6105000000097048597300000EC300000EC301C76FA8640000017A49444154
484B63F84F6330342CB8FFFAEBFF80C9A7FEE72EB90C154100AA5860DE7CF8BF4
3E7D1FFDA35FBFFA72DB808158500AC162C3BF1E47FD9AA6BFFB3165FFA1F3BFB
DCFFC0C9A7FFBB741FFB6FD172F8BF76F5FEFFF2257BFE0BE56CFFCF96BAE53F6
BCAE6FF0C899BFE6F3AFFE2FFD5A79FC196D4AFBF0135098B0505CBAF80351083
579D7A0AC6B75E7C01F3ABD65E071B0EF20D0C605800924437081B86190E63832
CE9DF7517CC3F75EF3DD434322D40361C596CDFF537FF775E790535090248B600
9BE1A1D3CE80F5060253123A20C9027C868368E4B08701A22D206438884FB6053
30F3C2068380893658151C341B038B205D80C0761B22C98B1FF01B8088005112E
C34198640B240B768273278C0FB2E0D987EF580D0761922DE8DE7EE7BF77FFC9F
FB5C0DCF9ECC38FFF0D1B6EFE972ADC8562283226D9021038FBE0C3FFF2D5D7FE
332743CA1C7C98640B90D9C460922D20151365C1F9871FFE2B94EEC16A003E0CD
203D28B0E302CA03618B58000F8FF1F006F515D6E9176E9510000000049454E44
AE42608200";
r["上移"] := "0502000000060400000074797065000203000000696D670006040000006461746
100024401000089504E470D0A1A0A0000000D4948445200000018000000180806
000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0
BFC6105000000097048597300000EC300000EC301C76FA864000000D949444154
484B63F84F63306A014140B4051BCFBFF81F3AEDCCFF84B9E7FF6FBBF4122A4A1
81065C1FDD75FFF2B94EEF9CF90B8098C55CAF782C588014459007235CC701806
891103085A30FFF0230CC36118244708E0B5003D68D031488E5050E1B5005BD0A
063424185D3027C41838EF10515560B08050D3AC61754582D202668D031AEA0C2
B0E0C4DD77580D2006EFBFFE1A6A0A026058D0BFF32E56CDC4E0AE6D77A0A6200
08605BBAEBCC2AA9918BCE332661182350E569D7A0A2E771C3A8F128541E10FD2
830D60B5809A60D4028260D40202E0FF7F00612A09387A7D4D910000000049454
E44AE42608200";
r["下移"] := "0502000000060400000074797065000203000000696D670006040000006461746
100028D01000089504E470D0A1A0A0000000D4948445200000018000000180806
000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0
BFC6105000000097048597300000EC300000EC301C76FA8640000012249444154
484B63F84F63306A0141405F0B365F78F1DF77E2A9FF0E9D47C9C2A1D3CEFCDF7
9F915D4340840B1C0AAF5F07F86C44D1461F3E6C350D32000C502D1BC1D583591
828572B6434D8300140B4A565EC5AA89145CBAEA2AD43408C08864F7DEE358351
283BDFA4F404D41000C0BAE3EFDFC5FAA70175603F061D9E2DDFF6F3CFF0C3505
01302C008165279E6035041F5E77F63954372AC06A010854AEB986D5206CB879D
34DA82E4C80D30210F0997012AB81C83864EA19A86AEC00AF054FDE7DFF2F5FB2
1BABC120AC54B6E7FFB3F7DFA1AAB103BC1680C0B64B2FB11A0EC27BAEBD86AAC
20D085A0002ED5B6F6318DEBDFD0E54163F20CA0210889C71166E38884D2C20DA
021000C5C9F30F3FA03CE20049169003462D2008686CC1FFFF005033D77F8BBE1
6860000000049454E44AE42608200";
return r ;
end
function GetPathFromFullName(fullname,fname,ftype);
begin
{**
@explan(说明) 获得当前执行tsl文件的所在路径 %%
@param(fullname)(string) 全名 %%
@param(fname)(string) 文件名 ,变参返回%%
@param(ftype)(string) 文件类型 ,变参返回%%
@return(string) 路径 %%
**}
ph := fullname;
n := "";
rp := "";
fname := "";
ftype := "";
firstd := true;
iofp := ioFileseparator();
for i := length(ph)downto 1 do
begin
vi := ph[i];
if vi="." and firstd then
begin
ftype := n;
n := "";
firstd := false;
end else
if vi=iofp then
begin
rp := ph[1:i-1];
break;
end else
n := vi+n;
end
FName := n;
return rp;
end
end.
Reference in New Issue View Git Blame Copy Permalink