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 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 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 FilterKeyDown(o,e); begin cc := e.CharCode; if cc=13 then begin if FFilterList.visible then begin FFilterList.visible := false; o.text := ""; idx := FFilterList.getCurrentSelection(); if idx >= 0 then begin FTree.SetSel(FFilterNodes[idx]); end end 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 Create(AOwner);override; begin inherited; 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.DrawBimpFirst := 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); //************************************************************ 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); FDesigner.EditerCodeChanged(); 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;//array(p,Getfuncextdir()); 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 ifoh 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); 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