3272 lines
95 KiB
Plaintext
3272 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;
|
|
FCOMPOSITIONFORM := new tagCOMPOSITIONFORM(nil);
|
|
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 WMIMESTARTCOMPOSITION(o,e):WM_IME_STARTCOMPOSITION;virtual;
|
|
begin
|
|
ime := ImmGetContext(self.Handle);
|
|
FCOMPOSITIONFORM.ptcurrentpos.cx := 200;
|
|
FCOMPOSITIONFORM.ptcurrentpos.cy := 200;
|
|
ImmSetCompositionWindow(ime,FCOMPOSITIONFORM._getptr_());
|
|
ImmReleaseContext(self.Handle,ime);
|
|
end
|
|
{$ifdef linux}
|
|
function ImmReleaseContext();
|
|
begin
|
|
end;
|
|
function ImmGetContext();
|
|
begin
|
|
end;
|
|
function ImmSetCompositionWindow();
|
|
begin
|
|
end;
|
|
function ImmSetStatusWindowPos();
|
|
begin
|
|
end;
|
|
{$else}
|
|
function ImmReleaseContext(h:pointer;ime:pointer):integer;stdcall;external "Imm32.dll" name "ImmReleaseContext";
|
|
function ImmGetContext(h:pointer):pointer;stdcall;external "Imm32.dll" name "ImmGetContext";
|
|
function ImmSetCompositionWindow(h:pointer;s:pointer):integer;stdcall;external "Imm32.dll" name "ImmSetCompositionWindow";
|
|
function ImmSetStatusWindowPos(h:pointer;s:pointer):integer;stdcall;external "Imm32.dll" name "ImmSetStatusWindowPos";
|
|
{$endif}
|
|
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]then return;
|
|
if fy>r[3]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;
|
|
FCOMPOSITIONFORM;
|
|
FOnCaretChanged;
|
|
end
|
|
implementation
|
|
type tagCOMPOSITIONFORM=class(tslcstructureobj)
|
|
private
|
|
static SSTRUCT;
|
|
class function getstruct()
|
|
begin
|
|
if not SSTRUCT then SSTRUCT := MemoryAlignmentCalculate(array(
|
|
("dwstyle","int",4),
|
|
("ptcurrentpos","intptr",0),
|
|
("rcarea","int[4]",array(0,0,0,0))),nil,nil,1);
|
|
return SSTRUCT;
|
|
end
|
|
public
|
|
function create()
|
|
begin
|
|
inherited create(getstruct(),ptr);
|
|
FPonter := new TCPoint();
|
|
_setvalue_("ptcurrentpos",FPonter._getptr_());
|
|
end
|
|
property dwstyle index "dwstyle" read _getvalue_ write _setvalue_;
|
|
property ptcurrentpos read FPonter;
|
|
property rcarea index "rcarea" read _getvalue_ write _setvalue_;
|
|
private
|
|
FPonter;
|
|
end
|
|
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; //编辑器的调试器
|
|
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
|
|
plg := pluginpath();
|
|
{$ifdef linux}
|
|
sp := "/";
|
|
{$else}
|
|
sp := "\\";
|
|
{$endif}
|
|
for i := length(plg)-1 downto 1 do
|
|
begin
|
|
if plg[i]=sp then
|
|
begin
|
|
fn := plg[1:i]+"FunCache.ini";
|
|
r := filedelete("",fn);
|
|
return r;
|
|
end
|
|
end
|
|
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;
|
|
dirs := owner.getlibpathstr();
|
|
parsercurrentitem(item);
|
|
fio := ioFileseparator();
|
|
FDebugUsr := 0;
|
|
FDebugPwd := 0;
|
|
deletefuncacheini();
|
|
getdebuger(pms);
|
|
exestr := format('"%s" "%s" -DEBUGSERVER -DEBUGLOGIN 0 -WAITATTACH -DEBUGPORT %d -libpath "%s" ',FDebugExe,FRuningfile,FDebugport,dirs);
|
|
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("showeval","调试程序:"+FDebugExe);
|
|
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;
|
|
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 := 23;
|
|
FStackList.Columns := array(("text":"line","width":40),
|
|
("text":"function","width":250) //,("text":"type","width":70)
|
|
);
|
|
FStackList.Border := true;
|
|
FVaraiblesList := new TGroupGridA(self);
|
|
FVaraiblesList.Border := false;
|
|
FVaraiblesList.ItemHeight := 23;
|
|
FVaraiblesList.Columns := array(("text":"name","width":95),
|
|
("text":"value","width":135),
|
|
("text":"type","width":50)
|
|
);
|
|
FCommandtext := new TEdit(self);
|
|
FCommandtext.placeholder := "命令输入框";
|
|
FCommandtext.Height := 23;
|
|
FCommandtext.onkeyup := thisfunction(cmdkeyup);
|
|
FShowText := new tmemo(self);
|
|
FShowText.ReadOnly := true;
|
|
FShowText.Border := true;
|
|
pmenu := new TPopUpMenu(self);
|
|
cmu := new TMenu(self);
|
|
cmu.OnClick := function(o,e)
|
|
begin
|
|
FShowText.Text := "";
|
|
end;
|
|
cmu.Caption := "清除";
|
|
cmu.Parent := pmenu;
|
|
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
|
|
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(dwProcessID,api) //通过进程ID获取窗口句柄
|
|
begin
|
|
h := api.GetTopWindow(0);
|
|
while(h) do
|
|
begin
|
|
pid := 0;
|
|
dwTheardId := api.GetWindowThreadProcessId(h,pid);
|
|
if(dwTheardId <> 0)then
|
|
begin
|
|
if(pid=dwProcessID)then
|
|
begin
|
|
// here h is the handle to the window
|
|
while(api.GetParent(h)<> 0) do h := api.GetParent(h);
|
|
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");
|
|
{$ifdef linux}
|
|
{$else}
|
|
if not Fdebugedwhandle then
|
|
Fdebugedwhandle := GetWindowHandleByPID(_wapi.GetProcessId(fdebugproc.Handle),_wapi);
|
|
if Fdebugedwhandle then
|
|
begin
|
|
_wapi.SetForegroundWindow(Fdebugedwhandle);
|
|
end
|
|
{$endif}
|
|
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("showeval","调试结束");
|
|
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
|
|
"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.SetForegroundWindow(self.Handle); //移动到前端 SetForegroundWindow BringWindowToTop
|
|
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("showeval","调试结束");
|
|
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
|
|
"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 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); //获得调试程序
|
|
begin
|
|
p := static pluginpath();
|
|
FDebugExe := inireadstring("",p+"localediter.ini","debug","debuger","");
|
|
pms := " ";
|
|
//if FDebugExe="1" then //默认获取参数
|
|
// begin
|
|
ps := owner.getexecuteparams(FRuningfile);
|
|
if ps then
|
|
begin
|
|
psi := ps[0];
|
|
if fileexists("",psi)then
|
|
begin
|
|
cmdexe := psi;
|
|
end else
|
|
begin
|
|
if FDebugExe="1" then
|
|
ExecuteCommand("showeval","当前指定的执行程序不存在!!");
|
|
end
|
|
psi := ps[1];
|
|
if 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
|
|
begin
|
|
idx += 2;
|
|
continue;
|
|
end
|
|
pms += " "+tostn(psi);
|
|
idx++;
|
|
end
|
|
end
|
|
//end
|
|
if(FDebugExe="1")and cmdexe then
|
|
begin
|
|
FDebugExe := cmdexe;
|
|
ExecuteCommand("showeval","<当前执行程序(F9)做调试器>");
|
|
end else
|
|
if fileexists("",FDebugExe)then
|
|
begin
|
|
ExecuteCommand("showeval","<用配置文件给定的调试器>");
|
|
end else
|
|
begin
|
|
FDebugExe := fdefaultdbger;
|
|
ExecuteCommand("showeval","<用编辑器自带的调试器b:>");
|
|
end
|
|
end
|
|
function remotedbugok();
|
|
begin
|
|
if FAttchedid then
|
|
begin
|
|
ExecuteCommand("showeval","远程启动脚本:"+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("showeval","开始调试");
|
|
//toolbtnState("暂停");
|
|
remotedbugok();
|
|
return;
|
|
end
|
|
function opengoto(v);
|
|
begin
|
|
cn := v["NAME"];
|
|
cnn := "";
|
|
for ii := 1 to length(cn) do
|
|
begin
|
|
if cn[ii]in array(".",":")then
|
|
begin
|
|
cn := cnn;
|
|
break;
|
|
end
|
|
cnn += cn[ii];
|
|
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("showeval",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 := 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;
|
|
end
|
|
"继续":
|
|
begin
|
|
//运行
|
|
//FBtns["继续"].Visible := false;
|
|
FBtns["进入"].Visible := false;
|
|
FBtns["跳出"].Visible := false;
|
|
FBtns["下一行(F8)"].Visible := false;
|
|
//FBtns["单步"].Visible := false;
|
|
//FBtns["终止"].Visible := false;
|
|
FBtns["暂停"].Visible := true;
|
|
FBtns["刷新符号表"].Visible := false;
|
|
FBtns["刷新当前符号"].Visible := false;
|
|
end
|
|
"停止":
|
|
begin
|
|
hiddenbtns();
|
|
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;
|
|
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
|
|
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
|
|
|
|
*) |