type teditorform = class(TVCform) //编辑器主窗口 uses utslvclauxiliary,tslvcl,UTslSynMemo,UtslCodeEditor; const c_e_none = "None"; const c_e_ansi = "ANSI"; const c_e_utf8 = "UTF8"; const c_e_utf8bom = "UTF8 BOM"; const c_e_ucs2big = "UCS2-big"; const c_e_ucs2little = "UCS2-little"; const c_e_separator = "----"; const c_e_to_ansi = "转为ANSI"; const c_e_to_utf8 = "转为UTF8"; const c_e_to_utf8bom = "转为UTF8 BOM"; const c_e_to_ucs2big = "转为UCS2-big"; const c_e_to_ucs2little="转为UCS2-little"; const c_m_cmd_config="命令行配置"; const c_m_debuger = "调试器"; const c_m_tsl_dir = "tsl函数目录"; const c_m_exec = "执行"; const c_m_exec_debug = "调试运行"; const c_m_remote_debug = "远程调试"; const c_m_remote_debug_wait="远程调试(waitattach)"; const c_m_compile="编译当前脚本"; const c_m_window = "窗口"; const c_m_logwindow = "日志窗口.."; const c_m_dir = "目录"; const c_m_encode = "编码"; const c_m_open = "打开"; const c_m_new = "新建"; const c_m_open_other="其他窗口打开"; const c_m_open_history = "打开历史"; const c_m_lang_config = "语言设置"; const c_m_tsl_style_config="tsl代码格式设置"; const c_m_tsl_block = "tsl代码块设置"; const c_m_config = "设置"; const c_m_block_mgr = "代码块管理"; const c_m_exec_config= "tsl执行设置"; const c_m_file = "文件"; const c_m_edit_color = "编辑器颜色"; const c_m_tab_config = "tab设置:"; const c_m_blank = "空格"; const c_m_close_min = "关闭时最小化"; const c_m_lang = "语言"; const c_m_run = "运行"; const c_m_editor = "默认"; const c_m_exer = "当前执行程序"; const c_m_help = "帮助"; const c_m_tsl_help = "tsl语言帮助"; const c_m_about = "关于"; function WMACTIVATE(o,e):WM_ACTIVATE;override; //激活 begin inherited; if e.wparam then begin return _send_(WM_USER,50,60,1); end //inherited; end function WMUSER(o,e):WM_USER;override; begin if e.wparam=50 and e.lparam=60 then begin it := FEdter.GetCurrentItem(); if it and it.FEditer then begin it.FEditer.SetFocus(); end return ; end inherited; end function editerinfo(); begin s := "tsl语言本地编辑器\r\n版本:1.0.0\r\n日期:2022-07-19"; sc := get_resource_by_name("tsleditor.tsl.about"); if ifstring(sc) then return sc; f := tslfilename()+".about"; if fileexists("",f) then begin size := filesize("",f); if readFile(rwraw(),"",f,0,size,data) then begin return data; end end return s; end function Create(AOwner);override; begin inherited ; GLobal G_OpenHostory; //////////////////目录///////////////////// basepath := TS_GetUserProfileHome(); sp := ioFileseparator(); FCache := basepath+"editer"+sp+"cmpCaches"; FPathDirPath := basepath+"editer"+sp+"paths.tsm"; Fexefilepath := basepath+"editer"+sp+"tslfile.tsm"; FOpendpaths := basepath+"editer"+sp+"openedpaths.tsm"; FTabWidthpath := basepath+"editer"+sp+"tabwidpath.tsm"; FexefileCmds := basepath+"editer"+sp+"cmds.tsm"; FHistoryPath := basepath+"editer"+sp+"HistoryPath.tsm"; FCodeblockPath := basepath+"editer"+sp+"BlockManager.tsm"; FFindhistroypath := basepath+"editer"+sp+"findhistory.tsm"; FFormatpath := basepath+"editer"+sp+"tslformat.tsm"; Fhighlightpath := basepath+"editer"+sp+"highlight.tsm"; feditorglobalpath := basepath+"editer"+sp+"feditorglobalpath.tsm"; Fremotepath := basepath+"editer"+sp; CreateDirWithFileName(basepath+"editer"+sp+"1.txt"); CreateDirWithFileName(basepath+"editer"+sp+"cmpCaches"+sp+"1.txt"); fdirspath := basepath+"editer"+sp+"tsldirpath.tsm"; //TBlockManager //echo "\r\n",FCache; //////////////////////////////////////// rc:=_wapi.GetScreenRect(); SetBoundsRect(RC); caption := "tsl代码编辑器"; m := new TMainMenu(self); ////////////////////////////////////////////// FmTool := new TMenu(self); FmTool.Caption := c_m_window; fmglobsearch := new TMenu(self); fmglobsearch.caption := c_m_logwindow; fmglobsearch.OnClick := function(o,e) begin FEDter.SwitchLogWnd(); end fmglobdir := new TMenu(self); fmglobdir.caption := c_m_dir; fmglobdir.onclick := function(o,e) begin v := not(Fdirview.Visible); Fdirview.Visible := v; fdirspliter.Visible := v; end /////////////////////////////////////////////////////// FEnCodeMenu := new TMenu(self); FEnCodeMenu.Caption := c_m_encode; FCodeMenus := array(); for i,v in array(c_e_None,c_e_ansi,c_e_utf8,c_e_utf8bom,c_e_ucs2big,c_e_ucs2little,c_e_separator,c_e_to_ansi,c_e_to_utf8,c_e_to_utf8bom,c_e_to_ucs2big,c_e_to_ucs2little) do begin it := new TMenu(self); it.Caption := v; FCodeMenus[i] := it; if v=c_e_separator then it.TSeparator := true; else if v in array(c_e_ucs2big,c_e_ucs2little,c_e_utf8bom) then begin it.Enabled := false; end else begin it.OnClick := thisfunction(ClickEnCodeMenu); end it.Parent := FEnCodeMenu; end /////////////////////////////////////////////////////////////// Fmopen := new TMenu(self); newaction := new TAction(self); NewAction.ShortCut := "ctrl+O"; NewAction.caption := c_m_open; NewAction.onexecute := function(o,e) begin return FEdter.OpenAfile(); end; Fmopen.action := newaction; Fmnew:= new TMenu(self); newaction := new TAction(self); NewAction.ShortCut := "ctrl+N"; NewAction.caption := c_m_new; NewAction.onexecute := function(o,e) begin return FEdter.CreateAfile(); end Fmnew.action := NewAction; FOpenOther := new TMenu(self); FOpenOther.Caption := c_m_open_other; FOpenOther.OnClick := thisfunction(OpenInOtherWnd) ; FOpenHistoryMenu := new TMenu(self); FOpenHistoryMenu.caption := c_m_open_history; FOpenHistoryMenu.OnClick := function(o,e)begin FEdter.ShowHistoryWnd(); end //////////////////////////////////////////////////////////////////// FTslLangMenu := new tmenu(self); FTslLangMenu.Caption := c_m_lang_config; FTslFormatMenu := new tmenu(self); FTslFormatMenu.Caption := c_m_tsl_style_config; FTslFormatMenu.OnClick := function(o,e)begin move_popwnd_to_center2(FFormatInfoWnd); FFormatInfoWnd.show(); end FCodeBlockMenu := new TMenu(self); FCodeBlockMenu.caption := c_m_tsl_block; FCodeBlockMenu.OnClick := function(o,e)begin move_popwnd_to_center2(fBlockManager); fBlockManager.ShowModal(); end FMenuSet := new TMenu(self); FMenuSet.caption := c_m_config; fmtslexepath := new TMenu(self); if 1=importfile(ftstream(),"",Fexefilepath,tslexefile) then begin end else begin sexe := SysExecName(); if ifstring(sexe) and sexe then begin for i:= length(sexe) downto 3 do begin if sexe[i]=sp then begin if sp="/" then sexe := sexe[1:i]+"TSL"; else sexe := sexe[1:i]+"tsl.exe"; break; end end tslexefile := sexe; end end fBlockManager := new TBlockManager(self); fBlockManager.WsDlgModalFrame := true; fBlockManager.caption := c_m_block_mgr; fBlockManager.minmaxbox := false; fBlockManager.Visible := false; fBlockManager.Parent := self; fBlockManager.SaveClick := function(o,e)begin d := fBlockManager.GetData(); Exportfile(ftstream(),"",FCodeblockPath,d); fBlockManager.EndModal(); class(TTSLCompletion).FCodeBlocks := d; end if 1= importfile(ftstream(),"",FCodeblockPath,d) and d and ifarray(d) then begin fBlockManager.SetData(d); class(TTSLCompletion).FCodeBlocks := d; end else begin try d := GetTslCompletionCodeBlocks(); fBlockManager.SetData(d); class(TTSLCompletion).FCodeBlocks := d; except end end ///////////////////////////////////////// //////////////////////////////////////////////// fmtslexepath.caption :=c_m_exec_config; fmfile := new TMenu(self); fmfile.caption := c_m_file; fmfile.parent := m; FMenuSet.parent := m; Fmopen.parent := fmfile; Fmnew.parent := fmfile; FOpenOther.Parent := fmfile; FOpenHistoryMenu.Parent := fmfile; FTslLangMenu.Parent := FMenuSet; FCodeBlockMenu.Parent := FTslLangMenu; FTslFormatMenu.Parent := FTslLangMenu; tbwidth := 4; if importfile(ftstream(),"",FTabWidthpath,d)=1 and ( d>0 ) then begin tbwidth := d; end FMTabContain :=new TMenu(self); fmshowhltediter :=new TMenu(self); fmshowhltediter.caption := c_m_edit_color; FMTabs := array(); FMTabContain.Caption := c_m_tab_config; for i:= 0 to 6 do begin tm := new TMenu(self); if i=0 then tm.Caption := "\\t"; else tm.Caption := inttostr(i)+c_m_blank; if tbwidth=i then tm.Checked := true; tm.Onclick := thisfunction(TabWidthClick); FMTabs[i] := tm; tm.Parent := FMTabContain; end FMTabContain.parent := FMenuSet; fmshowhltediter.Parent := FMenuSet; fmshowhltediter.OnClick := function(o,e)begin FEdter.showhltcolor(); end mainmenu := m; FmTool.parent := m; FEnCodeMenu.parent := m; fmglobsearch.parent := FmTool; fmglobdir.parent := FmTool; FSearchDir := new TSearchDir(self); FSearchDir.onsaveclick := function(o,e)begin return o.EndModal(1); end FSearchDir.parent := self; fmtslexepath.parent := FTslLangMenu; fmtslexepath.OnClick := function(o,e)begin //FEdter.FExecuteEditer.ShowModal(); FEdter.ShowExeEditer(); end FCloseMenu := new tmenu(self); FCloseMenu.Caption:=c_m_close_min; //FCloseMenu.Checked := true; FCloseMenu.parent := FMenuSet; FCloseMenu.OnClick := function(o,e) begin FCloseMenu.Checked := not(FCloseMenu.Checked); end FEdter := New TEditer(self); Fdirview := new tdirviewer(FEdter); Fdirview.fcloseclick := function(o,e)begin Fdirview.Visible := false; fdirspliter.Visible := false; end Fdirview.Visible := false; Fdirview.align := alLeft; fdirspliter := new tsplitter(self); fdirspliter.Visible := false; fdirspliter.align := alLeft; Fdirview.Parent := self; fdirspliter.Parent := self; FEdter.Visible := false; //语言按钮 FSynMenu := New TMenu(self); FSynMenu.Caption := c_m_lang; FSynMenus := array(); for i,v in FEdter.GetSynTypeNames() do begin it := new TMenu(self); it.Caption := v; FSynMenus[i] := it; it.OnClick := thisfunction(ClickSynMenu); it.Parent := FSynMenu; end FSynMenu.Parent := m; FRunMenu := new TMenu(self); FRunMenu.caption := c_m_run; FExeaction := new TAction(self); FExeaction.caption := c_m_exec; FExeaction.ShortCut := "F9"; FExeaction.onexecute := function(o,e) begin FEdter.ExecutePageItem(FEdter.GetCurrentItem()); end for i,v in array(c_m_cmd_config,c_m_debuger,c_m_tsl_dir,c_m_exec,c_m_exec_debug,c_m_remote_debug,c_m_remote_debug_wait,c_m_compile) do begin it := new TMenu(self); if v = c_m_exec then begin it.Action := FExeaction; end if v=c_m_debuger then begin it.caption := v; ite := new TMenu(self); ite.caption := c_m_editor; ite.Parent := it; itb := new TMenu(self); itb.caption := c_m_exer; global g_debug_chooser; g_debug_chooser := c_m_exer; itb.Checked := true; itb.Parent := it; itb._tag := ite; ite._tag := itb; f := function(o,e)begin o.Checked := true; o._tag.Checked := false; global g_debug_chooser; g_debug_chooser := o.caption; end ite.OnClick := f; itb.OnClick := f; end else begin it.caption := v; it.OnClick := thisfunction(clickRun); end it.Parent := FRunMenu; end FRunMenu.Parent := m; FEdter.Parent := self; ////////////////////////////////////////////////// FHelpMenu := new TMenu(self); FHelpMenu.Caption := c_m_help; FHelpMenus := array(); for i,v in array(c_m_tsl_help,c_m_about) do begin vi := new TMenu(self); vi.Caption := v; vi.OnClick := thisfunction(HelpClick); vi.Parent := FHelpMenu; end FHelpMenu.parent := m; ///////////////////////////////// FEdter.TslCacheDir := FCache; FEdter.TabWidth :=tbwidth; FEdter.OnPageItemSelChanged := thisfunction(PageItemSelChanged); FEdter.OnPageEditerChanged := thisfunction(PageEditerChanged); FEdter.TslExe := tslexefile; FEdter.align := alClient; if (importfile(ftstream(),"",feditorglobalpath,ginfo)=1) and ifarray(ginfo) then begin global g_editer_font_size := ginfo["font"]; //FEdter.getpage().font := ginfo["font"]; //FEdter.getcodemap().font := ginfo["font"]; //Fdirview.addrootdirs(dirs); end if importfile(ftstream(),"",fdirspath,dirs)=1 then begin Fdirview.addrootdirs(dirs); end FEdter.FHistoryDir:= Fremotepath; if importfile(ftstream(),"",FPathDirPath,dirs)=1 then begin FEdter.TslSearchDir := formatsearchdir(dirs); end else begin fn := SysExecName(); fio := ioFileseparator(); for i:= length(fn) downto 1 do begin if fn[i]=fio then begin dirs := array( fn[1:i]+"funcext" ); break; end end FEdter.TslSearchDir := dirs; end if ifarray(dirs) and dirs then FDirs := dirs; if G_OpenHostory then begin if 1= importfile(ftstream(),"",FOpendpaths,opinfo) then begin if ifarray(opinfo) then begin for i,v in opinfo["pages"] do begin it := FEdter.OpenAndGoLineByName(v["filename"],v["r"]); if it then begin ls := it.FEditer.Lines; for j,vj in v["f2"] do begin if vj and ls[j]then ls[j].FMarked := true; end if v["isnewfile"] then it.fisnewfile := true; end end if ifarray(opinfo["currentpage"]) then begin it := FEdter.OpenAndGotoFileByName( opinfo["currentpage"][0],opinfo["currentpage"][1]); //if it then it.FEditer.SetFocus(); end end end if 1= importfile(ftstream(),"",FHistoryPath,hist) then begin FEdter.SetHistoryFiles(hist); end if 1 = importfile(ftstream(),"",FFindhistroypath,fds) then begin FEdter.SetFindHistroy(fds); end if 1 = importfile(ftstream(),"",Fhighlightpath,fds) then begin FEdter.hltcolor := fds; end end if 1=Importfile(ftstream(),"",FexefileCmds,cmds) then begin //echo "getok\r\n"; FEdter.FExecuteEditer.SetData(cmds); end else begin FEdter.FExecuteEditer.SetData(array( //"items":(("caption":"tsl","exe":format('"%s" "%s" -libpath "%s"',tslexefile,"$(FULL_CURRENT_PATH)","$(CURRENT_DIRECTORY)"+sp+";"))), "items":(("caption":"tsl","exe":format('"%s" "%s" -libpath "%s"',"$(TSL_EXE)","$(FULL_CURRENT_PATH)","$(SEARCH_PATH)"))), "itemindex":0 )); end onclose := thisfunction(closemain); FFileopen := new TOpenFileADlg(self); FFileopen.Filter := array("执行文件":"*.exe"); FFileopen.parent := self; formIcon := GetIcon(); FEdter.Visible := true; FFormatInfoWnd := NEW tformatinfownd(self); FFormatInfoWnd.Visible := false; FFormatInfoWnd.WsDlgModalFrame := true; FFormatInfoWnd.Parent := self; FFormatInfoWnd.onclose := function(o,e)begin e.skip := true; o.Visible := false; //o.EndModal(); end FFormatInfoWnd.OnOkClicked := function(o,e)begin //o.EndModal(); //o.show(); o.Visible := false; d := o.GetData(); FEdter.SetCodeFormatInfo(d); Exportfile(ftstream(),"",FFormatpath,d); end if 1=Importfile(ftstream(),"",FFormatpath,FMTDATA) then begin //echo "getok\r\n"; if ifarray(FMTDATA) then FEdter.SetCodeFormatInfo(FMTDATA); FFormatInfoWnd.setdata(FMTDATA); end end function HelpClick(o,e); begin case o.Caption of c_m_tsl_help: begin return FEdter.ShowTslLangChm(); end c_m_about: begin return messageboxa(static editerinfo(),c_m_about,0,self.Handle); end end end function PageItemSelChanged(o,it) begin if it then begin if it.fisnewfile then cp := (it.FEditer.ChangedFlag?"*":"")+ " new "; else cp := (it.FEditer.ChangedFlag?"*":"")+ it.OrigScriptPath; end else cp := "-tsl编辑器"; Caption := to_ansi_str(cp); ModifyEnCodeMenu(it); ModifySynMenu(it); save_opend_file_name(); end function PageEditerChanged(it,flg) begin cit := FEdter.GetCurrentItem(); if it=cit then begin if it.fisnewfile then cp := (flg?"*":"")+ " new "//o.Caption;//it.ScriptPath+" -tsl编辑器"; else cp := (flg?"*":"")+ it.OrigScriptPath;//o.Caption;//it.ScriptPath+" -tsl编辑器"; ModifyEnCodeMenu(it); end else cp := "-tsl 编辑器"; caption := to_ansi_str(cp); end function OpenInOtherWnd(o,e) begin it := FEdter.GetCurrentItem(); if not it then return ; nph := it.OrigScriptPath; it.FEditer.ReadOnly := True; it := nil; _wapi.WinExec(format('"%s" -f "%s" -h 0 -i 1',SysExecName(),nph),true); end Function SearDirMenuClick(o,e); begin FSearchDir.SetData(FDirs); if FSearchDir.ShowModal() then begin ndirs :=FSearchDir.GetData(); if ndirs <> FDirs then begin FDirs := ndirs; dd := array(); FEdter.TslSearchDir := formatsearchdir(FDirs); Exportfile(ftstream(),"",FPathDirPath,ndirs); end end end function TabWidthClick(o,e); begin if o.Checked then return ; for i,v in FMTabs do begin if v=o then begin v.Checked := true; FEdter.TabWidth := i; exportfile(ftstream(),"",FTabWidthpath,i); end else v.Checked := false; end end function CloseAllPageItems(); begin Cit := FEdter.GetCurrentItem(); its := FEdter.GetAllPageItems(); for i:= 0 to its.Length()-1 do begin it := its[i]; if it.FEditer.ChangedFlag then begin r := MessageBoxA("存在未保存的文件,是否保存!","提示",3,self) ; if r = IDYES then begin FEdter.SaveAllPageItems(); break; end else if r = IDCANCEL then begin return ; end else begin end break; end end FEdter.CloseAllPageItems(Cit); end function closemain(o,e); begin if FCloseMenu.CHecked then begin e.skip := true; show(SW_SHOWMINNOACTIVE); return ; end fd := MessageBoxA('是否关闭编辑器','关闭',MB_YESNO,o); if fd<>IDYES then return e.skip := true; its := FEdter.GetAllPageItems(); for i:= 0 to its.Length()-1 do begin it := its[i]; if it.FEditer.ChangedFlag then begin r := MessageBoxA("存在未保存的文件,是否保存!","提示",3,self) ; if r = IDYES then begin FEdter.SaveAllPageItems(); break; end else if r = IDCANCEL then begin e.skip := true; return ; end else begin end break; end end d := Fdirview.getrootdirs(); if d and ifarray(d) then begin exportfile(ftstream(),"",fdirspath,d); end d := FEdter.FExecuteEditer.GetData(); if d and ifarray(d) then begin exportfile(ftstream(),"",FexefileCmds,d); end d := FEdter.GetHistoryFiles(); if ifarray(d) and d then begin Exportfile(ftstream(),"",FHistoryPath,d); end d := FEdter.GetFindHistory(); if ifarray(d) and d then begin Exportfile(ftstream(),"",FFindhistroypath,d); end d := FEdter.hltcolor; if ifarray(d) and d then begin Exportfile(ftstream(),"",Fhighlightpath,d); end global g_editer_font_size; if ifarray(g_editer_font_size) and g_editer_font_size then begin Exportfile(ftstream(),"",feditorglobalpath,array("font":g_editer_font_size)); end save_opend_file_name(); FEdter.CloseAllPageItems(); end function save_opend_file_name(); begin global g_dotsavehistory; if g_dotsavehistory then return ; d := FEdter.GetAllPagesInfo(); if not ifarray(d) then d := array(); if flastopend = d then return ; exportfile(ftstream(),"",FOpendpaths,d); flastopend := d; end function clickRun(o,e); begin case o.caption of c_m_compile: begin FEdter.buildpageitem(FEdter.GetCurrentItem()); end c_m_cmd_config: begin FEdter.ShowExeEditer(); end c_m_exec_debug: begin FEdter.DebugPageItem(FEdter.GetCurrentItem()); end c_m_remote_debug: begin FEdter.Debugremote(0); end c_m_remote_debug_wait: begin FEdter.Debugremote(1); end c_m_tsl_dir: begin SearDirMenuClick(o,e); end end end function ClickSynMenu(o,e); begin it := FEdter.GetCurrentItem(); if not it then return ; if o.Checked then return ; FEdter.SetPageItemSyn(it,o.caption); ModifySynMenu(it); end function ClickEnCodeMenu(o,e); begin it := FEdter.GetCurrentItem(); if not it then return ; if o.Checked then return ; case o.Caption of c_e_none: begin it.currentcodeisnone(); end c_e_ansi: begin it.CurrentcodeIsAnsi(); end c_e_utf8: begin it.CurrentCodeIsUtf8(); end c_e_to_ucs2big: begin it.ToUnicode_big(); end c_e_to_ucs2little: begin it.ToUniocode_little(); end c_e_to_ansi: begin it.ToANSI(); end c_e_to_utf8: begin it.ToUtF8(); end c_e_to_utf8bom: begin it.ToUtF8BOM(); end end; ModifyEnCodeMenu(it); end function OpenAndGotoFileByName(f,line); begin if f and ifstring(f) then FEdter.OpenAndGotoFileByName(f,line); end function ModifyEnCodeMenu(it); begin if not it then return ; bm := it.EnCode; for i,v in FCodeMenus do begin if i>6 then break; if v.Caption = bm then begin v.Checked := true; end else v.Checked := false; end end function ModifySynMenu(it); begin if not it then return ; bm := it.FSynType; for i,v in FSynMenus do begin if v.Caption = bm then begin v.Checked := true; end else v.Checked := false; end end private function formatsearchdir(d); begin for i,v in d do begin if not ifarray(v) then return d; if v["s"] then return v["d"]; end return array(); end protected type TSerlogerSimpleWnd=class(tdcreateform) uses tslvcl; label1:tlabel; furl:tedit; label2:tlabel; fport:tedit; label3:tlabel; fusr:tedit; label4:tlabel; fpwd:tpassword; flogout:tbtn; flogin:tbtn; [weakref]cancel_clk; [weakref]save_clk; function Create(AOwner);override; //构造 begin inherited; Loader.LoadFromTfmScript(self,getinfo()); flogout.OnClick := function(o,e)begin calldatafunction(cancel_clk,self,e); end flogin.OnClick := function(o,e)begin calldatafunction(save_clk,self,e); end end function setdata(d); begin if not ifarray(d) then return ; furl.text := d["addr"]; fport.text := d["port"]; fusr.text := d["usr"]; fpwd.text := d["pwd"]; end function getdata(); begin r := array(); r["addr"] := furl.text; r["port"] := fport.text; r["usr"] := fusr.text; r["pwd"] := fpwd.text; return r; end function tserlogersimplewnd1_close(o;e);virtual; begin Visible := false; e.skip := true; end function Recycling();override; //回收变量 begin inherited; ci := self.classinfo(); //将成员变量赋值为nil避免循环引用 for i,v in ci["members"] do begin if v["static"]then continue; invoke(self,v["name"],nil); end end private function getinfo(); begin return %% object tserlogersimplewnd1:tserlogersimplewnd caption="远程连接信息" color=0xFFFFFF height=211 minmaxbox=false onclose=tserlogersimplewnd1_close width=422 wsdlgmodalframe=true wssizebox=true object label1:tlabel left=4 top=3 width=80 height=25 caption="服务器地址" end object furl:tedit height=25 left=88 tabstop=true top=3 width=204 end object label2:tlabel left=296 top=3 width=34 height=25 caption="端口" end object fport:tedit height=25 left=333 tabstop=true top=3 width=62 end object label3:tlabel left=2 top=38 width=80 height=25 caption=" 用户名" end object fusr:tedit height=25 left=88 tabstop=true top=38 width=244 end object label4:tlabel left=2 top=72 width=80 height=25 caption=" 密 码" end object fpwd:tpassword height=25 left=88 tabstop=true top=72 width=245 end object flogout:tbtn anchors=[akright akbottom] caption="取消" height=23 left=149 tabstop=true top=130 width=74 end object flogin:tbtn anchors=[akright akbottom] caption="保存" height=23 left=259 tabstop=true top=130 width=74 end end %%; end end type TFormatInfoWnd=class(tvcform) uses tslvcl; label1:tlabel; label2:tlabel; label3:tlabel; label4:tlabel; label5:tlabel; faligncmt:tcombobox; fcharct:tcombobox; farraytype:tcombobox; fsyncheck:tcheckbtn; fselectcheck:tcheckbtn; btn1:tbtn; function Create(AOwner);override;//构造 begin inherited; Loader.LoadFromTfmScript(self,GetWndInfo()); //WSSizebox := true; end function DoOKClick(o;e);virtual; begin calldatafunction(FOnOkClick,self,e); end function tformatinfownd1_close(o;e);virtual; begin e.skip := true; o.Visible := false; end function DoControlAlign();override;//对齐子控件 begin end function Recycling();override;//回收变量 begin inherited; ci := self.classinfo(); //将成员变量赋值为nil避免循环引用 for i,v in ci["members"]do begin invoke(self,v["name"],nil); end end function GetData(); begin r := array(); r["cmt"]:= faligncmt.Checked; r["arraytype"]:= array("普通":1,"默认":0,"宽松":3)[farraytype.getCurrentItemText()]; r["syn"]:= fsyncheck.checked; r["sel"]:= fselectcheck.checked; return r; end function SetData(d); begin //"50" "80" "100" "130" // "50" "100" "130" "150" "200" "250" "300" //"默认" "普通" "宽松" if ifarray(d) then begin faligncmt.Checked := (d["cmt"]=1); farraytype.ItemIndex := (array(0:0,1:1,3:2))[d["arraytype"]]; fsyncheck.Checked := d["syn"]; fselectcheck.Checked := d["sel"]; end end property OnOkClicked read FOnOkClick write FOnOkClick; private [weakref] FOnOkClick; function GetWndInfo(); begin return %% object tformatinfownd1:tformatinfownd caption="tsl代码格式化参数" height=240 left=497 minmaxbox=false autosize=true onclose=tformatinfownd1_close top=295 width=280 wssizebox=false object label1:tlabel left=16 top=19 width=92 height=25 caption="多行注释对齐" end object label3:tlabel left=16 top=67 width=80 height=25 caption="array格式化" end object label4:tlabel left=13 top=112 width=80 height=21 caption="语法检查" end object label5:tlabel left=13 top=138 width=114 height=25 caption="格式化选择区域" end object faligncmt:tcheckbtn height=22 left=113 top=19 width=22 caption ="" end object farraytype:tcombobox height=23 itemindex=1 items=["默认" "普通" "宽松" ] left=103 top=67 width=143 end object fsyncheck:tcheckbtn caption="" checked=true height=22 left=124 top=109 width=22 end object fselectcheck:tcheckbtn caption="" height=20 left=135 top=141 width=21 end object btn1:tbtn caption="确定" height=31 left=154 onclick=dookclick top=166 width=82 end end%%; end end type TBlockEditer = class(TPanel) uses TSLVCL,UtslCodeEditor; function Create(AOwner);override; begin inherited; caption := "代码块编辑..."; FLabels := array(); for i,v in array("前缀","标题","值","附加值") do begin li := new TLabel(self); li.caption := v; FLabels[i] := li; li.parent := self; end FEditers := array(); for i:= 0 to 1 do begin FEditers[i] := new TEdit(self); FEditers[i].parent := self; end FChecked := new tcheckbtn(self); FChecked.parent := self; FBtn := new tbtn(self); FBtn.caption := "确定"; FBtn.parent := self; FCoder := new TFTSLScriptMemo(self); FCoder.Completion := new unit(UTslSynMemo).TTSLCompletion(self); FCoder.HighLighter := new unit(UTslSynMemo).TTslSynHighLighter(self); FBtn.onclick := function(o,e)begin calldatafunction(FBtnClick,self,e); end FCoder.parent := self; end function Recycling();override; begin inherited; FChecked := nil; FEditers:= nil; FLabels := nil; FBtn := nil; FCoder := nil; FBtnClick := nil; end function DoControlAlign();override; begin if FLabels and FEditers and FBtn and FCoder and FChecked then begin r := ClientRect; lr := array(5,10,45,35); FChecked.SetBoundsRect(array(52,10,72,30)); for i,v in FLabels do begin v.SetBoundsRect(lr); lr[1]+=25; lr[3]+=25; end w := r[2]-r[0]; lr := array(52,10+25,w-48,35+25); for i,v in FEditers do begin v.SetBoundsRect(lr); lr[1]+=25; lr[3]+=25; end lr[3] := r[3]-35; FCoder.SetBoundsRect(lr); lr := array(lr[2]-100,lr[3]+5,lr[2],r[3]-5); FBtn.SetBoundsRect(lr); end end function GetData(); begin return array(FChecked.checked,FEditers[0].text,FEditers[1].text,FCoder.text); end function SetData(d); begin if ifarray(d) then begin FCoder.ClearAll(); FCoder.PrepareCompletion(); FChecked.checked := d[0]; FEditers[0].text := d[1]; FEditers[1].text := d[2]; FCoder.text := d[3]; end end property BtnClick read FBtnClick write FBtnClick; private [weakref]FBtnClick; FChecked; FEditers; FLabels; FBtn; FCoder; end type TBlockManager=class(TVCForm) uses TSLVCL; function Create(AOwner);override; begin inherited; Fbtns := array(); for i,v in array("保存","添加","删除")do begin bi := new tbtn(self); bi.caption := v; bi.onclick := thisfunction(btnlick); Fbtns[i] := bi; bi.parent := self; end FList := new TListView(self); FList.Columns := array(("text":"前缀","width":40),("text":"名称","width":130),("text":"值","width":200),("text":"扩展","width":430)); FList.ColumnAsBool(0); { r := array(); r[0] := array("caption":"try..except","value":"try","valueext":"\r\nexcept\r\nend;"); r[1] := array("caption":"循环块","value":"for","valueext":"for i= to do\r\nbegin\r\nend","prefix":true); r[2] := array("caption":"窗口类","value":"vclform","valueext":"type =class(tvcform)\r\n function create(AOwner);\r\n begin\r\n inherited;\r\n end\r\nend","prefix":true); r[3] := array("caption":"窗口启动程序","value":"vclscript","valueext":"uses tslvcl;\r\napp := Initalizeapplication();\r\napp.createform(class(),fm);\r\nfm.show();\r\napp.run();","prefix":true); SetData(r); } FList.parent := self; FEditer := new TBlockEditer(self); FEditer.SetBoundsRect(array(left+30,top+30,left+width-20,top+height-20)); FEditer.Visible := false; FEditer.WsPopUp := true; FEditer.WSsysMenu := true; FEditer.parent := self; FEditer.OnClose := function(o,e)begin o.EndModal(); end FEditer.BtnClick := function(o,e)begin if FEditer.caption = "添加代码块..." then begin FList.appendItem(FEditer.GetData()); end else begin FList.SetItem(FList.SelectedId, FEditer.GetData()); end FEditer.EndModal(); end FList.OnDblClick :=function(o,e)begin if FList.SelectedId>=0 then begin FEditer.caption := "修改代码块..."; end else begin FEditer.caption := "添加代码块..." end FEditer.SetData(FList.SelectedValue); move_popwnd_to_center2(FEditer); FEditer.showmodal(); end end function DoControlAlign();override; begin if FList and FBtns then begin R := ClientRect; R1 := R; R1[3]-=30; FList.SetBoundsRect(R1); rc := R; RC[1] := R[3]-28; RC[3] := R[3]-2; for i,v in Fbtns do begin rc1 := RC; rc1[0] := R[2]-(I+1)*130; rc1[2] := RC1[0]+95; V.SetBoundsRect(rc1); end end end function btnlick(o,e); begin case o.caption of "删除": FList.deleteselect(); "添加": begin FEditer.caption := "添加代码块..."; FEditer.SetData(array(0,"","","")); FEditer.showmodal(); end "保存": begin //echo tostn(FList.ListValues); calldatafunction(FSaveClick,self,e); end end end function GetData(); begin d := FList.ListValues; r := array(); ri := 0; for i,v in d do begin if v[1] and v[2] and v[3] then r[ri++] := array("prefix":v[0],"caption":v[1],"value":v[2],"valueext":v[3]); end r union2= array(); return r; end function SetData(d); begin FList.DeleteAllItems(); r := array(); idx := 0; for i ,vv in d do begin if not ifarray(vv) then continue; cp := vv["caption"]; if not(cp and ifstring(cp)) then continue; v := vv["value"]; if not(v and ifstring(v)) then continue; ve := vv["valueext"]; if not(ve and ifstring(ve)) then continue; r[idx++] := array(vv["prefix"],cp,v,ve); end FList.appendItems(r); end property SaveClick read FSaveClick write FSaveClick; function Recycling();override; begin inherited; FSaveClick := FEditer := Fbtns := FList := nil; end private [weakref]FSaveClick; FEditer; Fbtns ; FList; end type tdirlistbox = class(TListBox) uses tslvcl,UtslCodeEditor; function create(AOwner); begin inherited; end function getItemText(i);override; begin r := inherited; return to_ansi_str(r); //"["$ i $"]" $ end end type tsearchdir = class(TCustomControl) uses tslvcl; function Create(AOwner);override; begin inherited; ParentFont := false; font := array("width":10,"height":20); fcopyer := new TClipBoard(self); caption := "函数搜索目录:左侧为别名,右侧为-libpath目录...."; fcpmenu := new TPopupmenu(self); mui := new TMenu(self); mui.caption := "复制目录"; mui.Parent := fcpmenu; mui.OnClick := thisfunction(copy_current_dirs); WsDlgModalFrame := true; //WSSizebox := true; visible := false; wsPopUp := true; WsSysMenu := true; Fidx := -1; FFolder := new TFolderChooseADlg(self); FFolder.parent := self; rc:=_wapi.GetScreenRect(); l:=(rc[2]-rc[0])/2-400; t:=(rc[3]-rc[1])/2-300; SetBoundsRect(array(l,t,545+l+5,310+t+15)); FLists := array(); FBtns := array(); for i,v in array(array(2,28,120,230),array(148,2,500,230)) do begin ls := new tdirlistbox(self); ls.SetBoundsRect(v); ls.parent := self; ls.Border := true; FLists[i] := ls; end FLists[0].PopupMenu := fcpmenu; FLists[0].OnPopupMenu := function(o,e)begin if o.ItemIndex<0 then return e.skip; end btrecs := array( array(124,3,144,25), array(124,206,144,230), array(502,3,528,25), array(502,206,528,230), array(400,240,500,265) ); btcolor := array(0x00c800,0x0000c8,0x00c800,0x0000c8,0); btcolor := array(); for i,v in array("+","-","+","-","确定") do begin bt := new tbtn(self); bt.caption := v; bt.SetBoundsRect(btrecs[i]); bt.parent := self; bt.onclick := thisfunction(btnclick); ci := btcolor[i]; if ci>0 then bt.Color := ci; FBtns[i] := bt; end FBtns[4].autosize := true; ///////////////////////////////// FEdit := new tedit(self); FEdit.SetBoundsRect(array(2,2,120,26)); FEdit.parent := self; FEdit.onkeyup := thisfunction(editkeyup); FEdit.placeholder := "查找or添加"; clean(); onclose := function(o,e)begin e.skip := true; o.endmodal(0); end ; autosize := true; end function GetPreferredSize(w,h);override; begin inherited; w+=5; h+=5; end function copy_current_dirs(o,e); begin fcopyer.text := array2str(FLists[1].items,";"); end function editkeyup(o,e); begin if e.CharCode = 13 then begin s := FEdit.text; if not s then return ; its := FLists[0].items; for i,v in its do begin if s = v then begin FLists[0].setCurrentSelection(i); return ; end end end end function btnclick(o,e); //点击处理 begin for i,v in FBtns do begin if v<>o then continue; list0 := FLists[0]; list1 := FLists[1]; case i of 0: //添加 begin S := FEdit.text; if not s then return ; its := list0.items; if not(s in its) then begin List0.appenditem(s); Farraya.push(array()); end FEdit.text := ""; end 1: begin Farraya.splice(Fidx,1); Fidx := -1; FLists[1].items := array(); FLists[0].DeleteSelectedItems(); end 2: //删除 begin if Fidx<0 then return ; if FFolder.OpenDlg() then begin s := FFolder.Folder; its := list1.items; if not(s in its) then begin its union= array(s); Farraya.splice(Fidx,1,its); list1.appenditem(s); end end end 3: begin if Fidx<0 then return ; FLists[1].DeleteSelectedItems(); its := FLists[1].items; Farraya.splice(Fidx,1,its); end 4: begin calldatafunction(FOnsaveclick,self(true)); //echo tostn(GetData()); end end ; end end function listselchanged(o,e); begin if o = FLists[0] then begin Fidx := o.getCurrentSelection; its := Farraya[Fidx]; FLists[1].items := its; end end function GetData(); //获得数据 begin r := array(); its := FLists[0].items; for i,v in its do begin r[i,"n"] := v; r[i,"d"] := Farraya[i]; if i=Fidx then r[i,"s"] := 1; end return r; end function SetData(d); //设置数据 begin clean(); list0 := FLists[0]; formatdata(d); for i,v in d do begin if ifarray(v) then begin list0.appenditem(v["n"]); Farraya.push(v["d"]); if v["s"] then list0.setCurrentSelection(i); end end end function clean();//清空 begin Fidx := -1; FEdit.text := ""; Farraya := new TMyArrayB(); for i,v in FLists do begin v.onSelectionChange := nil; v.items := array(); v.onSelectionChange := thisfunction(listselchanged); end end function Recycling();override; begin inherited; FOnsaveclick := nil; Farraya := nil; FFolder := nil; FLists := nil; FBtns := nil; end property onsaveclick read FOnsaveclick write FOnsaveclick; private function formatdata(d); begin r := array(); for i,v in d do begin if not ifstring(v) then begin return ; end end r := array(( "n":"default", "d":d, "s":1 )) ; d := r; end [weakref]FOnsaveclick; Fidx; FFolder; Farraya; FEdit; FLists; FBtns; fcpmenu; fcopyer; end private function GetIcon(); begin r := "0502000000060400000074797065000203000000696D670006040000006461746 10002EA01000089504E470D0A1A0A0000000D4948445200000018000000180806 000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000017F49444154 484BCD944B4B02611885FB412DDBB4ED37740369D1C6F69110B5A89FD0A6562DA 4B21BB8C8F2921214840B4992C0109112BA58511048C55C4FF3CEF78DCE37CD94 CE2478E0C070E6F53CCEFBE90CA0C7EA23C0ED31101D049AF73CE84C22E0709C9 558BE5CE5370C95D658D628F0C0D0E9AC389F5FE637DA1201F661F2E70B2BC94C 3353665D9F2F02F59C384FB943DE80648865DBC3626ED92ADB1AFA99D9E40DB0D 6432BF132894A7D01F64718E42FD39C2F801FF727C06D2D969DB35D03E827FA9B A8D03EEFEB09E8435E769B75A80FCE80DE416EFF01B2F329CE22BCA8ADFF03D0A 11B52A217D05215F39A147C45F4AAB84901AF1FD0725548A39BA6B57CDDAC0C06 488C016FD7D0AF1A90E78E208776A0A52B26400EC7CD4AFF806CD8D8C71754631 DD244ACF5CD95F934D4833294BD9259E91F505C815E7A845E7E823C136F01A4A9 5DE8C5075E1804504B403BA94159C840BF7B87341983B29485FEDCE4654C22A04 BD141CA912494F502D48D224F45050274A21E03806FF2C7CA7516022D7D000000 0049454E44AE42608200"; ico := new TIcon(); ico.ReadVcon(HexFormatStrToTsl(r)); return ico; end private Fdirview; fdirspliter; FLoger; FFormatInfoWnd; fBlockManager; FCodeMenus; FCloseMenu; FSynMenus; FCPB; FMTabs; flastopend; FOpendpaths; FTabWidthpath; FFileopen; FexefileCmds; FCodeblockPath; FHistoryPath; FFindhistroypath; FFormatpath; Fremotepath; fdirspath; Fhighlightpath; feditorglobalpath; FEdter; FSearchDir; FCache; FPathDirPath; FDirs; Fexefilepath; /////////////////actions FExeaction; end type tdirviewer = class(tcustomcontrol) uses tslvcl; private fms; ffolder; ftb; [weakref]ftbns; [weakref]fsbtns; fimgs; public [weakref] fcloseclick; function create(AOwner); begin inherited; Width := 300; addtoolbar(); fnodes := array(); FEdit := new tedit(self); FEdit.parent := self; FEdit.Align := alTop; FTree := new TTreeView(self); FTree.Border := false; FTree.Align := alClient; FTree.parent := self; ftree.ImageList := fimgs; FRootdirs := array(); FTree.onEmptyNodeExapanding:= thisfunction(emptyexpanding); Fnodeinfos := array(); fdircrc := array(); FEdit.onchange := function()begin s := FEdit.text; nd := ftree.rootnode; if trim(s) and (nd.ItemCount>0) then begin for i,v in fsbtns do v.Enabled := true; end else begin for i,v in fsbtns do v.Enabled := false; end end FEdit.onkeyup := function(o,e)begin if e.CharCode=13 then begin e.skip := true; if ssShift in e.shiftstate() then findup(); else finddown(); end end mus := new TPopupmenu(self); fms := array(); for i,v in array("添加工作目录","移除工作目录","刷新","打开") do begin mi := new TMenu(self); mi.caption := v; mi.onclick := thisfunction(muclick); mi.parent := mus; fms[i] := mi; end ftree.onrclick :=function(o,e)begin //nd := o.CurrentNode; nd := FTree.GetItemByYPos(e.ypos) ; if nd then begin if (nd.parent = o.rootnode) then //根目录 begin fms[0].Enabled := 0; fms[1].Enabled := true; fms[2].Enabled := true; fms[3].Enabled := true; end else begin fms[0].Enabled := 0; fms[1].Enabled := 0; fms[2].Enabled := true; fms[3].Enabled := true; end end else begin fms[0].Enabled := true; fms[1].Enabled := 0; fms[2].Enabled := true; fms[3].Enabled := 0; end end FTree.PopupMenu := mus; FTree.OnSelChanged := thisfunction(treenodeselchanged); ftree.OnDblClick := function(o,e) begin //echo "dblcock\r\n"; nd := ftree.CurrentNode; if not nd then return ; ins := Fnodeinfos[nd.handle]; if ins.isfile then begin fn := ins.fullname(); if 1= parseregexpr("\\.(?:tsl|tsf|txt|js|py|css|xml|html|htm|c|cpp|cc|cmd|tfm|bat|h)$",fn,"i",m,mp,ml) then begin editnode(); end end end selnowork(); end function treenodeselchanged(o,e); begin rnd := ftree.rootnode; //没有工作目录 if rnd.ItemCount<1 then return selnowork(); //没有选择节点 t := FEdit.text ; if trim(t) then begin for i,v in fsbtns do v.Enabled := true; end else begin for i,v in fsbtns do v.Enabled := false; end it := e.ItemNew; if not it then begin return selnonode(); end //选中节点为工作目录 if it.parent = rnd then return selnodeiswork(); //选中目录为普通节点 selnodenotwork(); end function addtoolbar(); //初始化工具栏 begin ftb := new TToolBar(self); fimgs := new tcontrolimagelist(self); fimgs.Width := 20; fimgs.Height := 20; bmp := new TBitmap(); bmp.readvcon(HexFormatStrToTsl(folderbmp())); fimgs.addbmp(bmp); bmp := new TBitmap(); bmp.readvcon(HexFormatStrToTsl(filebmp())); fimgs.addbmp(bmp); bmp := new TBitmap(); bmp.readvcon(HexFormatStrToTsl(dllbmp())); fimgs.addbmp(bmp); ftbns := array(); fsbtns := array(); for i,v in gettbicons() do begin bt := new TToolButton(ftb); bt.caption := i; bmp := new TBitmap(); bmp.readvcon(HexFormatStrToTsl(v)); fimgs.addbmp(bmp); bt.ImageId := fimgs.ImageCount-1; bt.parent := ftb; if i in array("移除工作目录","打开","刷新") then ftbns[i] := bt; if i in array("查找","反向查找") then fsbtns[i] := bt; bt.onclick := thisfunction(toolclick); end ftb.ImageList := fimgs; ftb.parent := self; end function toolclick(o,e); //工具栏事件 begin case o.caption of "关闭": begin if fcloseclick then call(fcloseclick); end "刷新": begin refreshdir(); end "打开": begin editnode(); end "添加工作目录": begin addgzml(); end "移除工作目录": begin nd := FTree.CurrentNode; delrootdir(nd); end "查找": begin finddown(); end "反向查找": begin findup(); end end end function muclick(o,e); begin case o.caption of "添加工作目录": begin addgzml(); end "移除工作目录": begin nd := FTree.CurrentNode; delrootdir(nd); end "刷新": begin refreshdir(); end "打开": begin editnode(); end end ; end function finddown(); begin dofind(false); end function findup(); begin dofind(true); end function emptyexpanding(o,e); begin it := e.item; lazyload(it,1); end function addrootdir(dir); begin adddir(dir,nil); end function delrootdir(nd); begin if nd.parent = ftree.rootnode then begin h := nd.handle; fi := Fnodeinfos[h]; Fnodeinfos[h] := 0; FRootdirs::begin if mcell=nd then mcell := 0; end nd.Recycling(); fnodes := array(); end end function getrootdirs(); begin r := array(); for i,v in FRootdirs do begin if v then r[length(r)] := i; end return r; end function addrootdirs(r); begin for i,v in r do begin addrootdir(v); end end function adddir(dir,pnode); begin if not(pnode) and FRootdirs[dir] then return 0; dirinfo := filelist("",dir); if not dirinfo then return 0; if not pos("D",dirinfo[0]["Attr"]) then return 0; if pos("H",dirinfo[0]["Attr"]) then return 0; nd := FTree.CreateTreeNode(); fnodes := array(); nd.dirtype := true; nd.ImgId := 0; nd.SelImgId := 0; ndinfo := new tdirnodeinfo(); Fnodeinfos[nd.handle] := ndinfo; if pnode then begin nd.parent := pnode; end else begin nd.parent := FTree.rootnode; FRootdirs[dir] := nd; ndinfo.rootnode := true; end getname(dir,n,ph); ndinfo.isfile := 0; ndinfo.fname := n; ndinfo.Folder := ph; nd.Caption := n; fnodes := array(); return 1; end private //菜单回调 function refreshdir(); begin fbackrootdirs := array(); for i,v in FRootdirs do begin if v then begin v.Recycling(); fbackrootdirs[i] := 1; end end fnodes := array(); FRootdirs := array(); Fnodeinfos := array(); for i,v in fbackrootdirs do begin addrootdir(i); end fbackrootdirs := array(); fdircrc := array(); end function dofind(d); begin s := lowercase(trim(FEdit.text)); if not s then return ; it := ftree.CurrentNode; getallnodes(); return finds(it,s,d); end function finds(it,s,d) begin bit := it; flag := false; ct := length(fnodes); firstx := 0; for i,v in fnodes do begin if v=it then begin firstx := i+(d?(-1):1); break; end end if d then begin sa := array(ct-1,-1)->0; end else begin sa := 0->(ct-1); end for ii,i in sa do begin idx := (firstx+i) mod ct; it := fnodes[idx]; if pos(s,lowercase(it.caption)) then begin FTree.SetSel(it); return 1; end end return 0; end function addgzml(); //添加工作目录 begin if not ffolder then ffolder := new TFolderChooseADlg(self); if ffolder.OpenDlg() then begin return addrootdir(ffolder.Folder); end end function editnode(); //打开 begin nd := ftree.CurrentNode; if not nd then return ; ins := Fnodeinfos[nd.handle]; ed := Owner; if ins then begin if ins.isfile then begin Owner.OpenAndGotoFileByName(ins.fullname); end else _wapi.openresourcemanager(ins.fullname); end end function selnodeiswork(); begin for i,v in ftbns do begin v.Enabled := true; end //移除,添加,刷新,打开 end function selnodenotwork(); begin //刷新,打开 for i,v in ftbns do begin if i in array("打开","刷新") then begin v.Enabled := true; end else begin v.Enabled := false; end end end function selnonode(); begin //添加,刷新 for i,v in ftbns do begin if i in array("添加工作目录","刷新") then begin v.Enabled := true; end else begin v.Enabled := false; end end end function selnowork(); begin //添加 for i,v in ftbns do begin if i in array("添加工作目录") then begin v.Enabled := true; end else begin v.Enabled := false; end end for i,v in fsbtns do v.Enabled := false; end private //加载相关 function loadall(nd,ct,mct); //加载所有节点 begin if not nd then begin nd := FTree.rootnode; end if nd.ItemCount<1 and nd.dirtype then lazyload(nd,0); ct+= nd.ItemCount; for i:= 0 to nd.ItemCount-1 do begin if ct>=mct then return ; loadall(nd.GetNodeByIndex(i),ct,mct); end end function lazyload(it,ex);//惰性加载节点 begin ins := Fnodeinfos[it.handle]; iof := iofileseparator(); if ins then begin dir := ins.fullname(); ct := 0; dirs := array(); files := array(); subs := filelist("",dir+iof+"*"); crc := getmsgd_crc32(tostn(subs)); if fdircrc[crc] then return it.dirtype := false ; fdircrc[crc] := true; for i,v in subs do begin fn := v["FileName"]; if fn="." or fn=".." then continue; if pos("H",v["Attr"]) then continue; if pos("D",v["Attr"]) then begin dirs[i] := array(dir+iof+fn,it); end else begin nd := FTree.CreateTreeNode(); iid := 1; if pos(".dll",lowercase(fn)) or pos(".ocx",lowercase(fn)) or pos(".exe",lowercase(fn)) or pos(".lib",lowercase(fn)) then iid := 2; files[i] := array(fn,dir,iid,nd); end end for j,v in files do begin iid := v[2]; fn := v[0]; dir := v[1]; nd := v[3]; nd.ImgId := iid; nd.SelImgId := iid; nd.Caption := fn; nd.parent := it; ndinfo := new tdirnodeinfo(); Fnodeinfos[nd.handle] := ndinfo; ndinfo.isfile := true; ndinfo.fname :=fn; ndinfo.Folder := dir ; ct++; end for j,v in dirs do begin adddir(v[0],v[1]); ct++; end if ct then begin if ex then it.expand(); end begin it.dirtype := false; end end end private function getname(fname,n,dir); begin fi := iofileseparator(); n := ""; for i:= length(fname) downto 1 do begin vi := fname[i]; if vi=fi then begin dir := fname[1:i-1]; break; end n := vi+n; end return n; end function getallnodes(); begin if not fnodes then begin ct := 0; nd := nil; loadall(nd,ct,3000); fnodes := array(); FTree.rootnode.caption := ""; nodes(FTree.rootnode,fnodes); end end function nodes(nd,nds); begin nds[length(nds)] := nd; for i := 0 to nd.ItemCount-1 do begin nodes(nd.GetNodeByIndex(i),nds); end end function filebmp(); begin return "0502000000060400000074797065000203000000696D670006040000006461746 10002D002000089504E470D0A1A0A0000000D4948445200000018000000180806 000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000026549444154 484BA596316BF26010C7FD0A4A45E820EAE0AAE22055870E2E4E7E00371571717 311119DDB8A5014717110071144544429942E56A1ED262E4E2ED6ADA2A0EBBDDE E51293D4B7BEE9FB8323FC2F77CFFF497289EA40C5D3D313148B45C8E57267239 FCFFF351E1F1FE1E3E3835712501884C361D0E974FF1D6EB71BAAD52AAD2919BC BDBDD149DCE57C3EA723EAC964C21597D96C36D0EFF7C1E3F150EF6030381994C B654AE2E22206830152A914AB7FE7F3F313AEAFAFC1EFF79F0C1E1E1EC860BFDF 73066827C16090953662B1189948068D46830C96CB2567002C160BDCDEDEFE3A7 03DC9E0F9F99912EFEFEFA45F5F5FCF36FD14D8FF2D47AB1DC17B8F05C3E19033 DAC0F1C4FEC3E1C01901C9E0EBEB8B0AEAF53A67B4810F16FB67B319670424030 40B0A85022BED188D46E8743AAC041406269309D2E9342B819797978B21E27038 E0FEFE9E9580C2C0E974D278C9C1ABFA29E40638D28944829580C2000B42A1102 BED44A351080402AC0414069148047C3E1F2BED64B359B05AADAC041406994C06 EC763B2B01F55CAB437E8B2A950ADD36390A552A9540AFD7B312907FAA31D49F6 8B941B7DB25031C59118541BBDDA6027C277E037E05B07F3C1E73E66820EE44DC 21162C160B3EAD8DD56A45FDF297F5A8BF8F9E96DF0035D88F1B15D15D5D5D413 29924319D4EA9A0D7EB91D60A6E0CFB47A311678E0638962E978BC47ABDA6D7BD 56AB91D60A4E95CD6683ED76CB99A381F8158DC7E334115EAF17EEEEEEF8F4657 6BB1D3D547CC9709D66B3C96704688A7061B3D94C05780578D41A373737D06AB5 685139D298E265E1BD93CFB83CC42953C7B9BF2A2700FE001125FC161DCF24BC0 000000049454E44AE42608200"; end function folderbmp(); begin return "0502000000060400000074797065000203000000696D670006040000006461746 10002C301000089504E470D0A1A0A0000000D4948445200000018000000180806 000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000015849444154 484BDD94318A8340144025571052A7509BF429839590CE464825DA0662E301CC0 1C42282E00162E1016C0541888585827D7A4B0FF037F377D4C8EEC2B23369F6C1 C7FF3F3A6F661C468037F30F04AAAA8220085F62BBDD42D775F4B5BFF31CEBFB4 55C2E172E921F0504CFF316ABFA4DC4714CBFFEE4D9E3F71B4EA7134EEA9585A0 2CCBC56C58C3300CF29C05B66D431004B462878A66812CCB70BFDF69C5469665A 069DA2CA8AA0AD6EB35E63C389FCFE0FBFE2C20C5F178C49C07922441DBB6B340 D77508C31073561E8F076C361BCC2781288A50D735E6AC5CAF57B02C0B731490F D5714051B3C381C0E70BBDD304701B9164CD3C4060FC8987DDF8FB900FBFD1EA2 28C2062B455100B9404750B05AADA0691ADA62C3755DDC911114EC763B5AB2438 E679EE7B4A202C77168C9C6300CD3F11C4141922468658D344DA7E33922902345 7E0AAF20A257E69BEE4DBC5900F00106E8BE867C71B1300000000049454E44AE4 2608200"; end function dllbmp(); begin return "0502000000060400000074797065000203000000696D670006040000006461746 10002DB01000089504E470D0A1A0A0000000D4948445200000018000000180806 000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000017049444154 484B63F84F638061C1D7EFDFFFBF79FF9E285CD53105AA0B37C0B0E0D5BB77FF5 FBE7D4B142E6F9DF4BFA8A117AA133BC0B000E4326C8661C3200B4C3C62F05A42 9105156D100BF059429105D76EDF055B02F20908638B138A2C40C720BDE880240 B662D5D0BC4EBB0CA8130D91680BC9F5BD3F53F34AD1C8C41EC8AB6C918EAC8B2 E0DEE327FFBD62F2FE1F3F77090583C490D581305916F4CD5A0276F59E2327E13 E80B14172C86AC9B220B1B0E1FFD2F5DBA0E18FC02031901CB25AB22CB874E336 38384041054B8EB06003C921AB25CB029861A08885B91EC4A65A1C803072C4823 08C8FAE8E6C0B88C523C0823317AFC14B4750120C482C82F389C5203390014E0B 402EBA71F73E980659366FE546B038321B1B26C902180D3274D1DAAD603E321B1 B26C98285AB37C32D58BD65F7FF82FA1E1436B2C1308CD702108029049533F53D 33FEC7E4D6FC0F4A2EF9DFD03B132C86CC768BC842311C84D1018605200072053 91813FCFF0F007C3FE0AC714133290000000049454E44AE42608200"; end function gettbicons(); begin r := array(); r["关闭"] := "0502000000060400000074797065000203000000696D670006040000006461746 10002C401000089504E470D0A1A0A0000000D4948445200000014000000140806 0000008D891D0D000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000015949444154 384F9D9431CA83401085F7625E21E015BC8156D639809D95AD36C142248568ED0 93C8277B0B0D99F4F32B2EB8EE1270F1EAC3B6FBE85901963156DDB66C771B455 55D93CCF6D1CC7873973478D8CA600B82C8B4D92C44651F4D564C85EE501BBAE5 39BBF991E5727709E67B5E13FA6577400D775F502455178DF9AAF19180770DF77 9BA6A917444DD3780DAEA921170A03961986C10B636968DB36A87187B4076199B 22C830296C6F7FB7DDE7146DA431896C9B24C2D6201F0BFC3C87DE06A58E6F178 A845B18010672D2386659800AD289EA6E983B3C759CB886119C6492BE2BEEF4F9 080B9D3B218966136B5E2EBF50A00F20035372B8665B4DFA5AEEBDB467988CCB5 06CBB035DC65F07C3E6F1BC4F22059B98301EB183DB686DBE006EF7CCDC8E6399 7C32F9B46EC6E1C6F7DFDB271DC4D833C20626BB8CBE2CE6464C3B80A8088ADC1 A0339B8C1313803973478D4C286BFF00D135DFBA6F19E4A90000000049454E44A E42608200"; r["添加工作目录"]:=folderbmp(); r["移除工作目录"] := "0502000000060400000074797065000203000000696D670006040000006461746 10002F101000089504E470D0A1A0A0000000D4948445200000014000000140806 0000008D891D0D000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000018649444154 384F9594A1AEC2301486270978C41C8684CC20090A3B4B022F805C160C9204378 5018F4060103C0104349E81C5E030047FEEFD0FA7A5BD1B2BF74B9AECB4E7FFE8 9A328F3EB0DFEF0BC727728508789E573826938974DBB0F072B9647680D0E170C 81D9D4E8785663F1C5AD8EBF5323BF8EF80430BC1743AA57ABD2ED5F7341A0DCE 2AB470B55A51B95C96EACD7C3E9727A2D3E944F7FB5DAA17954A85B30A2DDCED7 6BC751375960A757626584756A1BBCFE7332F5EAF5799710B6FB71BAF23ABD0DD 8FC7834AA5124B142EE1F178E40CB28A77F72FB55A8D168B85546EE166B3E18C8 9256CB7DB341E8FA5720B67B319674C2C61B7DBA5C16020955B381A8D38636209 A328A2300CA5720BFBFD3E674C2C619224D46C36A5720B5BAD16674C2CE172B9A 46AB52A955BE8FB3E674C2CE176BB6581BA06100641C0CF60381C6AE1F3F9E45E 644C2CA1BADC699ACACCEBEF9607BE2EE8352F35B084D8199AD6EBB5CC7C063DE 6DB282C2188E3981B715E45033DE8FD4B4608F0EB38ABA291FF16443F3022F41A 5192ECC50000000049454E44AE42608200"; r["刷新"] := "0502000000060400000074797065000203000000696D670006040000006461746 100029C01000089504E470D0A1A0A0000000D4948445200000014000000140806 0000008D891D0D000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000013149444154 384FBD940D8D834010464F10064000064000180001200004A0000318000128C00 0063030CD9B63B62D85CB5ED3F42513C8EEEC373F3BF0231FE67B82EBBA4ADBB6 92A6A90441A0C67B5DD732CFF3EEF5CAA960DFF72A1086A15455255DD7A9F11EC 7B1EE956529DBB6ED27EE3C099215360C83DAD9012020C1C8F8E8A382E338BAD2 78FAB02C8B8AE679BEAFFCA2824551489224AE5764E90355E0FFD85357323D222 23DC2D117FC49C87082599669D3C9EEAA7767344DA3591A4E9045B2FC2F9CF98E 209742D9BE585B6C360D2768BDF0BD6184B88C63654E102136F9027CB091C1984 51375826059F2BDFAC098E14FAB18747812044AB1A8D334EDAB7758638FE00CF4 B1452F8240FA163D8A221578FCEBB07735FCA782C02D7288C653920D3E6B7F0DF EA5E0BB7C5850E4063EDA83420076B5E10000000049454E44AE42608200"; r["查找"]:="0502000000060400000074797065000203000000696D670006040000006461746 100023601000089504E470D0A1A0A0000000D4948445200000014000000140806 0000008D891D0D000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA864000000CB49444154 384FED91310A8340104573201BB1110BC1422CC446F068DEC033D968A3853636D AD8083FFC75922059758349970703C39FD9C7B27BC397F90BAFF35B615114D299 93E7B9742B4F615996B02C0B599649720E777986671F6C6E58D7351CC7319272C 7B66D545525C9CADB1BB66D0BCFF30EA59CB9AE8BA6692479A1FD94BEEF110481 56CACCF77D745D27C916AD900CC380288A3652F66118AAD91EBB42324D1392245 122561CC718C751A67A0E85649E67A469AA8AFD19A742B22C8B2A138C849FF017 5E05B8030D10FC4ABB5F29D00000000049454E44AE42608200"; r["反向查找"] := "0502000000060400000074797065000203000000696D670006040000006461746 100023A01000089504E470D0A1A0A0000000D4948445200000014000000140806 0000008D891D0D000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA864000000CF49444154 384FEDD1CF0A454014C7F1D959B1B2623536BC25CF63230B29A5A4B010C50BFD6 E8733F736F973955B77E3B31A67CC7714811F7B82F7FD2738CF33A669E2A7735F 83C330200802F8BE8FBEEF797AEC34D8751D3CCF43188688A208524A344DC3BBF B0E83755DC375DD25A650D4711C5455C593ADDD605996B06D5B8B2914A5BDA228 78A2DB04F33C876559CBC1237491699AC8B28C271F5A304D531886711A53284AE F2649C293D53B18C731841097620A45E90C9D55B42F1CC79157D7B56DCBABD5EE 4FB9E309DE05BC002EB9F422B338307C0000000049454E44AE42608200"; r["打开"] := "0502000000060400000074797065000203000000696D670006040000006461746 10002C201000089504E470D0A1A0A0000000D4948445200000014000000140806 0000008D891D0D000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000015749444154 384FB5D43D4BC350140660FF89820AFE1135D2440545AB82E26235A9427129A25 25C6A116A9DD4BD4E756951076D87BAD4D14E814AA042B01532660CBC72AE69B8 FD8A37105F38907393F364B8371941C8F93FB0542C428DED627D35EA5B1F8D863 B01E8BA8ED657CBED7EE381715545A55CC15BADE65B9DD0F3F482F1D1313C3D3C BAAB1C48374443181585307E363048D0DE4ECC43799C1208A4C1EDCD2D388EE3F 53C461106697023BA06DBB6597F9848F4611421F0408B636569199665B1FE2899 F4B0FA7BBD0BFE13246C5151609A26EBCF52A92E80769E9FF505098BCC4A300C8 3F599741AFB9AC6AE3B11063F9B4DCC476448D333EC30E7B2D93E8C220CDEE5F3 B838CFE0F6FA86A183308A3048674D96E6303531C9BE88611106EF0B05BC56ABF 86EB7DD95C109B42922190AD25110F939F4D6D5650E0BB2E22A1C28FAFBEAADD3 E313949F5F5C8503C34AC820F003058F6573F619F1EC0000000049454E44AE426 08200"; return r; end fbackrootdirs; FTree; FEdit; fbtn; FRootdirs; fnodes; Fnodeinfos; fdircrc; type tdirnodeinfo = class() function create(); begin isfile := true; Folder := ""; fname := ""; iof := iofileseparator(); end function fullname(); begin return Folder+iof+fname; end isfile; Folder; fname; caption; rootnode; private iof; end end