tslediter/designer/tediterform.tsf

2083 lines
63 KiB
Plaintext

type TEditerForm = class(TVCform) //编辑器主窗口
uses utslvclauxiliary,tslvcl,UTslSynMemo,UtslCodeEditor;
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";
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;
//////////////////目录/////////////////////
{$ifdef linux}
home := sysgetenv("HOME");
if home then basepath := home+"/.vcl/";
else
basepath := ".vcl/";
{$else}
basepath := TS_GetUserProfileHome();
{$endif}
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";
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 := "窗口";
fmglobsearch := new TMenu(self);
fmglobsearch.caption := "日志窗口..";
fmglobsearch.OnClick := function(o,e)
begin
FEDter.SwitchLogWnd();
end
fmglobdir := new TMenu(self);
fmglobdir.caption := "目录";
fmglobdir.onclick := function(o,e)
begin
v := not(Fdirview.Visible);
Fdirview.Visible := v;
fdirspliter.Visible := v;
end
///////////////////////////////////////////////////////
FEnCodeMenu := new TMenu(self);
FEnCodeMenu.Caption := "编码";
FCodeMenus := array();
for i,v in array("ANSI","UTF8","UTF8 BOM","UCS2-big","UCS2-little","----","转为ANSI","转为UTF8","转为UTF8 BOM","转为UCS2-big","转为UCS2-little") do
begin
it := new TMenu(self);
it.Caption := v;
FCodeMenus[i] := it;
if v="----" then it.TSeparator := true;
else
if v in array("UCS2-big","UCS2-little","UTF8 BOM") 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 := "打开";
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 := "新建";
NewAction.onexecute := function(o,e)
begin
return FEdter.CreateAfile();
end
Fmnew.action := NewAction;
FOpenOther := new TMenu(self);
FOpenOther.Caption := "其他窗口打开";
FOpenOther.OnClick := thisfunction(OpenInOtherWnd) ;
FOpenHistoryMenu := new TMenu(self);
FOpenHistoryMenu.caption := "打开历史";
FOpenHistoryMenu.OnClick := function(o,e)begin
FEdter.ShowHistoryWnd();
end
////////////////////////////////////////////////////////////////////
FTslLangMenu := new tmenu(self);
FTslLangMenu.Caption := "语言设置";
FTslFormatMenu := new tmenu(self);
FTslFormatMenu.Caption := "tsl代码格式设置";
FTslFormatMenu.OnClick := function(o,e)begin
FFormatInfoWnd.show();
end
FCodeBlockMenu := new TMenu(self);
FCodeBlockMenu.caption := "tsl代码块设置";
FCodeBlockMenu.OnClick := function(o,e)begin
fBlockManager.ShowModal();
end
FMenuSet := new TMenu(self);
FMenuSet.caption := "设置";
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 := "代码块管理";
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 :="tsl执行设置";
fmfile := new TMenu(self);
fmfile.caption := "文件";
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 := "编辑器颜色";
FMTabs := array();
FMTabContain.Caption := "tab设置:";
for i:= 0 to 6 do
begin
tm := new TMenu(self);
if i=0 then tm.Caption := "\\t";
else
tm.Caption := inttostr(i)+"空格";
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:="关闭时最小化";
//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.fcbtn.OnClick := 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 := "语言";
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 := "运行";
FExeaction := new TAction(self);
FExeaction.caption := "执行";
FExeaction.ShortCut := "F9";
FExeaction.onexecute := function(o,e)
begin
FEdter.ExecutePageItem(FEdter.GetCurrentItem());
end
for i,v in array("命令行配置","tsl函数目录","执行","调试运行","远程调试","远程调试(waitattach)") do
begin
it := new TMenu(self);
if v = "执行" then
begin
it.Action := FExeaction;
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 := "帮助";
FHelpMenus := array();
for i,v in array("tsl语言帮助","关于") 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(),"",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
"tsl语言帮助":
begin
return FEdter.ShowTslLangChm();
end
"关于":
begin
return messageboxa(static editerinfo(),"关于",0,self.Handle);
end
end
end
function PageItemSelChanged(o,it)
begin
if it then
begin
if it.fisnewfile then self.Caption := (it.FEditer.ChangedFlag?"*":"")+ " new ";
else
self.Caption := (it.FEditer.ChangedFlag?"*":"")+ it.OrigScriptPath;
end else
caption := "-tsl编辑器";
ModifyEnCodeMenu(it);
ModifySynMenu(it);
end
function PageEditerChanged(it,flg)
begin
cit := FEdter.GetCurrentItem();
if it=cit then
begin
if it.fisnewfile then self.Caption := (flg?"*":"")+ " new "//o.Caption;//it.ScriptPath+" -tsl编辑器";
else
self.Caption := (flg?"*":"")+ it.OrigScriptPath;//o.Caption;//it.ScriptPath+" -tsl编辑器";
ModifyEnCodeMenu(it);
end
else caption := "-tsl 编辑器";
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_dotsavehistory;
if g_dotsavehistory then return ;
d := FEdter.GetAllPagesInfo();
if not ifarray(d) then d := array();
exportfile(ftstream(),"",FOpendpaths,d);
FEdter.CloseAllPageItems();
end
function clickRun(o,e);
begin
case o.caption of
"命令行配置":
begin
FEdter.ShowExeEditer();
end
"调试运行":
begin
FEdter.DebugPageItem(FEdter.GetCurrentItem());
end
"远程调试":
begin
FEdter.Debugremote(0);
end
"远程调试(waitattach)":
begin
FEdter.Debugremote(1);
end
"tsl函数目录":
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
"ANSI":
begin
it.CurrentcodeIsAnsi();
end
"UTF8":
begin
it.CurrentCodeIsUtf8();
end
"转为UCS2-big":
begin
it.ToUnicode_big();
end
"转为UCS2-little":
begin
it.ToUniocode_little();
end
"转为ANSI":
begin
it.ToANSI();
end
"转为UTF8":
begin
it.ToUtF8();
end
"转为UTF8 BOM":
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>5 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
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
FEditer.caption := "修改代码块...";
FEditer.SetData(FList.SelectedValue);
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 tsearchdir = class(TCustomControl)
uses tslvcl;
function Create(AOwner);override;
begin
inherited;
caption := "函数搜索目录:左侧为别名,右侧为-libpath目录....";
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,310+t));
FLists := array();
FBtns := array();
for i,v in array(array(2,28,120,230),array(148,2,500,230)) do
begin
ls := new TListBox(self);
ls.SetBoundsRect(v);
ls.parent := self;
ls.Border := true;
FLists[i] := ls;
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
/////////////////////////////////
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 ;
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;
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;
FOpendpaths;
FTabWidthpath;
FFileopen;
FexefileCmds;
FCodeblockPath;
FHistoryPath;
FFindhistroypath;
FFormatpath;
Fremotepath;
fdirspath;
Fhighlightpath;
FEdter;
FSearchDir;
FCache;
FPathDirPath;
FDirs;
Fexefilepath;
/////////////////actions
FExeaction;
end
type tdirviewer = class(tcustomcontrol)
uses tslvcl;
function create(AOwner);
begin
inherited;
fnodes := array();
FEdit := new tedit(self);
imglst := new tcontrolimagelist(self);
bmp := new TBitmap();
bmp.readvcon(HexFormatStrToTsl(folderbmp()));
imglst.addbmp(bmp);
bmp.readvcon(HexFormatStrToTsl(filebmp()));
imglst.addbmp(bmp);
bmp.readvcon(HexFormatStrToTsl(dllbmp()));
imglst.addbmp(bmp);
bmp.readvcon(HexFormatStrToTsl(searchbmp()));
Width := 300;
FTree := new TTreeView(self);
FTree.Align := alClient;
FTree.parent := self;
ftree.ImageList := imglst;
FRootdirs := array();
FTree.onEmptyNodeExapanding:= thisfunction(emptyexpanding);
Fnodeinfos := array();
fdircrc := array();
FEdit.parent := self;
FEdit.onkeyup := function(o,e)begin
if e.CharCode=13 then
begin
e.skip := true;
dofind();
end
end
fcbtn := new tbtn(self);
fcbtn.caption := "";
fcbtn.Parent := self;
fbtn := new tbtn(self);
fbtn.caption := "";
fbtn.BKBitmap := bmp;
fbtn.parent := self;
fbtn.onclick := thisfunction(dofind);
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;
s := "0502000000060400000074797065000203000000696D670006040000006461746
100023F01000089504E470D0A1A0A0000000D4948445200000012000000120806
00000056CE8E57000000017352474200AECE1CE90000000467414D410000B18F0
BFC6105000000097048597300000EC300000EC301C76FA864000000D449444154
384F63F84F2530920CFAB465CDFF4FDBD6417998E0757F3394850AB01A745395E
FFF9783BBA12208F0BC22EBFFD3CC48280F1560F5DAE7EDEBFFDF3696FDFFFDEC
71A8087E43400067187D39B0EBFF3D47DDFF3FAE5F26680808E00DEC6FE74EFE7
FE06F4BD01010C06B10C8250FFCACFFDF54E1FDFF79F716A8287680D32090218F
22DCC0EC4F5BD7FEBFA527F1FFDBF183603E3680D52090218F9302A13C08F87AE
CC0FFBB16CAFFBF5F3C031541051806BD01A6135C61F2FDC2E9FFF79CF4A03C54
80378C4801A3061102FFFF03001C3CE074AD27DED70000000049454E44AE42608
200";
bmp := new TBitmap();
bmp.readvcon(HexFormatStrToTsl(s));
fcbtn.BKBitmap := bmp;
end
fcbtn;
fms;
ffolder;
function muclick(o,e);
begin
case o.caption of
"添加工作目录":
begin
if not ffolder then ffolder := new TFolderChooseADlg(self);
if ffolder.OpenDlg() then
begin
return addrootdir(ffolder.Folder);
end
end
"移除工作目录":
begin
nd := FTree.CurrentNode;
delrootdir(nd);
end
"刷新":
begin
refreshdir();
end
"打开":
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
end ;
end
function dofind(o,e);
begin
s := lowercase(trim(FEdit.text));
if not s then return ;
it := ftree.CurrentNode;
getallnodes();
return finds(it,s);
end
function finds(it,s)
begin
bit := it;
flag := false;
ct := length(fnodes);
firstx := 0;
for i,v in fnodes do
begin
if v=it then
begin
firstx := i+1;
break;
end
end
for i := 0 to ct -1 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 doControlALign();override;
begin
if FEdit and FTree and fbtn and fcbtn then
begin
rc := ClientRect;
rc1 := array(rc[0]+20,rc[1],rc[2]-30,rc[0]+24);
rc3 := array(rc[2]-26,rc[1],rc[2]-2,rc[0]+24);
rc4 := array(rc[0]+1,rc[1]+2,rc[0]+19,rc[1]+20);
rc2 := array(rc[0],rc[1]+25,rc[2],rc[3]);
FEdit.SetBoundsRect(rc1);
FTree.SetBoundsRect(rc2);
fbtn.SetBoundsRect(rc3);
fcbtn.SetBoundsRect(rc4);
end
end
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 countfile(dir,n,ct);
begin
n++;
if ct<=n then return ;
iof := static iofileseparator();
fs := filelist("",dir);
if not fs then return n;
for i,v in filelist("",dir+iof+"*") do
begin
fn := v["FileName"];
if pos("H",v["Attr"]) then continue;
if fn="." or fn=".." then continue;
if pos("D",v["Attr"]) then
begin
countfile(dir+iof+fn,n,ct);
end else n++;
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(".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
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
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
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 searchbmp();
begin
return "0502000000060400000074797065000203000000696D670006040000006461746
100020502000089504E470D0A1A0A0000000D4948445200000018000000180806
000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0
BFC6105000000097048597300000EC300000EC301C76FA8640000019A49444154
484BED942FABC2601487170D1A440D62D0E0D2D06214C14FB02698449BF82564C
92018FC0676510441B098B681268320220836A36098E97739F3782FF2BEF35DF0
A67B1F58F89DFD79DEEDECBC1A7E993F24389FCF58AFD7B8DD6E5C098752D0E97
490CBE5A069DAF7512C16311C0EF98AF7040AB6DB2D32990C9ACD26369B0D2E97
0B3CCFC3E170C0783C46229180699A381E8F7C871CA9E07EBFFB2B9D4C265C915
32E97D1683438C9910AEAF53A2CCBE214CCF57A453299C462B1E08A8820389D4E
88C5629CD4F4FB7DB45A2D4E2282603E9F43D7754E6A6CDB462A95E2242208BAD
D2EAAD52AA77050BF56AB15A75704C16C36433E9FE7A4861EFCEE930A82FD7E8F
6834CA490DF5A056AB7112110444A552C16030E014CCF32F1A8D465C11910AE8B
5C3CE41BBDDE624472A20A8D9F178DC9FE4DD6EC7D5C7AA9F936C18C6CB391981
0282FA417B113D2C9D4EA3542AF96F562814D0EBF5FC4564B359B8AECB7788BC1
53CA1AD83E683FAE2380E571F908416B05C2EB9F24A28810A924422114CA753AE
FCF011011134A01F1304F12F50007C017768621EE3E529620000000049454E44A
E42608200";
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
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