3282 lines
95 KiB
Plaintext
3282 lines
95 KiB
Plaintext
unit utslvcldebuger;
|
||
interface
|
||
{**
|
||
@explan(说明) 编辑器调试功能 %%
|
||
@date(20220520)
|
||
**}
|
||
uses cstructurelib,utslvclauxiliary,utslvclmemstruct, UTslMemo,UTslSynMemo,utslvclstdctl, tslvcl;
|
||
function tdbgcallback(); //调试回调
|
||
type TTslDebug = class(TTslDebuga)
|
||
function create(AOwner);
|
||
begin
|
||
inherited;
|
||
end
|
||
end
|
||
type TFTSLScriptcustomMemo=class(TSYNmemoNorm)
|
||
private
|
||
fhgcolor;
|
||
function sethgcolor(hc);
|
||
begin
|
||
fhgcolor := hc;
|
||
if hc then
|
||
begin
|
||
setbkc(hc.bkcolor().color);
|
||
setfc(hc.fontcolor().color);
|
||
setselbc(hc.selbkcolor().color);
|
||
curbc(hc.curbkcolor().color);
|
||
setgutter(hc.gutterbkcolor().color);
|
||
end
|
||
end
|
||
function setselbc(bc);
|
||
begin
|
||
if bc>0 then selectbkcolor := bc;
|
||
else selectbkcolor := rgb(192,192,192);
|
||
end
|
||
function setgutter(bc);
|
||
begin
|
||
if bc>0 then guttercolor := bc;
|
||
else guttercolor := rgb(228,228,288);
|
||
|
||
end
|
||
function curbc(bc);
|
||
begin
|
||
if bc>0 then currentLineColor := bc;
|
||
else currentLineColor := rgb(232,232,255);
|
||
end
|
||
function setbkc(bc);
|
||
begin
|
||
if bc>0 then color := bc;
|
||
else color := 0xfefefe;
|
||
|
||
end
|
||
function setfc(bc);
|
||
begin
|
||
if bc>=0 then font.color := bc;
|
||
else font.color := 0;
|
||
|
||
end
|
||
public
|
||
property hgcolor read fhgcolor write sethgcolor;
|
||
function Create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
WsDlgModalFrame := true;
|
||
FChangedFlag := false;
|
||
FChangedLock := false;
|
||
Lineinterval := 3;
|
||
font := array("height":18,"width":9,"escapement":0,"orientation":0,"weight":400,"italic":0,"underline":0,"strikeout":0,
|
||
"charset":0,"outprecision":0,"clipprecision":0,"quality":1,"pitchandfamily":1,"facename":"Courier New","color":0);
|
||
//134
|
||
//font := array("facename":"Courier New");
|
||
autogutterwidth := true;
|
||
ongutterclick := function()begin
|
||
SwitchMarkLine(CaretY-1);
|
||
end
|
||
end
|
||
function DoCaretPosChanged();override;
|
||
begin
|
||
if HandleAllocated()then calldatafunction(FOnCaretChanged,self(true),new tuieventbase(0,0,0,0));
|
||
//echo tostn(self.CaretXY);
|
||
end
|
||
function InvalidateLines(FirstLine,LastLine:integer);override;
|
||
begin
|
||
if not HandleAllocated()then return;
|
||
if HighLighter is class(TTslSynHighLighter)then
|
||
begin
|
||
fy :=(FirstLine-TopLine) * LineHeight;
|
||
r := ClientRect;
|
||
if fy<(r[1]-2) then return;
|
||
if fy>(r[3]+2)then return;
|
||
r[0]:= GutterWidth;
|
||
r[1]:= max(0,fy);
|
||
InvalidateRect(r,false);
|
||
end else
|
||
return inherited;
|
||
end
|
||
function MouseUp(o,e);override;
|
||
begin
|
||
inherited;
|
||
end
|
||
function InsertChars(s);override;
|
||
begin
|
||
if(s="\r\n")then
|
||
begin
|
||
y := CaretY;
|
||
x := CaretX;
|
||
sl := Lines.GetStringByIndex(y-1);
|
||
if ifstring(sl)and sl then
|
||
begin
|
||
ins := "";
|
||
for i := 1 to x-1 do
|
||
begin
|
||
si := sl[i];
|
||
if si="\t" or si=" " then
|
||
begin
|
||
ins += si;
|
||
end else
|
||
break;
|
||
end
|
||
if ins then
|
||
begin
|
||
return inherited InsertChars(s+ins);
|
||
end
|
||
end
|
||
end
|
||
return inherited;
|
||
end
|
||
function KeyUp(o,e);override;
|
||
begin
|
||
e.Result := 1;
|
||
if Calldatafunction(FQuckKeys,self,e)then return;
|
||
inherited;
|
||
end
|
||
function ContextMenu(o,e);override;
|
||
begin
|
||
inherited;
|
||
e.skip := true;
|
||
end
|
||
function SwitchMarkLine(L); //此处处理断点问题
|
||
begin
|
||
if not(L >= 0)then
|
||
begin
|
||
L := self.CaretY-1;
|
||
end
|
||
it := Lines[L];
|
||
if it then
|
||
begin
|
||
it.FMarked := not(it.FMarked);
|
||
r := ClientRect;
|
||
r[2]:= GutterWidth()-1;
|
||
InValidateRect(r,false);
|
||
if _Tag then _Tag.markline(L,it.FMarked);
|
||
end
|
||
end
|
||
function KeyDown(o,e);override;
|
||
begin
|
||
e.Result := 0;
|
||
qc := Calldatafunction(FQuckKeys,self,e);
|
||
if qc then return;
|
||
if e.CharCode=VK_F5 then
|
||
begin
|
||
L := self.CaretY-1;
|
||
SwitchMarkLine(L);
|
||
return;
|
||
end
|
||
if e.CharCode=VK_F2 and(ssCtrl in e.shiftState())then
|
||
begin
|
||
L := self.CaretY-1;
|
||
SwitchMarkLine(L);
|
||
return;
|
||
end
|
||
if not(ssCtrl in e.shiftstate())and not(ssShift in e.shiftstate())then
|
||
begin
|
||
if e.CharCode=VK_F2 then
|
||
begin
|
||
y := CaretY-1;
|
||
len := Lines.length();
|
||
for i := y+1 to len+y-1 do
|
||
begin
|
||
idx :=(i+len)mod len;
|
||
it := Lines[idx];
|
||
if it and it.FMarked then
|
||
begin
|
||
return ExecuteCommand(ecGotoXY,array(idx+1,1));
|
||
end
|
||
end
|
||
return;
|
||
end
|
||
end
|
||
inherited;
|
||
end
|
||
function WMSYSKEYUP(o,e):WM_SYSKEYUP;override;
|
||
begin
|
||
e.Result := 1;
|
||
if CallDatafunction(FQuckKeys,self,e)then return;
|
||
inherited;
|
||
end
|
||
Function WMSYSKEYDOWN(o,e):WM_SYSKEYDOWN;override;
|
||
begin
|
||
e.Result := 0;
|
||
if CallDatafunction(FQuckKeys,self,e)then return;
|
||
inherited;
|
||
end
|
||
function WMSETFOCUS(o,e):WM_SETFOCUS;override;
|
||
begin
|
||
inherited;
|
||
CallDataFunction(FOnTextSetFocus,self(true),e);
|
||
end
|
||
function DoTextChanged(p);override;
|
||
begin
|
||
inherited;
|
||
SetChangeFlag(true);
|
||
end
|
||
function Notification(a,op);override;
|
||
begin
|
||
if ifarray(op) and op["editer"] and a = fhgcolor then
|
||
begin
|
||
if op["value"] .& 2 then
|
||
begin
|
||
setbkc(a.bkcolor().color);
|
||
end
|
||
if op["value"] .& 4 then
|
||
begin
|
||
setfc(a.fontcolor().color);
|
||
end
|
||
if op["value"] .& 1 then
|
||
begin
|
||
if Visible then
|
||
InvalidateRect(nil,false);
|
||
end
|
||
if op["value"] .& 8 then
|
||
begin
|
||
setselbc(a.selbkcolor().color);
|
||
end
|
||
if op["value"] .& 16 then
|
||
begin
|
||
curbc(a.curbkcolor().color);
|
||
end
|
||
if op["value"] .& 32 then
|
||
begin
|
||
setgutter(a.gutterbkcolor().color);
|
||
end
|
||
return ;
|
||
end
|
||
inherited;
|
||
|
||
end
|
||
function Recycling();override;
|
||
begin
|
||
FQuckKeys := nil;
|
||
FOnTextChanged := nil;
|
||
FOnTextSetFocus := nil;
|
||
FPageItem := nil;
|
||
FOnCaretChanged := nil;
|
||
inherited;
|
||
end
|
||
published
|
||
property OnCaretChanged read FOnCaretChanged write FOnCaretChanged;
|
||
property PageItem read FPageItem write FPageItem;
|
||
property OnTextChanged read FOnTextChanged write FOnTextChanged; //文本改变
|
||
property QuckKeys read FQuckKeys write FQuckKeys; //快捷键
|
||
property ChangedFlag read FChangedFlag write SetChangeFlag;
|
||
property ChangedLock read FChangedLock write FChangedLock;
|
||
property OnTextSetFocus read FOnTextSetFocus write FOnTextSetFocus;
|
||
private
|
||
function SetChangeFlag(v);
|
||
begin
|
||
nv := v?true:false;
|
||
if nv <> FChangedFlag then
|
||
begin
|
||
FChangedFlag := nv;
|
||
if FChangedLock then return;
|
||
calldatafunction(OnTextChanged,self(true),nv);
|
||
end
|
||
end
|
||
FPageItem;
|
||
FChangedLock;
|
||
FChangedFlag;
|
||
FOnTextChanged;
|
||
FOnTextSetFocus;
|
||
FQuckKeys;
|
||
FOnCaretChanged;
|
||
end
|
||
implementation
|
||
|
||
type TTslDebuga=class(TCustomControl)
|
||
private //成员变量
|
||
frunbtncall;
|
||
//Frundirect;
|
||
FRuningfile; //执行脚本文件名
|
||
FRuningItem; //执行的pageitem
|
||
FCurrentgotoitem; //当前运行到的pageitem
|
||
fdebugproc;
|
||
Fdebugedwhandle ;//调试的窗口
|
||
FDebugExe; //调试功能的exe
|
||
FConnectchannel; //调试的 通道
|
||
FDebugaddr; //地址
|
||
FDebugport; //调试的端口
|
||
FDebugUsr; //用户名
|
||
FDebugPwd; //密码
|
||
FDebugtsfs; //当前工程对应的tsf文件
|
||
FBtns;
|
||
FAttchedid;
|
||
fremotedbugstart;
|
||
fscriptbrks;//记录脚本的断点
|
||
FDebugtype;
|
||
fdbgselwnd;
|
||
FRemoteWait; //远程调试等待
|
||
FValewnd;
|
||
FCmdHistory;
|
||
FCmdHistoryid;
|
||
FCmdHistorycount;
|
||
////////////////////
|
||
Fdbgssybs;
|
||
Fdbgsybs;
|
||
Fdbgstack;
|
||
fdefaultdbger; //编辑器的调试器
|
||
fpopediterhandle;
|
||
type tdbgwnd=class(TPanel)
|
||
uses tslvcl;
|
||
function Create(AOwner);
|
||
begin
|
||
inherited;
|
||
WsDlgModalFrame := false;
|
||
p1 := new TPairSplitter(self);
|
||
p1.Position := 310;
|
||
p2 := new TPairSplitter(self);
|
||
p2.Position := 310;
|
||
sd1 := new TPairSplitterSide(self);
|
||
sd2 := new TPairSplitterSide(self);
|
||
sd3 := new TPairSplitterSide(self);
|
||
sd3 := new TPairSplitterSide(self);
|
||
sd4 := new TPairSplitterSide(self);
|
||
p1.Align := alClient;
|
||
sd1.WsDlgModalFrame := false;
|
||
sd2.WsDlgModalFrame := false;
|
||
sd3.WsDlgModalFrame := false;
|
||
sd4.WsDlgModalFrame := false;
|
||
p1.WsDlgModalFrame := false;
|
||
p2.WsDlgModalFrame := false;
|
||
p1.parent := self;
|
||
sd1.parent := p1;
|
||
sd1.Border := false;
|
||
sd2.parent := p1;
|
||
p2.Align := alClient;
|
||
p2.parent := sd2;
|
||
sd3.parent := p2;
|
||
sd4.parent := p2;
|
||
sd4.Border := false;
|
||
fside1 := sd1;
|
||
fside2 := sd3;
|
||
fside3 := sd4;
|
||
end
|
||
function addwnds(stk,vlist,cmd,cmdshow);
|
||
begin
|
||
stk.Align := alClient;
|
||
stk.parent := fside1;
|
||
vlist.Align := alClient;
|
||
vlist.parent := fside2;
|
||
cmd.Align := alBottom;
|
||
cmd.parent := fside3;
|
||
cmdshow.Align := alClient;
|
||
cmdshow.parent := fside3;
|
||
end
|
||
function Recycling();override;
|
||
begin
|
||
inherited;
|
||
fside1 := nil;
|
||
fside2 := nil;
|
||
fside3 := nil;
|
||
end
|
||
fside1;
|
||
fside2;
|
||
fside3;
|
||
end
|
||
function cmdkeyup(o,e);
|
||
begin
|
||
case e.charcode of
|
||
VK_UP:
|
||
begin
|
||
//return ;
|
||
if FCmdHistoryid <= 0 then return o.text := "";
|
||
FCmdHistoryid--;
|
||
txt := FCmdHistory[FCmdHistoryid];
|
||
if ifstring(txt)and txt then
|
||
begin
|
||
o.text := txt;
|
||
o.SetSel(length(txt),length(txt));
|
||
end
|
||
end
|
||
VK_DOWN:
|
||
begin
|
||
if FCmdHistoryid >= Length(FCmdHistory)then return o.text := "";
|
||
FCmdHistoryid++;
|
||
txt := FCmdHistory[FCmdHistoryid];
|
||
if ifstring(txt)and txt then
|
||
begin
|
||
o.text := txt;
|
||
o.SetSel(length(txt),length(txt));
|
||
end
|
||
end
|
||
13:
|
||
begin
|
||
//return ExecuteCommand("docmd");
|
||
txt := trim(o.Text);
|
||
if txt then
|
||
begin
|
||
if length(FCmdHistory)>FCmdHistorycount then
|
||
begin
|
||
for i := 0 to FCmdHistorycount-1 do
|
||
begin
|
||
FCmdHistory[i]:= FCmdHistory[i+1];
|
||
end
|
||
end
|
||
FCmdHistory[length(FCmdHistory)]:= txt;
|
||
FCmdHistoryid := length(FCmdHistory);
|
||
ExecuteCommand("docmd");
|
||
end
|
||
e.skip := true;
|
||
end
|
||
end
|
||
end
|
||
function getvalewnd(cp);
|
||
begin
|
||
if not FValewnd then
|
||
begin
|
||
FValewnd := new tdbgvalueshowgrid(self);
|
||
FValewnd.Visible := false;
|
||
FValewnd.Caption := "Value";
|
||
FValewnd.left := owner.left+100;
|
||
FValewnd.Width := 600;
|
||
FValewnd.Height := 500;
|
||
FValewnd.WSpOPUp := true;
|
||
FValewnd.WSsYSMenu := true;
|
||
FValewnd.WsSizeBox := true;
|
||
FValewnd.Parent := self;
|
||
FValewnd.OnClose := function(o,e)
|
||
begin
|
||
o.Visible := false;
|
||
o.TSLdata := array();
|
||
end
|
||
end
|
||
if ifstring(cp)then FValewnd.Caption := cp;
|
||
return FValewnd;
|
||
end
|
||
function deletefuncacheini();
|
||
begin
|
||
return filedelete("",(TS_ModulePath()+"FunCache.ini"));
|
||
end
|
||
public
|
||
property runbtncall read frunbtncall write frunbtncall;
|
||
function addbtns(btns); //添加菜单
|
||
begin
|
||
FBtns := btns;
|
||
for i,v in Fbtns do
|
||
begin
|
||
v.onClick := thisfunction(Dbgtooldo);
|
||
if v.Caption="添加/删除断点F5" then continue;
|
||
if v.Caption="继续" then
|
||
begin
|
||
v.onClick := thisfunction(dbgtooldorun);
|
||
v.Caption := "调试运行";
|
||
continue;
|
||
end
|
||
v.Visible := false;
|
||
end
|
||
end
|
||
function DbgNextLine(); //下一行
|
||
begin
|
||
ExecuteCommand("dbgstepover");
|
||
end
|
||
function serwnd_cclk(o,e); //取消
|
||
begin
|
||
FRemoteWait := false;
|
||
cancelremotedbg(o,e,"取消调试");
|
||
return;
|
||
end
|
||
function serwnd_oclk(o,e); //远程连接按钮
|
||
begin
|
||
d := fdbgselwnd.GetData();
|
||
addr := d["addr"];
|
||
port := d["port"];
|
||
if not(addr and port)then return MessageboxA("远程服务器信息不全","提示",0,self.Handle);
|
||
port := StrToIntDef(port,443);
|
||
usr := d["usr"];
|
||
pwd := d["pwd"];
|
||
//连接判断
|
||
if checkconnected()then
|
||
begin
|
||
disconnectserver();
|
||
end
|
||
if FDebugtype="remotewait" then //远程等待
|
||
begin
|
||
FDebugaddr := addr;
|
||
FDebugport := port;
|
||
FDebugUsr := usr;
|
||
FDebugPwd := pwd;
|
||
FRemoteWait := true;
|
||
fdbgselwnd.Visible := false;
|
||
return _send_(WM_USER,0,0,1);
|
||
end
|
||
if 0 <> connectserver(addr,port)then return MessageboxA("远程服务器连接失败","提示",0,self.Handle);
|
||
if(usr and pwd)and 0 <> dbglogin(usr,pwd)then
|
||
begin
|
||
return MessageboxA("登陆用户失败","提示",0,self.Handle);
|
||
end
|
||
ExecuteCommand("dbgcreatechannel"); //构造channel
|
||
if FConnectchannel then
|
||
begin
|
||
dbglist(FConnectchannel);
|
||
end
|
||
end
|
||
function dbg_clk(o,e);
|
||
begin
|
||
file := o.getstartfilename(d);
|
||
item := nil;
|
||
if file=0 then //不存在脚本
|
||
begin
|
||
if 1 <> MessageboxA("没找到本地对应的tsl\r\n是否继续调试","提示",1,self.Handle)then
|
||
begin
|
||
return serwnd_cclk();
|
||
end
|
||
end else
|
||
begin
|
||
item := owner.OpenAndGotoFileByName(file,1);
|
||
end
|
||
o.Visible := false;
|
||
FRuningItem := item;
|
||
FCurrentgotoitem := item;
|
||
parsercurrentitem(item);
|
||
FAttchedid := d;
|
||
dbgattach(FConnectchannel,d["id"]);
|
||
//echo tostn(d);
|
||
end
|
||
function Debugremote(flg);
|
||
begin
|
||
{$ifdef linux}
|
||
//return MessageboxA("linux目前不支持调试","提示",0,self.Handle);
|
||
{$endif}
|
||
if FRemoteWait then
|
||
begin
|
||
if flg then
|
||
begin
|
||
if 1=MessageboxA("远程调试等待中...\r\n点击确定停止等待..","提示",1,self.Handle)then
|
||
begin
|
||
FRemoteWait := false;
|
||
disconnectserver();
|
||
end
|
||
return;
|
||
end else
|
||
begin
|
||
return MessageboxA("远程调试等待中...","提示",0,self.Handle);
|
||
end
|
||
end else
|
||
begin
|
||
//if flg then return ;
|
||
if FConnectchannel then
|
||
begin
|
||
//return MessageboxA("正在调试中...","提示",0,self.Handle);
|
||
return debugrunredo();
|
||
end
|
||
end
|
||
if not fdbgselwnd then
|
||
begin
|
||
fdbgselwnd := new tdbgselwnd(self);
|
||
fdbgselwnd.Parent := self;
|
||
fdbgselwnd.FHistoryDir := owner.FHistoryDir;
|
||
fdbgselwnd.loaddata();
|
||
fdbgselwnd.OnClose := thisfunction(serwnd_cclk);
|
||
fdbgselwnd.save_clk := thisfunction(serwnd_oclk);
|
||
fdbgselwnd.cancel_clk := thisfunction(serwnd_cclk);
|
||
fdbgselwnd.dbg_clk := thisfunction(dbg_clk);
|
||
end
|
||
fdbgselwnd.setlist();
|
||
if flg then
|
||
begin
|
||
FDebugtype := "remotewait";
|
||
fdbgselwnd.setattachwait(true);
|
||
end else
|
||
begin
|
||
FDebugtype := "remote";
|
||
fdbgselwnd.setattachwait(false);
|
||
end
|
||
fdbgselwnd.show();
|
||
return;
|
||
end
|
||
function debugrunredo();
|
||
begin
|
||
return dbgtooldorun(nil,nil);
|
||
end
|
||
function Debuglocal(item); //调试脚本
|
||
begin
|
||
{$ifdef linux}
|
||
//return MessageboxA("linux目前不支持调试","提示",0,self.Handle);
|
||
{$endif}
|
||
if not item then return 0;
|
||
if FConnectchannel then
|
||
begin
|
||
return debugrunredo();
|
||
end
|
||
if FRemoteWait then
|
||
begin
|
||
//return MessageboxA("远程调试等待中...","提示",0,self.Handle);
|
||
return debugrunredo();
|
||
end
|
||
FDebugtype := "local";
|
||
if checkconnected()then disconnectserver(); //断开连接
|
||
FAttchedid := 0;
|
||
FDebugport := randomfrom(1 -> 600)+20000;
|
||
FDebugaddr := '127.0.0.1';
|
||
FRuningItem := item;
|
||
FCurrentgotoitem := item;
|
||
parsercurrentitem(item);
|
||
fio := ioFileseparator();
|
||
FDebugUsr := 0;
|
||
FDebugPwd := 0;
|
||
deletefuncacheini();
|
||
////////////////////////////////////////////////////
|
||
getdebuger(pms,pdir);
|
||
if not pdir then pdir := owner.getlibpathstr();
|
||
if not pdir then pdir := "abc;";
|
||
////////////////////////////////////
|
||
if pdir then
|
||
begin
|
||
exestr := format('"%s" "%s" -DEBUGSERVER -DEBUGLOGIN 0 -WAITATTACH -DEBUGPORT %d -libpath "%s" ',FDebugExe,FRuningfile,FDebugport,pdir);
|
||
end else
|
||
begin
|
||
exestr := format('"%s" "%s" -DEBUGSERVER -DEBUGLOGIN 0 -WAITATTACH -DEBUGPORT %d " ',FDebugExe,FRuningfile,FDebugport);
|
||
end
|
||
exestr += pms;
|
||
fremotedbugstart := true;
|
||
fscriptbrks := array();
|
||
{$ifdef linux}
|
||
sp := ioFileseparator();
|
||
for i:= length(FDebugExe) downto 1 do
|
||
begin
|
||
if FDebugExe[i] = sp then
|
||
begin
|
||
exepath := FDebugExe[1:i];
|
||
break;
|
||
end
|
||
end
|
||
npm := array("LD_LIBRARY_PATH=" $ exepath ,getgtkdisplay());
|
||
Sysexecsetenvs(npm,0);
|
||
exestr := ParserCommandLine(exestr);
|
||
{$endif}
|
||
h := fdebugproc.CreateProcess(nil,exestr);
|
||
if h then
|
||
begin
|
||
ExecuteCommand("dbgcreatechannel");
|
||
ExecuteCommand("showstr","调试程序:"+FDebugExe);
|
||
if ifarray(exestr) then exestr := array2str(exestr," ");
|
||
ExecuteCommand("showstr","调试命令行:"+exestr);
|
||
if FConnectchannel then
|
||
begin
|
||
dbgattachwait(FConnectchannel);
|
||
end
|
||
end
|
||
end
|
||
|
||
function wmuser(o,e):WM_USER;virtual;
|
||
begin
|
||
if FRemoteWait and not(checkconnected())then
|
||
begin
|
||
if(0 <> connectserver(FDebugaddr,FDebugport))then
|
||
begin
|
||
FRemoteWait := false;
|
||
messageboxa("连接服务器失败","错误",0,self);
|
||
return;
|
||
//sleep(100);
|
||
//_send_(WM_USER,0,0,1);
|
||
end else
|
||
begin
|
||
FRemoteWait := false;
|
||
FConnectchannel := dbgcreatechannel();
|
||
setgdbcallback();
|
||
if(FDebugUsr and FDebugPwd)and(0 <>(lgg := dbglogin(FDebugUsr,FDebugPwd)))then
|
||
begin
|
||
messageboxa("登陆失败\r\n用户名或者密码错误","登陆失败",0,self);
|
||
return disconnectserver();
|
||
end
|
||
dbgattachwait(FConnectchannel);
|
||
FBtns["终止"].Visible := true;
|
||
end
|
||
end
|
||
end
|
||
function Create(AOwner);
|
||
begin
|
||
inherited;
|
||
init_item_height := 30;
|
||
fscriptbrks := array();
|
||
//Frundirect := false;
|
||
FCmdHistory := array();
|
||
FCmdHistoryid := 0;
|
||
FCmdHistorycount := 10;
|
||
FDebugExe := "";
|
||
Caption := "tsl debug ...";
|
||
dbwnd := new tdbgwnd(self);
|
||
dbwnd.Align := alClient;
|
||
dbwnd.Parent := self;
|
||
FStackList := new TListView(self); // new TListBox(self); //new tmemo(self);//
|
||
FStackList.ItemHeight := init_item_height;
|
||
FStackList.Columns := array(("text":"line","width":80),
|
||
("text":"function","width":250) //,("text":"type","width":70)
|
||
);
|
||
FStackList.Border := true;
|
||
FVaraiblesList := new TGroupGridA(self);
|
||
FVaraiblesList.Border := false;
|
||
FVaraiblesList.ItemHeight := init_item_height;
|
||
FVaraiblesList.Columns := array(("text":"name","width":105),
|
||
("text":"value","width":135),
|
||
("text":"type","width":80)
|
||
);
|
||
FCommandtext := new TEdit(self);
|
||
FCommandtext.autosize := true;
|
||
FCommandtext.placeholder := "命令输入框";
|
||
FCommandtext.Height := init_item_height;
|
||
FCommandtext.onkeyup := thisfunction(cmdkeyup);
|
||
FShowText := new tmemo(self);
|
||
FShowText.ReadOnly := true;
|
||
FShowText.Border := true;
|
||
pmenu := new TPopUpMenu(self);
|
||
cmu := new TMenu(self);
|
||
cmu2 := new TMenu(self);
|
||
cmu.OnClick := function(o,e)
|
||
begin
|
||
FShowText.Text := "";
|
||
end;
|
||
cmu.Caption := "清除";
|
||
cmu2.Caption := "复制";
|
||
cmu.Parent := pmenu;
|
||
cmu2.Parent := pmenu;
|
||
cmu2.onClick := function(o,e)
|
||
begin
|
||
FShowText.ExecuteCommand(FShowText.ecCopy);
|
||
end
|
||
FShowText.PopUpMenu := pmenu;
|
||
dbwnd.addwnds(FStackList,FVaraiblesList,FCommandtext,FShowText);
|
||
ExecuteCommand("clearall");
|
||
getdefaultdbger();
|
||
frunbtncall := function(o,e)begin
|
||
|
||
ow := owner;
|
||
if ow then
|
||
begin
|
||
ow.DebugPageItem(ow.GetCurrentItem());
|
||
end
|
||
end
|
||
fdebugproc := new tcustomprocess(self);
|
||
fdebugproc.onended := function(o,e)
|
||
begin
|
||
toolbtnState("停止");
|
||
end
|
||
fdebugproc.OnEcho := function();
|
||
begin
|
||
return 1;
|
||
end
|
||
onnotification := function(o,e)begin
|
||
if not (FStackList and FVaraiblesList) then return ;
|
||
ms := e.message;
|
||
if ifarray(ms) and ms[0] ="font" then
|
||
begin
|
||
ft := ms[1];
|
||
FStackList.font := ft;
|
||
FStackList.ItemHeight := ft["height"]+6;
|
||
FVaraiblesList.font := ft;
|
||
FVaraiblesList.ItemHeight := ft["height"]+6;
|
||
//font := ms[1];
|
||
end
|
||
end
|
||
|
||
end
|
||
function addbreak(item,idx,n); //添加断点
|
||
begin
|
||
if not FConnectchannel then return;
|
||
parseriteminfo(item,idx,n,usr);
|
||
if n then
|
||
begin
|
||
//echo "\r\n====add:",usr,"====",n,"===",idx;
|
||
//echo "\r\n>>",(idx+1)," ",item.ScriptPath;
|
||
dbgsetbreak(FConnectchannel,usr,n,idx+1);
|
||
end
|
||
end
|
||
function removebreak(item,idx); //移除断点
|
||
begin
|
||
if not FConnectchannel then return;
|
||
parseriteminfo(item,idx,n,usr);
|
||
if n then
|
||
begin
|
||
//echo "\r\n====remove:",usr,"====",n,"===",idx;
|
||
dbgunsetbreak(FConnectchannel,usr,n,idx+1);
|
||
end
|
||
end
|
||
function GetWindowHandleByPID(pid,api) //通过进程ID获取窗口句柄
|
||
begin
|
||
{$ifdef linux}
|
||
return 0;
|
||
{$endif}
|
||
dwProcessID := _wapi.GetProcessId(pid);
|
||
h := api.GetTopWindow(0);
|
||
while(h) do
|
||
begin
|
||
pid := 0;
|
||
dwTheardId := api.GetWindowThreadProcessId(h,pid);
|
||
if(dwTheardId <> 0) and (pid=dwProcessID) then
|
||
begin
|
||
//while(api.GetParent(h)<> 0) do h := api.GetParent(h); // 原有的处理方式找到最上层
|
||
cni := 100;
|
||
cn := "";setlength(cn,cni);
|
||
cno := api.GetClassNameA(h,cn,cni);
|
||
if cno >1 then
|
||
begin
|
||
cn := cn[1:cni];
|
||
if pos("tsui_application",cn) then return h;
|
||
end
|
||
end
|
||
h := api.GetNextWindow(h,2);
|
||
end
|
||
return 0;
|
||
end
|
||
function dbgtooldorun(o,e);
|
||
begin
|
||
if not(FConnectchannel or FRemoteWait) then
|
||
begin
|
||
return CallMessgeFunction(frunbtncall,nil,nil);
|
||
end
|
||
//if not( FBtns["终止"].Visible) then return ;
|
||
toolbtnState("继续");
|
||
if FCurrentgotoitem and FCurrentgotoitem.FEditer then FCurrentgotoitem.FEditer.ExecuteCommand("ecruningto",nil);
|
||
ExecuteCommand("dbgrun");
|
||
Fdebugedwhandle := GetWindowHandleByPID(fdebugproc.Handle,_wapi);
|
||
if Fdebugedwhandle then
|
||
begin
|
||
_wapi.SetForegroundWindow(Fdebugedwhandle);
|
||
end
|
||
end
|
||
function Dbgtooldo(o,e)
|
||
begin
|
||
cp := o.Caption;
|
||
case cp of
|
||
"调试运行":
|
||
begin
|
||
//echo "调试运行";
|
||
it := Owner.GetCurrentItem(); //Owner.GetAllPageItems();
|
||
Debuglocal(it);
|
||
end
|
||
"添加/删除断点F5":
|
||
begin
|
||
it := Owner.GetCurrentItem();
|
||
if it then
|
||
begin
|
||
it.FEditer.SwitchMarkLine();
|
||
end
|
||
end
|
||
"暂停":
|
||
begin
|
||
ExecuteCommand("dbgpause");
|
||
if Fdebugedwhandle then
|
||
begin
|
||
_Wapi.postmessagea(Fdebugedwhandle,WM_NULL,0,0);
|
||
end
|
||
end
|
||
"进入":
|
||
begin
|
||
ExecuteCommand("dbgstep")
|
||
end
|
||
"单步":
|
||
begin
|
||
//dbgstep();
|
||
end
|
||
"下一行(F8)":
|
||
begin
|
||
ExecuteCommand("dbgstepover");
|
||
end
|
||
"跳出":
|
||
begin
|
||
ExecuteCommand("dbgstepout");
|
||
end
|
||
"继续":
|
||
begin
|
||
dbgtooldorun(o,e);
|
||
end
|
||
"终止":
|
||
begin
|
||
ExecuteCommand("dbgreset");
|
||
end
|
||
"单步":
|
||
begin
|
||
end
|
||
"刷新符号表":
|
||
begin
|
||
ExecuteCommand("dbggetallvalue");
|
||
end
|
||
"刷新当前符号":
|
||
begin
|
||
ExecuteCommand("dbggetcurrentnode");
|
||
end
|
||
"清除文本框":
|
||
begin
|
||
FShowText.Text := "";
|
||
end
|
||
end;
|
||
end
|
||
function dbgeventcall(d); //回调
|
||
begin
|
||
global g_tsldbgcallback_handle;
|
||
if not ifarray(d)then return;
|
||
if d["channel"]<> FConnectchannel then return;
|
||
recvtype := d["recvtype"];
|
||
if recvtype=0 then
|
||
begin
|
||
FRemoteWait := 0;
|
||
ExecuteCommand("showstr","\r\n调试结束");
|
||
if FConnectchannel then dbgdeletechannel(FConnectchannel);
|
||
FConnectchannel := 0;
|
||
g_tsldbgcallback_handle := nil;
|
||
if FCurrentgotoitem and FCurrentgotoitem.FEditer then FCurrentgotoitem.FEditer.ExecuteCommand("ecruningto",nil);
|
||
Fdebugedwhandle := 0;
|
||
toolbtnState("停止");
|
||
return;
|
||
end
|
||
//echo "\r\nrectype",format("0x%x",recvtype);
|
||
if 0x0401=recvtype then
|
||
begin
|
||
//owner.echoAppendString(d["errmsg"]);
|
||
//ExecuteCommand("showeval",d["errmsg"]);
|
||
ExecuteCommand("echo",d["errmsg"]);
|
||
return;
|
||
end
|
||
if recvtype <> 0x402 then
|
||
begin
|
||
return;
|
||
end
|
||
case magicgetarray(d,array("result","CmdType"))of
|
||
//"ErrorReport": array("result","CmdText")
|
||
"attachlist":
|
||
begin
|
||
r := magicgetarray(d,array("result","CmdData"));
|
||
r ::
|
||
begin
|
||
if mcol="createtm" then
|
||
begin
|
||
mcell := datetimetostr(mcell);
|
||
end
|
||
end
|
||
return fdbgselwnd.setlist(r);
|
||
//return echo tostn(r);
|
||
end
|
||
"attachwaitok","attachok": // 连接,默认
|
||
begin
|
||
debuginitok();
|
||
FVaraiblesList.SetNodeData(array());
|
||
FStackList.DeleteAllItems();
|
||
return;
|
||
end
|
||
"DebugInfo": //调试信息
|
||
begin
|
||
if "dbgdetach"=remotewaitinit(d)then return;
|
||
stk := magicgetarray(d,array("result","CmdData","CallStack")); //深度
|
||
if fremotedbugstart then
|
||
begin
|
||
fremotedbugstart := false;
|
||
if ifnil(fscriptbrks[stk[0,"LINE"]-1]) then
|
||
begin
|
||
return debugrunredo();
|
||
end
|
||
end
|
||
sybs := magicgetarray(d,array("result","CmdData","SymbolInfo")); //符号
|
||
ssybs := magicgetarray(d,array("result","CmdData","EnvInfo")); //系统参数
|
||
toolbtnState("暂停");
|
||
{if (ssybs = Fdbgssybs) and (sybs = Fdbgsybs) and (stk=Fdbgstack) then //值没变
|
||
begin
|
||
return ;
|
||
end }
|
||
if(ssybs <> Fdbgssybs)or(sybs <> Fdbgsybs)then
|
||
begin
|
||
FVaraiblesList.SetNodeData(array());
|
||
ddd := formatsysvlist(ssybs,nil);
|
||
FVaraiblesList.SetNodeData(ddd,true);
|
||
Fdbgssybs := ssybs;
|
||
ddd := formatvlist(sybs);
|
||
FVaraiblesList.SetNodeData(ddd,true);
|
||
Fdbgsybs := sybs;
|
||
end
|
||
if stk <> Fdbgstack then
|
||
begin
|
||
FStackList.DeleteAllItems();
|
||
FStackList.appendItems(stk[:,array("LINE","NAME","USER")]);
|
||
//FStackList.text := array2str(stks,"\r\n");
|
||
Fdbgstack := stk;
|
||
end
|
||
if ifarray(stk)then
|
||
begin
|
||
FVaraiblesList.celldbclk := thisfunction(vdbclk);
|
||
FVaraiblesList.celledit := thisfunction(vdoedit);
|
||
FVaraiblesList.Showarray := thisfunction(vdoshowarray);
|
||
FStackList.OnDblClick := thisfunction(stkdbclk);
|
||
it := opengoto(stk[0]);
|
||
//if not it then return;
|
||
if it and it <> FCurrentgotoitem then
|
||
begin
|
||
if FCurrentgotoitem and FCurrentgotoitem.FEditer then
|
||
begin
|
||
FCurrentgotoitem.FEditer.ExecuteCommand("ecruningto",nil);
|
||
end
|
||
FCurrentgotoitem := it;
|
||
end
|
||
if FCurrentgotoitem then
|
||
begin
|
||
FCurrentgotoitem.FEditer.ExecuteCommand("ecruningto",stk[0,"LINE"]-1);
|
||
end
|
||
end
|
||
_wapi.ForegroundWindow(geteditorhandle());
|
||
return;
|
||
end
|
||
"detached":
|
||
begin
|
||
if FConnectchannel then
|
||
begin
|
||
dbgdeletechannel(FConnectchannel);
|
||
FConnectchannel := 0;
|
||
g_tsldbgcallback_handle := nil;
|
||
FAttchedid := 0;
|
||
end
|
||
FRemoteWait := 0;
|
||
if FCurrentgotoitem and FCurrentgotoitem.FEditer then FCurrentgotoitem.FEditer.ExecuteCommand("ecruningto",nil);
|
||
ExecuteCommand("showstr","\r\n调试结束");
|
||
toolbtnState("停止");
|
||
return;
|
||
end
|
||
"DebugSysParamValue":
|
||
begin
|
||
CmdTypeAux := magicgetarray(d,array("result","CmdTypeAux"));
|
||
ev := magicgetarray(d,array("result","CmdData"));
|
||
cp := magicgetarray(d,array("result","CmdParam"));
|
||
len :=-1;
|
||
if ifnumber(CmdTypeAux)and(CmdTypeAux .& 0x80000000)then
|
||
begin
|
||
len := _shr((int(CmdTypeAux).& 0xFFF0),4);
|
||
end
|
||
//echo "\r\n***",len," ",cp," ",tostn(ev);
|
||
if(cp="#DebugEval")or(cp="#Error")then
|
||
begin
|
||
return showevaldata(nil,ev);
|
||
end
|
||
if ifarray(ev)then
|
||
begin
|
||
ddd := formatsysvlist(array(cp:ev),len);
|
||
FVaraiblesList.SetNodeData(ddd,true);
|
||
for i,v in ev do
|
||
begin
|
||
if ifstring(i)then
|
||
begin
|
||
ncp := tostn(i);
|
||
ncp := replacetext(ncp,".","\\o");
|
||
ncp := cp+".["+ncp+"]";
|
||
end else
|
||
begin
|
||
ncp := cp+".["+tostn(i)+"]";
|
||
end
|
||
magicsetarray(d,array("result","CmdParam"),ncp);
|
||
magicsetarray(d,array("result","CmdData"),v);
|
||
dbgeventcall(d);
|
||
end
|
||
return;
|
||
end else
|
||
begin
|
||
ddd := formatsysvlist(array(cp:ev),len);
|
||
FVaraiblesList.SetNodeData(ddd,true);
|
||
end
|
||
end
|
||
"DebugValue":
|
||
begin
|
||
cp := magicgetarray(d,array("result","CmdParam"));
|
||
ev := magicgetarray(d,array("result","CmdData"));
|
||
if(cp="#DebugEval")or(cp="#Error")then
|
||
begin
|
||
return showevaldata(nil,ev);
|
||
end
|
||
if ifarray(ev)then
|
||
begin
|
||
//showevaldata(cp,ev);
|
||
ddd := formatvlist(array(cp:ev));
|
||
FVaraiblesList.SetNodeData(ddd,true);
|
||
for i,v in ev do
|
||
begin
|
||
if ifstring(i)then
|
||
begin
|
||
ncp := tostn(i);
|
||
ncp := replacetext(ncp,".","\\o");
|
||
ncp := cp+".["+ncp+"]";
|
||
end else
|
||
begin
|
||
ncp := cp+".["+tostn(i)+"]";
|
||
end
|
||
magicsetarray(d,array("result","CmdParam"),ncp);
|
||
magicsetarray(d,array("result","CmdData"),v);
|
||
dbgeventcall(d);
|
||
end
|
||
return;
|
||
end else
|
||
begin
|
||
ddd := formatvlist(array(cp:ev));
|
||
FVaraiblesList.SetNodeData(ddd,true);
|
||
end
|
||
end
|
||
"noattachederror":
|
||
begin
|
||
return disconnectserver();
|
||
FRemoteWait := 0;
|
||
ExecuteCommand("showeval","noattachederror");
|
||
d["recvtype"]:= 0; //退出
|
||
dbgeventcall(d);
|
||
return;
|
||
end else
|
||
begin
|
||
//echo tostn(d);
|
||
end
|
||
end
|
||
return;
|
||
end
|
||
function showevaldata(cp_,ev);
|
||
begin
|
||
cp := cp_;
|
||
if cp then
|
||
begin
|
||
if parseregexpr("\\(\\w+\\)\\.",cp,"r", function(a)
|
||
begin
|
||
return "";
|
||
end
|
||
,s)=1 then
|
||
begin
|
||
cp := s;
|
||
end
|
||
end
|
||
if ev and ifarray(ev)then
|
||
begin
|
||
fwnd := getvalewnd(cp);
|
||
fwnd.TSLdata := ev;
|
||
fwnd.Show();
|
||
end else
|
||
begin
|
||
if cp then FShowText.Text += ">>"+cp+"\r\n";
|
||
ExecuteCommand("showeval",ev);
|
||
end
|
||
end
|
||
function ExecuteCommand(cmd,p);override;
|
||
begin
|
||
case cmd of
|
||
"dbgstate":
|
||
begin
|
||
if ifnil(p)then return FdebugState;
|
||
end
|
||
"execommand":
|
||
begin
|
||
case p of
|
||
"#127":
|
||
begin
|
||
FShowText.Text := "";
|
||
end
|
||
end;
|
||
end
|
||
"docmd":
|
||
begin
|
||
s := FCommandtext.Text;
|
||
if not s then return;
|
||
FCommandtext.Text := "";
|
||
if s="#cls" then return ExecuteCommand("execommand",s);
|
||
FShowText.Text += ">>"+s+"\r\n";
|
||
ExecuteCommand("dbgeval",s);
|
||
end
|
||
"clearall": //清除所有
|
||
begin
|
||
//FStackList.items := array();
|
||
//FStackList.text := "";
|
||
FStackList.DeleteAllItems();
|
||
FVaraiblesList.SetNodeData(array());
|
||
if p then
|
||
begin
|
||
FShowText.Text := "";
|
||
FCommandtext.Text := "";
|
||
end
|
||
end
|
||
"showstr":
|
||
begin
|
||
FShowText.Text += (ifstring(p)?p:tostn(p)) +"\r\n";
|
||
end
|
||
"showeval":
|
||
begin
|
||
FShowText.Text += "ans="+tostn(p)+"\r\n";
|
||
FShowText.ExecuteCommand(FShowText.ecGotoXY,array(100000,1));
|
||
end
|
||
"echo" :
|
||
begin
|
||
if ifstring(p) then
|
||
begin
|
||
FShowText.Text += p;
|
||
Ls := FShowText.Lines;
|
||
FShowText.ExecuteCommand(FShowText.ecGotoXY,array(ls.length(),10000000));
|
||
end
|
||
end
|
||
"dbgcreatechannel":
|
||
begin
|
||
if not FConnectchannel then
|
||
begin
|
||
idx := 0;
|
||
if not checkconnected()then
|
||
begin
|
||
while(FDebugtype="local")and(0 <> connectserver(FDebugaddr,FDebugport)) do
|
||
begin
|
||
sleep(100);
|
||
idx++;
|
||
if idx>20 then
|
||
begin
|
||
return ExecuteCommand("debugconnecterr");
|
||
end;
|
||
end
|
||
end
|
||
FConnectchannel := dbgcreatechannel();
|
||
setgdbcallback();
|
||
end
|
||
end
|
||
"dbggetallvalue":
|
||
begin
|
||
if FConnectchannel then
|
||
begin
|
||
dbggetallvalue(FConnectchannel);
|
||
end
|
||
end
|
||
"dbggetcurrentnode":
|
||
begin
|
||
FVaraiblesList.getcurrentnodedata();
|
||
end
|
||
"dbgreset": //停止
|
||
begin
|
||
if FConnectchannel then
|
||
begin
|
||
if fdebugproc.Handle then
|
||
begin
|
||
|
||
//cd := {$ifdef linux} 1 {$else} -1 {$endif} ;
|
||
fdebugproc.terminate(1);
|
||
end
|
||
if FAttchedid then
|
||
begin
|
||
//echo "\r\n终止";
|
||
return dbgdetach(FConnectchannel);
|
||
end else
|
||
begin
|
||
if FDebugtype="remotewait" then //远程,断开连接
|
||
begin
|
||
return disconnectserver();
|
||
end
|
||
return dbgdetach(FConnectchannel);
|
||
//return dbgreset(FConnectchannel);
|
||
end
|
||
end
|
||
end
|
||
"dbgrun": //运行
|
||
begin
|
||
if FConnectchannel then dbgrun(FConnectchannel);
|
||
end
|
||
"dbgstep":
|
||
begin
|
||
if FConnectchannel then dbgstep(FConnectchannel);
|
||
end
|
||
"dbgpause": //暂停
|
||
begin
|
||
if FConnectchannel then dbgpause(FConnectchannel);
|
||
end
|
||
"dbgstepover": //下一行
|
||
begin
|
||
if FConnectchannel then dbgstepover(FConnectchannel);
|
||
end
|
||
"dbgstepout": //跳出函数
|
||
begin
|
||
if FConnectchannel then dbgstepout(FConnectchannel);
|
||
end
|
||
"dbgeval": //执行
|
||
begin
|
||
if FConnectchannel then
|
||
begin
|
||
if p and ifstring(p) then
|
||
begin
|
||
getvalewnd("ans");
|
||
dbgeval(FConnectchannel,p);
|
||
end
|
||
end else
|
||
begin
|
||
FShowText.Text +="非调试状态!";
|
||
end
|
||
end
|
||
end
|
||
end
|
||
function Recycling();override;
|
||
begin
|
||
global g_tsldbgcallback_handle;
|
||
stopdebug();
|
||
inherited;
|
||
FStackList := nil;
|
||
FVaraiblesList := nil;
|
||
FToolbar := nil;
|
||
FCommandtext := nil;
|
||
FShowText := nil;
|
||
fimgelist := nil;
|
||
FBtns := nil;
|
||
g_tsldbgcallback_handle := nil;
|
||
fdbgselwnd := nil;
|
||
frunbtncall := nil;
|
||
end
|
||
//property rundirect read Frundirect write Frundirect;
|
||
private
|
||
function geteditorhandle();
|
||
begin
|
||
if not fpopediterhandle then
|
||
begin
|
||
o := Owner;
|
||
while o do
|
||
begin
|
||
if o.WSpOPUp then
|
||
begin
|
||
fpopediterhandle := o.Handle;
|
||
break;
|
||
end
|
||
o :=o.parent;
|
||
end
|
||
end
|
||
return fpopediterhandle;
|
||
end
|
||
function getgtkdisplay(); //去掉try
|
||
begin
|
||
dsp := Sysgetenv("DISPLAY");
|
||
if dsp="" then dsp := ":0";
|
||
if not ifstring(dsp) then dsp := ":0";
|
||
return "DISPLAY="+dsp;
|
||
end
|
||
function getdefaultdbger();
|
||
begin
|
||
fdefaultdbger := gettslexefullpath();
|
||
end
|
||
function getdebuger(pms,pdir); //获得调试程序
|
||
begin
|
||
p := static pluginpath();
|
||
global g_debug_chooser;
|
||
if g_debug_chooser="当前执行程序" then
|
||
begin
|
||
FDebugExe := "1";
|
||
end else
|
||
begin
|
||
FDebugExe := inireadstring("",p+"localediter.ini","debug","debuger","");
|
||
if not ifstring(FDebugExe) then FDebugExe := "";
|
||
end
|
||
pms := " ";
|
||
ps := owner.getexecuteparams(FRuningfile);
|
||
if ps then
|
||
begin
|
||
psi := ps[0];
|
||
if ifstring(psi) and psi and fileexists("",psi)then
|
||
begin
|
||
cmdexe := psi;
|
||
end else
|
||
begin
|
||
if FDebugExe="1" then
|
||
ExecuteCommand("showstr","当前指定的执行程序不存在!!");
|
||
end
|
||
psi := ps[1];
|
||
if psi and ifstring(psi) and fileexists("",psi)then
|
||
begin
|
||
end else
|
||
begin
|
||
pms += " "+tostn(psi);
|
||
end
|
||
idx := 2;
|
||
while idx<length(ps) do
|
||
begin
|
||
psi := ps[idx];
|
||
if lowercase(psi)="-libpath" then //屏蔽此处，让debug和运行的参数保持一致
|
||
begin
|
||
pdir :=ps[idx+1];
|
||
idx += 2;
|
||
continue;
|
||
end
|
||
pms += " "+tostn(psi);
|
||
idx++;
|
||
end
|
||
end
|
||
if(FDebugExe="1")and cmdexe then
|
||
begin
|
||
FDebugExe := cmdexe;
|
||
ExecuteCommand("showstr","<当前执行程序(F9)做调试器>");
|
||
end else
|
||
if FDebugExe and ifstring(FDebugExe) and fileexists("",FDebugExe)then
|
||
begin
|
||
ExecuteCommand("showstr","<用配置文件给定的调试器>");
|
||
end else
|
||
begin
|
||
FDebugExe := fdefaultdbger;
|
||
ExecuteCommand("showstr","<用编辑器自带的调试器b:>");
|
||
end
|
||
end
|
||
function remotedbugok();
|
||
begin
|
||
if FAttchedid then
|
||
begin
|
||
ExecuteCommand("showstr","远程启动脚本:"+FAttchedid["info"]);
|
||
end
|
||
end
|
||
function remotewaitinit(d);
|
||
begin
|
||
if FDebugtype <> "remotewait" then return;
|
||
if FAttchedid then return;
|
||
FAttchedid := magicgetarray(d,array("result","CmdData","StartInfo"));
|
||
file := fdbgselwnd.getstartfilename(FAttchedid);
|
||
item := nil;
|
||
if file=0 then //不存在脚本
|
||
begin
|
||
if 1 <> MessageboxA("没找到本地对应的tsl\r\n是否继续调试","提示",1,self.Handle)then
|
||
begin
|
||
dbgdetach(FConnectchannel);
|
||
return "dbgdetach";
|
||
//return serwnd_cclk();
|
||
end
|
||
end else
|
||
begin
|
||
item := owner.OpenAndGotoFileByName(file,1);
|
||
end
|
||
FRuningItem := item;
|
||
FCurrentgotoitem := item;
|
||
parsercurrentitem(item);
|
||
setbrks(); //设置断点
|
||
remotedbugok();
|
||
end
|
||
function debuginitok();
|
||
begin
|
||
if FDebugtype <> "remotewait" then setbrks(); //设置断点
|
||
//showbtns(); //显示按钮
|
||
ExecuteCommand("showstr","开始调试");
|
||
//toolbtnState("暂停");
|
||
remotedbugok();
|
||
return;
|
||
end
|
||
function opengoto(v);
|
||
begin
|
||
cn := v["NAME"];
|
||
cnn := "";
|
||
for ii := 1 to length(cn) do
|
||
begin
|
||
cni := cn[ii];
|
||
if (cni = ".") or (cni = ":")then
|
||
begin
|
||
cn := cnn;
|
||
break;
|
||
end
|
||
cnn += cni;
|
||
end
|
||
f := FDebugtsfs[lowercase(cn)];
|
||
if not f then
|
||
begin
|
||
return ExecuteCommand("showeval","找不到代码:"+cn);
|
||
end
|
||
it := owner.OpenAndGotoFileByName(f,v["LINE"]);
|
||
return it;
|
||
end
|
||
function cancelremotedbg(o,e,s);
|
||
begin
|
||
fdbgselwnd.Visible := false;
|
||
if e then e.skip := true;
|
||
if FConnectchannel then dbgdeletechannel(FConnectchannel);
|
||
FConnectchannel := 0;
|
||
ExecuteCommand("showstr",ifstring(s)?s:"取消远程调试...");
|
||
end
|
||
function stkdbclk(o,e);
|
||
begin
|
||
//echo "\r\n",o.SelectedId;
|
||
id := o.SelectedId;
|
||
if id >= 0 then
|
||
begin
|
||
d := o.GetItem(id);
|
||
if d then
|
||
begin
|
||
return opengoto(d);
|
||
end
|
||
end
|
||
end
|
||
function vdoshowarray(d);
|
||
begin
|
||
//echo tostn(d);
|
||
try
|
||
gp := d[3];
|
||
if(gp[length(gp)]="+")and parseregexpr("\\+$",gp,"r", function(a)
|
||
begin
|
||
return "";
|
||
end
|
||
,sgp)=1 then
|
||
begin
|
||
gp := "sysparams:"+sgp;
|
||
end
|
||
showevaldata(gp,d[1]["value"]);
|
||
except
|
||
end;
|
||
end
|
||
function vdoedit(d,s);
|
||
begin
|
||
if not FConnectchannel then return;
|
||
gp := d[1][3];
|
||
try
|
||
v := eval(&s);
|
||
except
|
||
v := nil;
|
||
end
|
||
if(gp[length(gp)]="+")and parseregexpr("\\+$",gp,"r", function(a)
|
||
begin
|
||
return "";
|
||
end
|
||
,sgp)=1 then
|
||
begin
|
||
dbgsetvalue(FConnectchannel,sgp,d[1][5],v);
|
||
sleep(20);
|
||
dbggetvalue(FConnectchannel,sgp,d[1][5]);
|
||
end else
|
||
begin
|
||
//echo "\r\nset: ",gp," ",v;
|
||
dbgsetvalue(FConnectchannel,gp,0,v);
|
||
sleep(20);
|
||
dbggetvalue(FConnectchannel,gp,0);
|
||
end
|
||
end
|
||
function vdbclk(o,e);
|
||
begin
|
||
if not FConnectchannel then return;
|
||
if(e[0]=1)and(e[1][2]="*")then
|
||
begin
|
||
gp := e[1][3];
|
||
if gp="sysparams+" then return;
|
||
if(gp[length(gp)]="+")and parseregexpr("\\+$",gp,"r", function(a)
|
||
begin
|
||
return "";
|
||
end
|
||
,sgp)=1 then
|
||
begin
|
||
dbggetvalue(FConnectchannel,sgp,e[1][5]);
|
||
end else
|
||
begin
|
||
dbggetvalue(FConnectchannel,gp,0);
|
||
end
|
||
end
|
||
end
|
||
function parsercurrentitem(item); //修正本地函数
|
||
begin
|
||
FDebugtsfs := class(TTSLCompletion).getdirtsfs();
|
||
if item then
|
||
begin
|
||
FRuningfile := item.OrigScriptPath; // %% E:\TSUIGROUP\script\tgdb.tsl%%;
|
||
FDebugtsfs["__main__"]:= FRuningfile;
|
||
ls := item.FEditer.lines;
|
||
d := unit(utssvr_api_c).get_tsl_tokenizeex(item.FEditer.Text,0xffff);//tsl_tokenizeex_2_(item.FEditer.Text,0xffff);
|
||
for i,v in d["blcks"] do
|
||
begin
|
||
s := ls.GetStringByIndex(v["mbeg"]-1);
|
||
ctls := 0;
|
||
case v["mtype"]of //函数
|
||
11:
|
||
begin
|
||
ctls := "function\\s+(\\w+)\\(";
|
||
end
|
||
3:
|
||
begin
|
||
ctls := "type\\s+(\\w+)\\s*=\\s*class" //类
|
||
end
|
||
end;
|
||
if s and ctls and(parseregexpr(ctls,s,"si",m,mp,ml)=1)then
|
||
begin
|
||
n := lowercase(m[0,1]);
|
||
FDebugtsfs[n]:= FRuningfile;
|
||
end
|
||
end
|
||
end
|
||
end
|
||
function toolbtnState(flg);
|
||
begin
|
||
case flg of
|
||
"启动","暂停":
|
||
begin
|
||
showbtns();
|
||
FBtns["暂停"].Visible := false;
|
||
FBtns["刷新符号表"].Visible := true;
|
||
FBtns["刷新当前符号"].Visible := true;
|
||
FBtns["继续"].Visible := (flg = "暂停") ;
|
||
//FBtns["终止"].Visible := true;
|
||
end
|
||
"继续":
|
||
begin
|
||
//运行
|
||
//FBtns["继续"].Visible := false;
|
||
FBtns["进入"].Visible := false;
|
||
FBtns["跳出"].Visible := false;
|
||
FBtns["下一行(F8)"].Visible := false;
|
||
//FBtns["单步"].Visible := false;
|
||
FBtns["终止"].Visible := true;
|
||
FBtns["暂停"].Visible := true;
|
||
FBtns["刷新符号表"].Visible := false;
|
||
FBtns["刷新当前符号"].Visible := false;
|
||
FBtns["继续"].Visible := false;
|
||
end
|
||
"停止":
|
||
begin
|
||
hiddenbtns();
|
||
FBtns["继续"].Visible := true;
|
||
end
|
||
end
|
||
end
|
||
function showbtns(); //显示
|
||
begin
|
||
for i,v in FBtns do
|
||
begin
|
||
V.Visible := true;
|
||
end
|
||
//FToolbar.Visible := true;
|
||
end
|
||
function hiddenbtns(); //隐藏
|
||
begin
|
||
for i,v in FBtns do
|
||
begin
|
||
if i="添加/删除断点F5" then continue;
|
||
if i="继续" then continue;
|
||
v.Visible := false;
|
||
end
|
||
//FToolbar.Visible := false;
|
||
end
|
||
function stopdebug(); //结束进程
|
||
begin
|
||
if fdebugproc.Handle then
|
||
begin
|
||
fdebugproc.terminate(1);
|
||
Fdebugedwhandle := 0;
|
||
end
|
||
end
|
||
function parseriteminfo(item,idx,n,usr);
|
||
begin
|
||
if item=FRuningItem then
|
||
begin
|
||
usr := "local";
|
||
n := "__main__";
|
||
end else
|
||
begin
|
||
usr := "system";
|
||
end
|
||
if not n then
|
||
begin
|
||
n := getscriptname(item.OrigScriptPath);
|
||
end
|
||
end
|
||
function getscriptname(nn);
|
||
begin
|
||
fio := ioFileseparator();
|
||
n := "";
|
||
for i := Length(nn)-1 downto 1 do
|
||
begin
|
||
if fio=nn[i]then
|
||
begin
|
||
n := nn[i+1:];
|
||
idx := pos(".",n);
|
||
if idx then
|
||
begin
|
||
n := lowercase(n[1:idx-1]);
|
||
end
|
||
break;
|
||
end
|
||
end
|
||
return n;
|
||
end
|
||
function setbrks(); //初次添加断点
|
||
begin
|
||
its := owner.GetAllPageItems().data;
|
||
for i,v in FDebugtsfs do
|
||
begin
|
||
delii :=-1;
|
||
for ii,vv in its do
|
||
begin
|
||
ifok := vv.ScriptPathIs(v);
|
||
if ifok then
|
||
begin
|
||
delii := ii;
|
||
lines := vv.FEditer.Lines;
|
||
for idx := 0 to Lines.Length()-1 do
|
||
begin
|
||
if Lines[idx].FMarked then addbreak(vv,idx,i);
|
||
end
|
||
break;
|
||
end
|
||
end
|
||
if delii <> 0 then
|
||
begin
|
||
reindex(its,array(delii:nil));
|
||
end
|
||
end
|
||
if FRuningItem then
|
||
begin
|
||
lines := FRuningItem.FEditer.Lines;
|
||
for idx := 0 to Lines.Length()-1 do
|
||
begin
|
||
if Lines[idx].FMarked then
|
||
begin
|
||
addbreak(FRuningItem,idx,"__main__");
|
||
fscriptbrks[idx]:= true;
|
||
end
|
||
end
|
||
end
|
||
end
|
||
function setgdbcallback(); //设置回调
|
||
begin
|
||
global g_tsldbgcallback_handle;
|
||
g_tsldbgcallback_handle := thisfunction(dbgeventcall);
|
||
dbgsetcallback(FConnectchannel,"return unit(utslvcldebuger).tdbgcallback();");
|
||
end
|
||
function formatvlist(d);
|
||
begin
|
||
r := array();
|
||
ncs := array();
|
||
idx := 0;
|
||
for i,v in d do
|
||
begin
|
||
ri := parservname(i,v);
|
||
for j,vj in ri do
|
||
begin
|
||
id := vj["n"];
|
||
if ncs[id]then continue;
|
||
ncs[id]:= true;
|
||
r[idx]["id"]:= id;
|
||
vjt := vj["t"];
|
||
vjv := vj["v"];
|
||
if vjt="*" then
|
||
begin
|
||
vval := array("value":vjv,"font":("color":0xff0000));
|
||
end else
|
||
if ifarray(vjv)then
|
||
begin
|
||
vval := array("value":vjv,"font":("color":0));
|
||
end else
|
||
if ifstring(vjt)and(vjt <> "nil")then
|
||
begin
|
||
vval := array("value":tostn(vjv),"font":("color":0));
|
||
end else
|
||
begin
|
||
vval := array("value":"","font":("color":0));
|
||
end
|
||
r[idx]["data"]:= array(vj["c"],vval,vj["t"],vj["n"],id);
|
||
r[idx]["pid"]:= vj["p"];
|
||
r[idx]["nnp"]:= vj["nnp"];
|
||
idx++;
|
||
end
|
||
end
|
||
return r;
|
||
end
|
||
function formatsysvlist(d,len);
|
||
begin
|
||
r := array();
|
||
ncs := array();
|
||
idx := 0;
|
||
for i,v in d do
|
||
begin
|
||
ri := parsersysname(i,v,len);
|
||
for j,vj in ri do
|
||
begin
|
||
id := vj["n"];
|
||
if ncs[id]then continue;
|
||
ncs[id]:= true;
|
||
r[idx]["id"]:= id;
|
||
vjt := vj["t"];
|
||
vjv := vj["v"];
|
||
if vjt="*" then
|
||
begin
|
||
vval := array("value":vjv,"font":("color":0xff0000));
|
||
end else
|
||
if ifarray(vjv)then
|
||
begin
|
||
vval := array("value":vjv,"font":("color":0));
|
||
end else
|
||
if ifstring(vjt)and(vjt <> "nil")then
|
||
begin
|
||
vval := array("value":tostn(vjv),"font":("color":0));
|
||
end else
|
||
begin
|
||
vval := array("value":"","font":("color":0));
|
||
end
|
||
r[idx]["data"]:= array(vj["c"],vval,vjt,vj["n"],id,vj["len"]);
|
||
r[idx]["pid"]:= vj["p"];
|
||
r[idx]["nnp"]:= vj["nnp"];
|
||
idx++;
|
||
end
|
||
end
|
||
return r;
|
||
end
|
||
function gettypename(ev);
|
||
begin
|
||
case datatype(ev)of
|
||
0:t := "int"; //处理长整型的问题
|
||
20:t := "int64";
|
||
24:t := "lstr";
|
||
1:t := "double";
|
||
2:t := "str";
|
||
5:t := "array";
|
||
else t := "nil";
|
||
end;
|
||
return t;
|
||
end
|
||
function parsersysname(ostring,ev,nlen);
|
||
begin
|
||
len := length("*TSL_UNComplete*");
|
||
ucp := false;
|
||
if pos("*TSL_UNComplete*",ostring)=1 then
|
||
begin
|
||
ucp := true;
|
||
if Length(ostring)=len then //空串
|
||
begin
|
||
nstr := "";
|
||
return array();
|
||
end else
|
||
nstr := ostring[len+1:];
|
||
end else
|
||
nstr := ostring;
|
||
r := array();
|
||
if ucp then t := "*";
|
||
else t := gettypename(ev);
|
||
nid := "";
|
||
r[0]:= array("n":"sysparams+",
|
||
"c":array("font":("color":0x0000ff,"italic":1),"value":"sysparams")
|
||
);
|
||
if nlen >= 0 then
|
||
begin
|
||
nnl := 0x80000000+_shl(nlen,4)+1;
|
||
cn := "";
|
||
if nlen=0 then
|
||
begin
|
||
r[1]:= array("n":"+",
|
||
"c":tostn(""),
|
||
"len":nnl,
|
||
"p":"sysparams+"
|
||
);
|
||
end else
|
||
begin
|
||
cn := nstr[1:nlen];
|
||
r[1]:= array("n":cn+"+",
|
||
"c":cn,
|
||
"len":nnl,
|
||
"p":"sysparams+"
|
||
);
|
||
if nlen<length(nstr)then
|
||
begin
|
||
nstr := nstr[nlen+1:];
|
||
end else
|
||
nstr := "";
|
||
end
|
||
dd := str2array(nstr,".");
|
||
dd[0]:= cn;
|
||
ldd := length(dd)-1;
|
||
for i,v in dd do
|
||
begin
|
||
cl := 0x0000ff;
|
||
nid += v;
|
||
if(i=0)then
|
||
begin
|
||
vi := tostn(v);
|
||
end else
|
||
begin
|
||
vi := v;
|
||
//cl := 0xff0000;
|
||
end
|
||
if 1=parseregexpr("^\\(\\w+\\)$",vi,"i",p11,p111,p1111)then
|
||
begin
|
||
np := 1;
|
||
cl := 0x008080;
|
||
end else
|
||
np := 0;
|
||
r[i+1]:= array("c":array("font":("color":cl),"value":vi),"i":false,"n":nid+"+","p":r[i]["n"],"len":nnl,"nnp":np);
|
||
if i<ldd then nid += ".";
|
||
end
|
||
r[i+1]["t"]:= t;
|
||
r[i+1]["v"]:= ev;
|
||
end else
|
||
begin
|
||
nnl := 0x80000000+_shl(length(nstr),4)+1;
|
||
r[1]:= array("n":nstr+"+",
|
||
"c":("font":("color":0x0000ff),"value":tostn(nstr)),
|
||
"t":t,
|
||
"v":ev,
|
||
"len":nnl,
|
||
"p":"sysparams+"
|
||
);
|
||
end
|
||
return r;
|
||
end
|
||
function parservname(ostring,ev);
|
||
begin
|
||
len := length("*TSL_UNComplete*");
|
||
ucp := false;
|
||
if pos("*TSL_UNComplete*",ostring)=1 then
|
||
begin
|
||
ucp := true;
|
||
nstr := ostring[len+1:];
|
||
end else
|
||
nstr := ostring;
|
||
len := length(nstr);
|
||
r := array();
|
||
if ucp then t := "*";
|
||
else
|
||
begin
|
||
t := gettypename(ev);
|
||
end
|
||
nid := "";
|
||
dd := str2array(nstr,".");
|
||
ldd := length(dd)-1;
|
||
for i,v in dd do
|
||
begin
|
||
cl := 0;
|
||
nid += v;
|
||
if 1=parseregexpr("^\\(\\w+\\)$",v,"i",p11,p111,p1111)then
|
||
begin
|
||
np := 1;
|
||
cl := 0x008080;
|
||
end else
|
||
np := 0;
|
||
r[i]:= array("c":("value":v,"font":("color":cl)),"i":false,"n":nid,"p":r[i-1]["n"],"nnp":np);
|
||
if i<ldd then nid += ".";
|
||
end
|
||
r[i]["n"]:= nstr;
|
||
r[i]["t"]:= t;
|
||
r[i]["v"]:= ev;
|
||
return r;
|
||
end
|
||
|
||
FStackList;
|
||
FVaraiblesList;
|
||
FToolbar;
|
||
FCommandtext;
|
||
FShowText;
|
||
fimgelist;
|
||
end
|
||
type ttempclass = class()
|
||
function create(c);
|
||
begin
|
||
Caption := c;
|
||
end
|
||
caption;
|
||
end
|
||
type tdbgselwnd=class(tdcreateform)
|
||
uses tslvcl;
|
||
label1:tlabel;
|
||
furl:tedit;
|
||
label2:tlabel;
|
||
fport:tedit;
|
||
label3:tlabel;
|
||
fusr:tedit;
|
||
label4:tlabel;
|
||
label5:tlabel;
|
||
fpwd:tpassword;
|
||
fdir:tedit;
|
||
fdiag:tfolderchooseadlg;
|
||
flist:tlistview;
|
||
fcbtn:tbtn;
|
||
flogout:tbtn;
|
||
flogin:tbtn;
|
||
fdbg:tbtn;
|
||
cancel_clk;
|
||
save_clk;
|
||
dbg_clk;
|
||
fhistorydir;
|
||
function Create(AOwner);override; //构造
|
||
begin
|
||
inherited;
|
||
Visible := false;
|
||
ParentFont := false;
|
||
Loader.LoadFromTfmScript(self,getinfo());
|
||
flist.Columns := array(
|
||
("text":"ID号","width":150),
|
||
("text":"信息","width":300),
|
||
("text":"创建时间","width":100)
|
||
);
|
||
flogout.top := 140;
|
||
flogout.OnClick := function(o,e)
|
||
begin
|
||
calldatafunction(cancel_clk,self,e);
|
||
end
|
||
flogin.OnClick := function(o,e)
|
||
begin
|
||
if fhistorydir and ifstring(fhistorydir)then
|
||
begin
|
||
Fremotepath := fhistorydir+"remoteinfo.tsm";
|
||
d := getdata();
|
||
Exportfile(ftstream(),"",Fremotepath,d);
|
||
end
|
||
calldatafunction(save_clk,self,e);
|
||
end
|
||
fdbg.onclick := function(o,e)
|
||
begin
|
||
calldatafunction(dbg_clk,self,e);
|
||
end
|
||
setlist();
|
||
end
|
||
function setattachwait(flg); //设置登陆样式
|
||
begin
|
||
if flg then
|
||
begin
|
||
Height := 210;
|
||
end else
|
||
begin
|
||
Height := 550;
|
||
end
|
||
end
|
||
function loaddata(); //导入数据
|
||
begin
|
||
if fhistorydir and ifstring(fhistorydir)then
|
||
begin
|
||
Fremotepath := fhistorydir+"remoteinfo.tsm";
|
||
if fileexists("",Fremotepath)and(1=importfile(ftstream(),"",Fremotepath,d))then
|
||
begin
|
||
setdata(d);
|
||
end
|
||
end
|
||
end
|
||
function getdata();
|
||
begin
|
||
r := array();
|
||
r["addr"]:= furl.text;
|
||
r["port"]:= fport.text;
|
||
r["usr"]:= fusr.text;
|
||
r["pwd"]:= fpwd.text;
|
||
r["dir"]:= fdir.text;
|
||
return r;
|
||
end
|
||
function tserlogersimplewnd1_close(o;e);virtual;
|
||
begin
|
||
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
|
||
function getdir();
|
||
begin
|
||
if fdiag.ChooseDlg()then
|
||
begin
|
||
fdir.text := fdiag.Folder;
|
||
end
|
||
end
|
||
function setlist(d);
|
||
begin
|
||
FList.DeleteAllItems();
|
||
fdbg.Enabled := false;
|
||
if d and ifarray(d)then
|
||
begin
|
||
FList.appendItems(d);
|
||
FList.SelectedId := 0;
|
||
fdbg.Enabled := true;
|
||
end
|
||
end
|
||
function getstartfilename(sv);
|
||
begin
|
||
dirt := fdir.Text;
|
||
if not sv then sv := FList.SelectedValue;
|
||
if dirt and sv then
|
||
begin
|
||
if sv then
|
||
begin
|
||
fs := sv["info"];
|
||
if fs then
|
||
begin
|
||
for i := length(fs)-1 downto 1 do
|
||
begin
|
||
if fs[i]in array("\\","/")then
|
||
begin
|
||
fs := fs[i+1:];
|
||
break;
|
||
end
|
||
end
|
||
return gettruefile(dirt,fs,ioFileseparator());
|
||
end
|
||
end
|
||
end
|
||
end
|
||
private
|
||
function getinfo();
|
||
begin
|
||
return %%
|
||
object tserlogersimplewnd1:tserlogersimplewnd
|
||
caption="远程调试"
|
||
color=0xFFFFFF
|
||
top=100
|
||
height=550
|
||
minmaxbox=false
|
||
onclose=tserlogersimplewnd1_close
|
||
width=580
|
||
wsdlgmodalframe=true
|
||
wssizebox=false
|
||
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=300
|
||
end
|
||
object label4:tlabel
|
||
left=2
|
||
top=72
|
||
width=80
|
||
height=25
|
||
caption=" 密 码"
|
||
end
|
||
object label5:tlabel
|
||
left=2
|
||
top=100
|
||
width=80
|
||
height=25
|
||
caption=" 脚本目录"
|
||
end
|
||
|
||
object fpwd:tpassword
|
||
height=25
|
||
left=88
|
||
tabstop=true
|
||
top=72
|
||
width=300
|
||
end
|
||
object fdir:tedit
|
||
height=25
|
||
left=88
|
||
tabstop=true
|
||
top=100
|
||
width=300
|
||
end
|
||
object fcbtn:tbtn
|
||
caption="..."
|
||
height=25
|
||
left=390
|
||
tabstop=true
|
||
top=100
|
||
width=22
|
||
onclick=getdir
|
||
end
|
||
object flogout:tbtn
|
||
an1chors=[akright akbottom]
|
||
caption="取消"
|
||
height=23ff
|
||
left=375
|
||
tabstop=true
|
||
top=480
|
||
width=74
|
||
end
|
||
object fdbg:tbtn
|
||
an1chors=[akright akbottom]
|
||
caption="调试"
|
||
height=23
|
||
left=470
|
||
tabstop=true
|
||
top=480
|
||
width=74
|
||
end
|
||
object flogin:tbtn
|
||
caption="连接"
|
||
height=23
|
||
left=470
|
||
tabstop=true
|
||
top=140
|
||
width=74
|
||
end
|
||
object flist:tlistview
|
||
anch1ors=[akTop akright akLeft akBottom]
|
||
height=290
|
||
left=2
|
||
top=180
|
||
width=560
|
||
end
|
||
object fdiag:tfolderchooseadlg
|
||
caption="执行目录"
|
||
end
|
||
end
|
||
%%;
|
||
end
|
||
private
|
||
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"];
|
||
fdir.text := d["dir"];
|
||
end
|
||
function gettruefile(dir,n,fio);
|
||
begin
|
||
if dir and ifstring(dir)then
|
||
begin
|
||
rfile := dir+fio+n;
|
||
if fileexists("",rfile)then return rfile;
|
||
for i,v in FileList("",dir+fio+"*") do
|
||
begin
|
||
fn := v["FileName"];
|
||
if pos("D",v["Attr"])and not(fn in array(".",".."))then
|
||
begin
|
||
rfile := gettruefile(dir+fio+fn,n,fio);
|
||
if rfile then return rfile;
|
||
end
|
||
end
|
||
end
|
||
end
|
||
end
|
||
type tdbgvalueshowgrid=class(TDrawGrid)
|
||
{**
|
||
@explan(说明)TSL数组和对象展示 %%
|
||
**}
|
||
private
|
||
static FHGS;
|
||
ftext;
|
||
FCols;
|
||
Fdata;
|
||
FMRWD;
|
||
FGridControl;
|
||
FRows;
|
||
FShowTwo;
|
||
FCControls;
|
||
FColumnWidth;
|
||
FRowHeader;
|
||
FControlIndex;
|
||
FStringAlign;
|
||
FNumberAlign;
|
||
FDefAlign;
|
||
FCanedit;
|
||
function showstring(f);
|
||
begin
|
||
if ifarray(Fdata)then
|
||
begin
|
||
gettxtobj();
|
||
ftext.text := "";
|
||
if f then
|
||
begin
|
||
ftext.HighLighter := FHGS[1]; //FHGS[1];
|
||
ftext.Caption := "json";
|
||
ftext.text := ejsonformat(Fdata);
|
||
end else
|
||
begin
|
||
ftext.HighLighter := FHGS[0];
|
||
ftext.Caption := "原串....";
|
||
ftext.text := tostn(Fdata);
|
||
end
|
||
ftext.show();
|
||
end
|
||
end
|
||
function getdata(i,j,cp,indexs);
|
||
begin
|
||
{**
|
||
@explan(说明) 获取数据
|
||
**}
|
||
if j=0 and FRowHeader then return FRows[i];
|
||
r := FRows[i];
|
||
if FCols and FShowTwo then
|
||
begin
|
||
if FRowHeader then c := FCols[j-1];
|
||
else c := FCols[j];
|
||
d := FData[r][c];
|
||
if cp then cp := "["+tostn(r)+"]";
|
||
if cp then cp += "["+tostn(c)+"]";
|
||
if indexs then indexs := array(r,c);
|
||
end else
|
||
begin
|
||
d := FData[FRows[i]];
|
||
if cp then
|
||
begin
|
||
cs := r;
|
||
if ifstring(cs)then cs := replacetext(cs,".","\\o");
|
||
cp := "["+tostn(cs)+"]";
|
||
end
|
||
if indexs then indexs := array(r);
|
||
end
|
||
return d;
|
||
end
|
||
function SetStringAlign(v);
|
||
begin
|
||
if v <> FStringAlign then
|
||
begin
|
||
FStringAlign := v;
|
||
InvalidateRect(nil,true);
|
||
end
|
||
end
|
||
function SetNumberAlign(v);
|
||
begin
|
||
if v <> FNumberAlign then
|
||
begin
|
||
FNumberAlign := v;
|
||
InvalidateRect(nil,true);
|
||
end
|
||
end
|
||
function SetdefAlign(v);
|
||
begin
|
||
if v <> FDefAlign then
|
||
begin
|
||
FDefAlign := v;
|
||
InvalidateRect(nil,true);
|
||
end
|
||
end
|
||
function GetTSLData();
|
||
begin
|
||
return FData;
|
||
end
|
||
function StrToNumber(s);
|
||
begin
|
||
if pos(".",s)then
|
||
begin
|
||
return StrToFloatDef(s,0);
|
||
end else
|
||
begin
|
||
return StrToIntDef(s,0);
|
||
end
|
||
end
|
||
function SetRowHeader(v);
|
||
begin
|
||
nv := v?true:false;
|
||
if FRowHeader <> nv then
|
||
begin
|
||
FRowHeader := nv;
|
||
FD := FData;
|
||
SetData(array());
|
||
SetData(FD);
|
||
end
|
||
end
|
||
function SetTwoD(v);
|
||
begin
|
||
nv := v?true:false;
|
||
if nv <> FShowTwo then
|
||
begin
|
||
if FCanedit and nv then return; //编辑情况
|
||
FD := FData;
|
||
SetData(array());
|
||
FShowTwo := nv;
|
||
SetData(FD);
|
||
end
|
||
end
|
||
function setdatap();
|
||
begin
|
||
if not Fdata then exit;
|
||
FCols := nil;
|
||
FRows := mrows(Fdata,1);
|
||
FCL := mcols(Fdata,1);
|
||
allFCL := true;
|
||
if FShowTwo then
|
||
begin
|
||
for i,v in FData do
|
||
begin
|
||
if not ifarray(v)then
|
||
begin
|
||
allFCL := false;
|
||
break;
|
||
end
|
||
end
|
||
end
|
||
fcs := array();
|
||
wd := 150;
|
||
for i,v in FRows do
|
||
begin
|
||
if ifstring(v)then
|
||
begin
|
||
wd := max(wd,length(v) * 9);
|
||
if wd>200 then break;
|
||
end
|
||
end
|
||
if RowHeader then
|
||
begin
|
||
fcs[0]:= array("text":" ","width":min(200,wd));
|
||
end
|
||
if FCL and allFCL and FShowTwo then
|
||
begin
|
||
FCols := FCl;
|
||
for i,v in FCols do
|
||
begin
|
||
fcs[length(fcs)]:= array("text":ifstring(v)?v:inttostr(v),"width":FMRWD);
|
||
end
|
||
end else
|
||
begin
|
||
fcs[length(fcs)]:= array("text":" ","width":ColumnWidth>20?ColumnWidth:150);
|
||
end
|
||
Columns := fcs;
|
||
ItemCount := length(FRows);
|
||
end
|
||
function gettxtobj();
|
||
begin
|
||
if not ftext then
|
||
begin
|
||
FText := new TFTSLScriptcustomMemo(self); //tmemo(self);
|
||
//ftext.HighLighter := FHGS[0];
|
||
ftext.readonly := true;
|
||
ftext.left := left+20;
|
||
ftext.top := top+20;
|
||
ftext.width := 500;
|
||
ftext.height := 400;
|
||
ftext.wspopup := true;
|
||
FText.WsSysMenu := true;
|
||
ftext.WsSizeBox := true;
|
||
FText.onclose := function(o,e)
|
||
begin
|
||
e.skip := true;
|
||
o.visible := false;
|
||
end
|
||
FText.parent := self;
|
||
end
|
||
return ftext;
|
||
end
|
||
function SetData(data,f);
|
||
begin
|
||
if Fdata=data then return;
|
||
DeleteAllColumns();
|
||
if ftext then ftext.Visible := false;
|
||
for i,v in mrows(FCControls,1) do
|
||
begin
|
||
obj := FCControls[v];
|
||
obj.TSLdata := nil;
|
||
obj.Visible := false;
|
||
obj.Parent := nil;
|
||
end
|
||
FCControls := array();
|
||
FData := data;
|
||
setdatap();
|
||
end
|
||
function itemishow(r,r2);
|
||
begin
|
||
return r[2]<r2[0]or r[0]>r2[2];
|
||
end
|
||
function getdtobject();
|
||
begin
|
||
global Fdtobjects;
|
||
if not ifarray(Fdtobjects)then Fdtobjects := array();
|
||
for i,v in Fdtobjects do
|
||
begin
|
||
p := v.Parent;
|
||
if not p then
|
||
begin
|
||
return v;
|
||
end
|
||
end
|
||
o := new tdbgvalueshowgrid(initializeapplication());
|
||
o.ControlIndexs(idexs);
|
||
o.height := 500;
|
||
o.width := 500;
|
||
o.Twodimensional := Twodimensional;
|
||
o.Visible := false;
|
||
o.wspopup := true;
|
||
o.WsSysMenu := true;
|
||
o.WsSizeBox := true;
|
||
o.onclose := thisfunction(ShowDataClose);
|
||
Fdtobjects[length(Fdtobjects)]:= o;
|
||
return o;
|
||
end
|
||
function getitemcontrol(d,p,i,j,tp,cp,idexs);
|
||
begin
|
||
idx := format("%d*%d",i,j);
|
||
o := FCControls[idx];
|
||
if tp="grid" then
|
||
begin
|
||
if not o then
|
||
begin
|
||
o := getdtobject();
|
||
o.parent := self;
|
||
FCControls[idx]:= o;
|
||
end
|
||
//o.Twodimensional := Twodimensional;
|
||
if o.wspopup then p := ClientToScreen(p[0],p[1]);
|
||
o.left := p[0]-20;
|
||
o.top := p[1]-20;
|
||
o.caption := caption+"."+cp;
|
||
o.TSLdata := d;
|
||
o.show();
|
||
end
|
||
end
|
||
public
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
if not fhgs then
|
||
begin
|
||
FHGS := array();
|
||
FHGS[0]:= new TTslSynHighLighter(initializeapplication());
|
||
FHGS[1]:= new TJsonSynHighLighter(initializeapplication());
|
||
end
|
||
GridLine := true;
|
||
FCControls := array();
|
||
FRowHeader := true;
|
||
FixedColumns := 1;
|
||
itemheight := 25;
|
||
caption := "";
|
||
FMRWD := 150;
|
||
FShowTwo := false;
|
||
OndblClick := thisfunction(GridCellDblClick);
|
||
FNumberAlign := AL9_CENTERRIGHT;
|
||
FStringAlign := AL9_CENTERLEFT;
|
||
FDefAlign := AL9_CENTER;
|
||
mu := new TPopupmenu(self);
|
||
for i,v in array("一维","二维","原串","json") do
|
||
begin
|
||
mi := new TMenu(self);
|
||
mi.parent := mu;
|
||
mi.caption := v;
|
||
mi.OnClick := function(o,e)
|
||
begin
|
||
case o.caption of
|
||
"一维":
|
||
begin
|
||
Twodimensional := false;
|
||
end
|
||
"二维":
|
||
begin
|
||
if FCanedit then return;
|
||
Twodimensional := true;
|
||
end
|
||
"原串":
|
||
begin
|
||
showstring();
|
||
end
|
||
"json":
|
||
begin
|
||
showstring(1);
|
||
end
|
||
end
|
||
end
|
||
end
|
||
PopupMenu := mu;
|
||
end
|
||
function DoDrawSubItem(o,e);override;
|
||
begin
|
||
inherited;
|
||
if e.skip then exit;
|
||
dc := e.canvas;
|
||
i := e.itemid;
|
||
j := e.subitemid;
|
||
d := getdata(i,j);
|
||
src := e.SubItemRect;
|
||
if j=0 and FRowHeader then
|
||
begin
|
||
//_wapi.DrawFrameControl(dc.Handle,src,DFC_BUTTON,DFCS_BUTTONPUSH);
|
||
dc.Draw("framecontrol",array(src[0:1],src[2:3]),DFC_BUTTON,DFCS_BUTTONPUSH);
|
||
end
|
||
ds := "";
|
||
dc.font.color := 0;
|
||
if ifarray(d)then
|
||
begin
|
||
ds := format("<Array[%d]>",length(d));
|
||
//dc.drawtext(ds,src);
|
||
class(TLabel).CanvasDrawAlignText(dc,src,ds,FDefAlign);
|
||
end else
|
||
if ifstring(d)then
|
||
begin
|
||
ds := d;
|
||
//dc.drawtext(ds,src);
|
||
class(TLabel).CanvasDrawAlignText(dc,src,ds,FStringAlign);
|
||
end else
|
||
begin
|
||
ds := tostn(d);
|
||
if d<0 then dc.font.color := rgb(200,0,0);
|
||
if ifnumber(d)and j>0 then
|
||
begin
|
||
//dc.drawtext(ds,src,DT_RIGHT);
|
||
class(TLabel).CanvasDrawAlignText(dc,src,ds,FNumberAlign);
|
||
end else
|
||
begin
|
||
//dc.drawtext(ds,src);
|
||
if not ifnil(d)then class(TLabel).CanvasDrawAlignText(dc,src,ds,FStringAlign);
|
||
end
|
||
end
|
||
end
|
||
function GridCellDblClick(o,e);virtual;
|
||
begin
|
||
cp := 1;
|
||
cl := e.isubitem;
|
||
if cl<1 and FRowHeader then exit;
|
||
indexs := 1;
|
||
d := getdata(e.iitem,cl,cp,indexs);
|
||
p := e.ptaction;
|
||
if ifarray(d)then
|
||
begin
|
||
if d then getitemcontrol(d,p,e.iitem,cl,"grid",cp,indexs);
|
||
end else
|
||
begin
|
||
gettxtobj();
|
||
ftext.caption := Caption+"."+cp;
|
||
FText.text := tostn(d);
|
||
FText.show();
|
||
end
|
||
end
|
||
function ShowDataClose(o,e);
|
||
begin
|
||
o.show(false);
|
||
o.TSLdata := array();
|
||
e.skip := true;
|
||
end
|
||
function Recycling();override;
|
||
begin
|
||
inherited;
|
||
ftext := nil;
|
||
FCols := nil;
|
||
Fdata := nil;
|
||
FControls := array();
|
||
end
|
||
function ControlIndexs(dx);
|
||
begin
|
||
{**
|
||
@ignore(忽略) %%
|
||
**}
|
||
if dx then FControlIndex := dx;
|
||
return FControlIndex;
|
||
end
|
||
property Twodimensional:bool read FShowTwo write SetTwoD;
|
||
property TSLdata:variable read GetTSLData write SetData;
|
||
property ColumnWidth:integer read FColumnWidth write FColumnWidth;
|
||
property RowHeader:bool read FRowHeader write SetRowHeader;
|
||
property StringAlign:AlignStyle9 read FStringAlign write SetStringAlign;
|
||
property NumberAlign:AlignStyle9 read FNumberAlign write SetNumberAlign;
|
||
property DefAlign:AlignStyle9 read FDefAlign write SetdefAlign;
|
||
{**
|
||
@param(Twodimensional)(BOOL) 是否二维强制二维展示 %%
|
||
@param(TSLdata)(array) tsl数据 %%
|
||
**}
|
||
end
|
||
type TGroupGridA=class(TDrawGrid)
|
||
{**
|
||
@explan(说明)带层级功能的表格 %%
|
||
**}
|
||
{**
|
||
@expample(范例)
|
||
FGrid := new TGroupGridA(self);
|
||
FGrid.border := true;
|
||
FGrid.OddLineBKColor := 0xFF0000; //奇数行背景色
|
||
FGrid.EvenLineBKColor := 0x00FF00;//偶数行背景色
|
||
cls := array(("text":"a","width":300),("text":"b","width":30)); //设置标题
|
||
FGrid.Columns := cls;
|
||
d := array(
|
||
("id":1,"data":("福哥",true)),
|
||
("id":2,"data":("a",false)),
|
||
("id":3,"pid":1,"data":(("value":"a","type":"string","font":("color":rgb(200,0,0))),true)),
|
||
("id":4,"pid":1,"data":("a",false)),
|
||
("id":5,"pid":3,"data":("a",false))
|
||
);
|
||
FGrid.SetNodeData(d); //设置数据
|
||
//获得数据使用 FGrid.GetNodeData();
|
||
**}
|
||
uses tslvcl;
|
||
function Create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
GridLine := true;
|
||
FOddLineBKColor := 0xFAF3F1;
|
||
FEvenLineBKColor := 0xFFFFFF;
|
||
FNodeManger := new TGroupManger();
|
||
GridLine := true;
|
||
FNodes := array();
|
||
FCellediter := new tedit(self);
|
||
FCellediter.Visible := false;
|
||
FCellediter.Parent := self;
|
||
FCellediter.onkeyup := thisfunction(doeditcell);
|
||
FCellediter.onKillFocus := function(o,e)
|
||
begin
|
||
o.Visible := false;
|
||
end
|
||
//inherited SetColumns(array(("text":"","width":25)));
|
||
end
|
||
function doeditcell(o,e);
|
||
begin
|
||
//echo "\r\nkey up:",e.charcode;
|
||
case e.charcode of
|
||
13:
|
||
begin
|
||
e.skip := true;
|
||
o.Visible := false;
|
||
callDatafunction(FCelledit,o._Tag,o.text);
|
||
end
|
||
VK_ESCAPE:
|
||
begin
|
||
o.Visible := false;
|
||
end
|
||
end;
|
||
end
|
||
function SetNodeData(d,ncls); //设置数据
|
||
begin
|
||
FCellediter.Visible := false;
|
||
if not ncls then
|
||
begin
|
||
FCurrentNode_a := nil;
|
||
FNodeManger.RootNode.RecyclingChildren();
|
||
FNodeData := array();
|
||
FNodeIds := array();
|
||
end
|
||
for i,v in d do
|
||
begin
|
||
id := v["id"];
|
||
nd := FNodeData[id];
|
||
if nd then
|
||
begin
|
||
for j,vj in v["data"] do
|
||
begin
|
||
nd[j]:= vj;
|
||
end
|
||
continue;
|
||
end
|
||
pid := v["pid"];
|
||
nd := CreateNode();
|
||
nd.FNodeid := id;
|
||
nd.FNNNODE := V["nnp"];
|
||
nd.Expanded := false;
|
||
pnd := FNodeData[pid];
|
||
for j,vj in v["data"] do
|
||
begin
|
||
nd[j]:= vj;
|
||
end
|
||
if not(pnd)then AppendNode(nd);
|
||
else AppendNode(nd,pnd);
|
||
FNodeData[id]:= nd;
|
||
FNodeIds[id]:= pid;
|
||
end
|
||
UpdateWindow();
|
||
InValidateRect(nil,false);
|
||
end
|
||
function GetNodeData(); //获得数据
|
||
begin
|
||
r := array();
|
||
ri := 0;
|
||
for i,v in FNodeData do
|
||
begin
|
||
r[ri,"id"]:= i;
|
||
r[ri,"pid"]:= FNodeIds[i];
|
||
r[ri,"data"]:= v.FData;
|
||
ri++;
|
||
end
|
||
return r;
|
||
end
|
||
function getcurrentnodedata();
|
||
begin
|
||
if FCurrentNode_a then
|
||
begin
|
||
d := FCurrentNode_a.Fdata;
|
||
if d[3]="sysparams+" then return;
|
||
d[2]:= "*";
|
||
FNodeManger.getcdnodes(FCurrentNode_a,r);
|
||
reindex(FNodeData,r);
|
||
reindex(FNodeIds,r);
|
||
FCurrentNode_a.RecyclingChildren();
|
||
FCurrentNode_a.Expanded := false;
|
||
calldatafunction(FCelldbclk,self,array(1,d,FCurrentNode_a));
|
||
end
|
||
end
|
||
function MouseDown(o,e);override;
|
||
begin
|
||
//
|
||
inherited;
|
||
if e.shiftdouble()then
|
||
begin
|
||
r := HitTestItem(e.xpos,e.ypos);
|
||
if r[0]>= 0 and r[1]=1 then
|
||
begin
|
||
nd := FNodes[r[0]];
|
||
d := nd.Fdata;
|
||
if d[2]in array("str","int","lstr","double","nil","int64")then
|
||
begin
|
||
try
|
||
rc := o.GetSubItemRect(r[0],r[1]);
|
||
FCellediter.SetBoundsRect(rc);
|
||
try
|
||
FCellediter.Text := d[1]["value"];
|
||
except
|
||
FCellediter.Text := "";
|
||
end;
|
||
FCellediter._Tag := array(r[1],d,nd);
|
||
FCellediter.show();
|
||
FCellediter.SetFocus();
|
||
except
|
||
end;
|
||
return;
|
||
end else
|
||
if d[2]="array" then
|
||
begin
|
||
calldatafunction(FShowarray,d);
|
||
return;
|
||
end
|
||
calldatafunction(FCelldbclk,o,array(r[1],d,nd));
|
||
end
|
||
end
|
||
FCellediter.Visible := false;
|
||
end
|
||
function MouseUp(o,e);override; //展开折叠点击
|
||
begin
|
||
inherited;
|
||
r := HitTestItem(e.xpos+5,e.ypos);
|
||
if r[0]>= 0 then
|
||
begin
|
||
nd := FNodes[r[0]];
|
||
if FCurrentNode_a <> nd then
|
||
begin
|
||
FCurrentNode_a := nd;
|
||
InValidateRect(nil,false);
|
||
end
|
||
if r[1]=0 then
|
||
begin
|
||
if nd and nd.NodeCount>0 then
|
||
begin
|
||
if nd.Expanded then nd.UnExpand();
|
||
else nd.Expand();
|
||
UpDateWindow();
|
||
end
|
||
return;
|
||
end
|
||
v := nd[r[1]];
|
||
if ifarray(v)then
|
||
begin
|
||
if v["type"]="link" then
|
||
begin
|
||
//return CallMessgeFunction(OnLinkCellClik,o,v);
|
||
end
|
||
end
|
||
end
|
||
end
|
||
function AppendNode(nd,pnd); //在父节点中追加节点
|
||
begin
|
||
if not(pnd is class(TNode))then _pnd := FNodeManger.RootNode;
|
||
else _pnd := pnd;
|
||
_pnd.AppendNode(nd);
|
||
end
|
||
function InsertNode(nd,idx,pnd); //插入节点
|
||
begin
|
||
if not(pnd is class(TNode))then _pnd := FNodeManger.RootNode;
|
||
else _pnd := pnd;
|
||
_pnd.InsertNode(nd,idx);
|
||
end
|
||
function CreateNode(); //构造节点
|
||
begin
|
||
return FNodeManger.CreateNode();
|
||
end
|
||
function InsertNodes(nds,idx,pnd); //批量添加节点
|
||
begin
|
||
if not(pnd is class(TNode))then _pnd := FNodeManger.RootNode;
|
||
else _pnd := pnd;
|
||
_pnd.InsertNodes(nds,idx);
|
||
end
|
||
function GetNodeByIndex(idx); //通过序号获得节点,必须update后
|
||
begin
|
||
return FNodes[idx];
|
||
end
|
||
function UpDateWindow(); //update节点
|
||
begin
|
||
//更新窗口
|
||
FNodes := FNodeManger.ListNodes();
|
||
ItemCount := length(FNodes);
|
||
end
|
||
function DoDrawItem(o,e);override; //绘制单元格
|
||
begin
|
||
inherited;
|
||
j := e.Subitemid;
|
||
i := e.itemid;
|
||
DObject := FNodes[i];
|
||
if not DObject then return;
|
||
dc := e.canvas;
|
||
e.rcitem := rec;
|
||
rec := e.SubItemRect;
|
||
wd := 4;
|
||
if FCurrentNode_a=DObject then
|
||
begin
|
||
dc.Brush.Color := 0xffce87;
|
||
end else
|
||
begin
|
||
if i mod 2 then
|
||
begin
|
||
dc.Brush.Color := FOddLineBKColor; // FOddLineBKColor := 0xFAF3F1;
|
||
end else
|
||
dc.Brush.Color := FEvenLineBKColor; // FEvenLineBKColor := 0xFFFFFF;
|
||
end
|
||
dc.FillRect(rec);
|
||
dc.pen.color := 0xa8a8a8;
|
||
//dc.pen.style := PS_DASHDOT;
|
||
dc.pen.width := 2;
|
||
dc.moveto(array(rec[2],rec[1]));
|
||
dc.LineTo(array(rec[2],rec[3]));
|
||
if j=0 then
|
||
begin
|
||
cj :=-1;
|
||
pd := DObject.Parent;
|
||
while pd do
|
||
begin
|
||
if not(pd.FNNNODE)then cj++;
|
||
pd := pd.Parent;
|
||
end
|
||
wd := cj * 20+4;
|
||
if DObject.NodeCount>0 then
|
||
begin
|
||
if DObject.Expanded then bmp := FBmpExpand;
|
||
else bmp := FBmpUnexpand;
|
||
bmp.Draw(dc,rec[0]+wd+1,rec[1]+10,SRCAND);
|
||
//dc.stretchdraw(array(rec[0]+2+wd,rec[1]+2,rec[0]+15+wd,rec[1]+15),bmp);
|
||
end
|
||
//rec[0]+=wd+4+18;
|
||
rec[0]+= wd+16;
|
||
end
|
||
if j >= 0 and DObject then
|
||
begin
|
||
rec[0]+= 4;
|
||
v := DObject[j];
|
||
if ifstring(v)then
|
||
begin
|
||
//if j=0 and v="sysparams" then dc.font.color := 0x0000ff;
|
||
//else dc.font.color := 0;
|
||
dc.DrawText(v,rec,DT_SINGLELINE .| DT_VCENTER);
|
||
end else
|
||
begin
|
||
if ifarray(v)then
|
||
begin
|
||
val := v["value"];
|
||
typ := v["type"];
|
||
ft := v["font"];
|
||
rebk := false;
|
||
if ifarray(ft)and ft then
|
||
begin
|
||
bf := dc.font.fontinfo();
|
||
dc.font.setvalues(ft);
|
||
rebk := true;
|
||
end
|
||
if typ="link" then
|
||
begin
|
||
udl := dc.font.underline;
|
||
fcl := dc.Font.Color;
|
||
dc.font.underline := true;
|
||
dc.Font.Color := rgb(0,0,254);
|
||
end
|
||
if ifstring(val)then
|
||
begin
|
||
dc.drawtext(val,rec,DT_SINGLELINE .| DT_VCENTER .| DT_NOPREFIX);
|
||
end else
|
||
if ifarray(val)then
|
||
begin
|
||
dc.drawtext(format("ARRAY<[%d]>",Length(val)),rec,DT_SINGLELINE .| DT_VCENTER .| DT_NOPREFIX);
|
||
end
|
||
//还原
|
||
if rebk then
|
||
begin
|
||
dc.font.SetValues(bf);
|
||
end else
|
||
if typ="link" then
|
||
begin
|
||
dc.font.underline := udl;
|
||
dc.Font.Color := fcl;
|
||
end
|
||
end else
|
||
begin
|
||
if not ifnil(v)then dc.drawtext(tostn(v),rec,DT_SINGLELINE .| DT_VCENTER .| DT_NOPREFIX);
|
||
end
|
||
end
|
||
end
|
||
end
|
||
function Recycling();override;
|
||
begin
|
||
inherited;
|
||
FCurrentNode_a := nil;
|
||
FCelldbclk := nil;
|
||
FShowarray := nil;
|
||
FCelledit := nil;
|
||
FOnLinkCellClik := nil;
|
||
FBoolColumns := nil;
|
||
FOddLineBKColor := nil;
|
||
FEvenLineBKColor := nil;
|
||
FNodeData := nil;
|
||
FNodeIds := nil;
|
||
FCellediter := nil;
|
||
end
|
||
published //属性
|
||
property OddLineBKColor read FOddLineBKColor write FOddLineBKColor;
|
||
property EvenLineBKColor read FEvenLineBKColor write FEvenLineBKColor;
|
||
property BoolColumns read FBoolColumns write FBoolColumns;
|
||
property OnLinkCellClik read FOnLinkCellClik write FOnLinkCellClik;
|
||
property celldbclk read FCelldbclk write FCelldbclk;
|
||
property celledit read FCellEdit write FCelledit;
|
||
property Showarray read FShowarray write FShowarray;
|
||
private
|
||
function GetChildAllChecked(nd,j,ck);
|
||
begin
|
||
nck := not(ck);
|
||
for i := 0 to nd.NodeCount-1 do
|
||
begin
|
||
cnd := nd.GetNodeByIndex(i);
|
||
if ifobj(cnd)then
|
||
begin
|
||
if cnd.NodeCount=0 then
|
||
begin
|
||
if cnd[j]=nck then return 0;
|
||
end
|
||
if 0=GetChildAllChecked(cnd,j,ck)then return 0;
|
||
end
|
||
end
|
||
return 1;
|
||
end
|
||
function CheckAllChild(nd,j,ck);
|
||
begin
|
||
for i := 0 to nd.NodeCount-1 do
|
||
begin
|
||
cnd := nd.GetNodeByIndex(i);
|
||
if ifobj(cnd)then
|
||
begin
|
||
vi := nd[j];
|
||
if vi=0 or vi=1 then cnd[j]:= ck;
|
||
CheckAllChild(cnd,j,ck);
|
||
end
|
||
end
|
||
end
|
||
FBoolColumns;
|
||
FOddLineBKColor;
|
||
FEvenLineBKColor;
|
||
FNodeData;
|
||
FNodeIds;
|
||
FOnLinkCellClik;
|
||
FCelldbclk;
|
||
FCelledit;
|
||
FShowarray;
|
||
FCellediter;
|
||
protected
|
||
type TGroupNode=class(TNode) //groupgrid节点
|
||
uses tslvcl;
|
||
function Create();
|
||
begin
|
||
inherited;
|
||
FData := array();
|
||
end
|
||
function Operator[](idx);
|
||
begin
|
||
return FData[idx];
|
||
end
|
||
function Operator[1](idx,val);
|
||
begin
|
||
return FData[idx]:= val;
|
||
end
|
||
FNodeid;
|
||
FNNNODE;
|
||
//private
|
||
FData;
|
||
end
|
||
type TGroupManger=class(TNodeManger) //group节点管理
|
||
function Create();
|
||
begin
|
||
inherited;
|
||
end
|
||
function CreateNode();override;
|
||
begin
|
||
return new TGroupNode();
|
||
end
|
||
end
|
||
class function Sinit();override;
|
||
begin
|
||
inherited;
|
||
GetSJPng();
|
||
end
|
||
private
|
||
FCurrentNode_a;
|
||
FNodes;
|
||
FNodeManger;
|
||
static FBmpExpand;
|
||
static FBmpUnexpand;
|
||
class function GetSJPng();
|
||
begin
|
||
if not FBmpExpand then
|
||
begin
|
||
FBmpExpand := new TBitmap();
|
||
FBmpExpand.readvcon(HexFormatStrToTsl("0502000000060400000074797065000203000000696D670006040000006461746
|
||
10002C700000089504E470D0A1A0A0000000D494844520000000A0000000A0806
|
||
0000008D32CFBD000000017352474200AECE1CE90000000467414D410000B18F0
|
||
BFC6105000000097048597300000EC300000EC301C76FA8640000005C49444154
|
||
285363F84F24204DE1EA7DF8F1ABF740851FBFFEFF9FD9F3FF7F443D6E7CF53ED
|
||
4C41B0FFFFF8F6FC1AEE8D005900A24379EBA86A968D729A82410A07866F76984
|
||
A2CD47A1825080E16B9807D00186425C804885FFFF030081696EBEB08C861D000
|
||
0000049454E44AE42608200"));
|
||
end
|
||
if not FBmpUnexpand then
|
||
begin
|
||
FBmpUnexpand := new TBitmap();
|
||
FBmpUnexpand.readvcon(HexFormatStrToTsl("0502000000060400000074797065000203000000696D670006040000006461746
|
||
10002BF00000089504E470D0A1A0A0000000D494844520000000A0000000A0806
|
||
0000008D32CFBD000000017352474200AECE1CE90000000467414D410000B18F0
|
||
BFC6105000000097048597300000EC300000EC301C76FA8640000005449444154
|
||
285363F88F0672FAFEFF3F7A09CA4102180A23EA2178DF39A80014E05408C23B4
|
||
E40058100AF4210DE7404224E502108AFDE474D852045208057214C1108E05488
|
||
AC08043014164DC654F4FFFFFFFF0022DF66E2EA30F3BB0000000049454E44AE4
|
||
2608200"));
|
||
end
|
||
end
|
||
end
|
||
type TNodeManger=class //节点树管理
|
||
uses tslvcl;
|
||
function Create();
|
||
begin
|
||
FRootNode := CreateNode();
|
||
end
|
||
function CreateNode();virtual;
|
||
begin
|
||
return new TNode();
|
||
end
|
||
function ListNodes();virtual;
|
||
begin
|
||
r := array();
|
||
GetExpandedNodes(FRootNode,r,0);
|
||
return r;
|
||
end
|
||
function GetNodeByListIndex(id);virtual;
|
||
begin
|
||
return GetExpandedNodeById(FRootNode,0,id);
|
||
end
|
||
function getcdnodes(nd,r);
|
||
begin
|
||
if not ifarray(r)then r := array();
|
||
for i := 0 to nd.NodeCount-1 do
|
||
begin
|
||
cnd := nd.GetNodeByIndex(i);
|
||
r[cnd.FNodeid]:= nil;
|
||
getcdnodes(cnd,r);
|
||
end
|
||
end
|
||
Property RootNode read FRootNode;
|
||
Private
|
||
function GetExpandedNodes(nd,r,ct);
|
||
begin
|
||
for i := 0 to nd.NodeCount-1 do
|
||
begin
|
||
cnd := nd.GetNodeByIndex(i);
|
||
r[ct++]:= cnd;
|
||
if cnd.NodeCount>0 and cnd.Expanded then GetExpandedNodes(cnd,r,ct);
|
||
end
|
||
end
|
||
function GetExpandedNodeById(nd,ct,id);
|
||
begin
|
||
for i := 0 to nd.NodeCount-1 do
|
||
begin
|
||
cnd := nd.GetNodeByIndex(i);
|
||
if ct=id then return cnd;
|
||
ct++;
|
||
if cnd.NodeCount>0 and cnd.Expanded then
|
||
begin
|
||
r := GetExpandedNodeById(cnd,ct,id);
|
||
if r then return r;
|
||
end
|
||
end
|
||
end
|
||
private
|
||
FRootNode;
|
||
end
|
||
function tdbgcallback();
|
||
begin
|
||
global g_tsldbgcallback_handle;
|
||
if g_tsldbgcallback_handle then call(g_tsldbgcallback_handle,sysparams);
|
||
end
|
||
function ejsonformat(d,tbw);
|
||
begin
|
||
return exportjsonformat(d,tbw);
|
||
end
|
||
|
||
initialization
|
||
|
||
|
||
end.
|
||
|
||
|
||
///////////////暂时不用函数//////
|
||
(*
|
||
|
||
function getobjtransfunc();
|
||
begin
|
||
return %%
|
||
function _show_dbg_obj(o_,ct,mus);
|
||
begin
|
||
r := array();
|
||
if ifarray(o_) then
|
||
begin
|
||
for i,v in o_ do
|
||
begin
|
||
r[i] := _show_dbg_obj(v,ct,mus);
|
||
end
|
||
return r;
|
||
end else
|
||
if not ifobj(o_) then return o_;
|
||
if not ifarray(mus) then mus := array();
|
||
if o_ in mus then return "<object>";
|
||
o := o_;
|
||
obk := o;
|
||
try
|
||
stk := array();
|
||
idx :=0;
|
||
while idx<(ct>0?ct:3) do
|
||
begin
|
||
mus[length(mus)] := o;
|
||
d := o.classinfo();
|
||
stk[idx,0] := o;
|
||
stk[idx,1] := d;
|
||
inh := d["inherited"];
|
||
if not inh then break;
|
||
o := findclass(inh[0],o);
|
||
idx++;
|
||
end
|
||
for idx := length(stk)-1 downto 0 do
|
||
begin
|
||
o:=stk[idx,0];
|
||
for i,v in stk[idx,1,"properties"] do
|
||
begin
|
||
n := v["name"];
|
||
if v["read"] and (v["access"] in array(0,1)) then
|
||
begin
|
||
r[n] := 0;
|
||
|
||
end else
|
||
begin
|
||
reindex(r,array(n:nil));
|
||
end
|
||
end
|
||
for i,v in stk[idx,1,"members"] do
|
||
begin
|
||
n := v["name"];
|
||
if v["access"] in array(0,1) then
|
||
begin
|
||
r[n] := 0;
|
||
|
||
end else
|
||
begin
|
||
reindex(r,array(n:nil));
|
||
end
|
||
end
|
||
|
||
end
|
||
rs := mrows(r,1) ;
|
||
for i := length(rs)-1 downto 0 do
|
||
begin
|
||
v := rs[i];
|
||
nv := invoke(obk,v);
|
||
if datatype(nv)=7 then r[v] := "<function>";
|
||
else if ifarray(nv) then r[v] := _show_dbg_obj(nv,ct,mus);
|
||
else if ifobj(nv) then r[v] := _show_dbg_obj(nv,ct,mus);
|
||
else r[v] := _show_dbg_obj(nv,ct,mus);
|
||
end
|
||
except
|
||
return r;
|
||
end;
|
||
return r;
|
||
end
|
||
%%;
|
||
end
|
||
|
||
*) |