liujianjun
/
tslediter
3
0
Fork 1
Code Issues Pull Requests Projects Releases Wiki Activity

界面库 

优化调试
This commit is contained in:
JianjunLiu 2022-11-10 11:19:47 +08:00
parent 73102c6d46
commit 6d2e542ed7
4 changed files with 107 additions and 95 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
designer/tslvcldesigner.tsf
View File

@ -1047,7 +1047,7 @@ type TVclDesigner = class(tvcform)
it.Imgs := fdimagelist.GetImageId("tdcreateform");
end
comp := it.ComponentCreater(node,wr);
//if first then comp.Cwnd.visible := false;
if first then comp.Cwnd.Handle;
comp.isinherited := d["inherited"];
comp.inheritedparent := d["parent"];
comp.name := d["name"];
@ -1089,11 +1089,7 @@ type TVclDesigner = class(tvcform)
lazy[length(lazy)] := array(n,setddpv,pp);
continue;
end
if first and n="visible" then
begin
firstvisible := array(comp,setddpv,pp);
end else
comp.SetComponentProperties(n,setddpv,pp);
comp.SetComponentProperties(n,setddpv,pp);
end
for i,v in d["object"] do
begin
@ -1103,14 +1099,6 @@ type TVclDesigner = class(tvcform)
begin
comp.SetComponentProperties(v[0],v[1],v[2]);
end
if firstvisible then
begin
comp.SetComponentProperties("visible",firstvisible[1],firstvisible[2]);
end
if first then
begin
comp.Cwnd.Handle;
end
BindCwndMessage(comp.Cwnd);
//comp.DoControlAlign();
end

58
designer/utslvcldcomponents.tsf
View File

@ -90,6 +90,28 @@ type TDComponent = class()
begin
return feventnametable[FDefaultEvent];
end
function OpenClass(o,e);
begin
cp:=o.Component;
if not cp then exit;
nd := cp.TreeNode;
if nd then d := nd.owner.Designer;
if d then
begin
d.openclassfile();
end
end
function opentfm(o,e);
begin
cp:=o.Component;
if not cp then exit;
nd := cp.TreeNode;
if nd then d := nd.owner.Designer;
if d then
begin
d.opentfm();
end
end
public
function libs();virtual;
begin
@ -366,6 +388,8 @@ type TDComponent = class()
function menus();virtual; //菜单项
begin
r := array(
("type":"menu","caption":"打开tsf文件","onclick":thisfunction(OpenClass)),
("type":"menu","caption":"打开tfm文件","onclick":thisfunction(opentfm)),
("type":"menu","caption":"删除","id":"delete","onclick":thisfunction(deleteclick)),
("type":"menu","caption":"复制","id":"copy","onclick":thisfunction(copyclick)),
("type":"menu","caption":"剪切","id":"cut","onclick":thisfunction(cutclick)),
@ -886,39 +910,17 @@ type TDForm = class(TDComponent)
d.saveCurrentForm();
end
end
function OpenClass(o,e);
begin
cp:=o.Component;
if not cp then exit;
nd := cp.TreeNode;
if nd then d := nd.owner.Designer;
if d then
begin
d.openclassfile();
end
end
function opentfm(o,e);
begin
cp:=o.Component;
if not cp then exit;
nd := cp.TreeNode;
if nd then d := nd.owner.Designer;
if d then
begin
d.opentfm();
end
end
public
function menus();override;
begin
r := array();
//r[0] := array("type":"menu","caption":"保存窗口");
idx := 0;
r[idx++] := array("type":"menu","caption":"打开tsf文件","onclick":thisfunction(OpenClass));
r[idx++] := array("type":"menu","caption":"打开tfm文件","onclick":thisfunction(opentfm));
r := inherited;
r := select * from r where ["caption"] in array("打开tfm文件","打开tsf文件","粘贴") end;
idx := length(r);
//r[idx++] := array("type":"menu","caption":"打开tsf文件","onclick":thisfunction(OpenClass));
r[idx++] := array("type":"menu","caption":"关闭窗口","onclick":thisfunction(closecurrentform));
r[idx++] := array("type":"menu","caption":"保存窗口","onclick":thisfunction(savecurrentform));
r[idx++] := array("type":"menu","caption":"粘贴","onclick":thisfunction(pasteclick));
//r[2] := array("type":"menu","caption":"打开工程目录","onclick":thisfunction(openProjectDir));
return r;
end
@ -3406,7 +3408,7 @@ type TDPairSplitterSide = class(TDComponent)
function menus();override;
begin
r := inherited;
return select * from r where ["caption"] in array("删除","粘贴","剪切") end ;
return select * from r where ["caption"] in array("删除","粘贴","剪切","打开tsf文件","打开tfm文件") end ;
end
function InToolBar();override;
begin

20
designer/utslvcldebuger.tsf
View File

@ -271,6 +271,8 @@ type TTslDebuga=class(TCustomControl)
FDebugtsfs; //当前工程对应的tsf文件
FBtns;
FAttchedid;
fremotedbugstart;
fscriptbrks;//¼Ç¼½Å±¾µÄ¶Ïµã
FDebugtype;
fdbgselwnd;
FRemoteWait; //远程调试等待
@ -603,6 +605,8 @@ type TTslDebuga=class(TCustomControl)
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();
@ -890,10 +894,18 @@ type TTslDebuga=class(TCustomControl)
"DebugInfo": //调试信息
begin
if "dbgdetach"=remotewaitinit(d)then return;
toolbtnState("ÔÝÍ£");
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 ;
@ -1582,7 +1594,11 @@ type TTslDebuga=class(TCustomControl)
lines := FRuningItem.FEditer.Lines;
for idx := 0 to Lines.Length()-1 do
begin
if Lines[idx].FMarked then addbreak(FRuningItem,idx,"__main__");
if Lines[idx].FMarked then
begin
addbreak(FRuningItem,idx,"__main__");
fscriptbrks[idx]:= true;
end
end
end
end

100
funcext/tvclib/uvcpropertytypespersistence.tsf
View File

@ -142,7 +142,7 @@ type TTmfParserToken = class(TTmfParserbase)
ct := "";
end else
begin
if not(ct) then return ;
if ct="" then return ;
if n=TT_NUM then
begin
if pos(".",ct)then ct := strtofloat(ct);
@ -152,18 +152,6 @@ type TTmfParserToken = class(TTmfParserbase)
r[len++]:= array(ct,n);
ct := "";
end
return ;
if ct or(n=TT_STR)then
begin
if n=TT_NUM then
begin
if pos(".",ct)then ct := strtofloat(ct);
else ct := strtoint(ct);
end
if n=TT_SYM then ct := lowercase(ct);
r[len++]:= array(ct,n);
ct := "";
end
end
function GetNumber(len);//½âÎöÊý×Ö
begin
@ -263,35 +251,44 @@ type TTmfParserToken = class(TTmfParserbase)
r := array();
len := 0;
ct := ""; //µ±Ç°×Ö·û
pnumber := true;
kb := array(" ":1,"\t":1,"\r":1,"\n":1);
fgf := array(' ':1,'\t':1,"\r":1,"\n":1,";":1,",":1);
sns := array("=":1,":":1,"(":1,")":1,"<":1,">":1,"[":1,"]":1);
while whileok() do
begin
c := cchar();
if c="0" and pnumber and(not ct)then
if fgf[c] then // in array(' ','\t',"\r","\n",";",",")
begin
tv := PHexNumber();
if tv="d" then
begin
ct := c;
end else
delct(r,tv,len,TT_HEX);
if ct="0" then delct(r,ct,len,TT_NUM);
else delct(r,ct,len,TT_SYM);
end else
if sns[c]then
begin
delct(r,ct,len,TT_SYM);
delct(r,c,len,TT_SIG);
end else
if c='"' or c="'" then
begin
delct(r,ct,len,TT_SYM);
delct(r,Pstring(c),len,TT_STR);
end else
if fgf[c] then // in array(' ','\t',"\r","\n",";",",")
if c="0" and (not ct)then
begin
if ct="0" and pnumber then delct(r,ct,len,TT_NUM);
else delct(r,ct,len,TT_SYM);
tv := PHexNumber();
if tv="d" then
begin
ct := c;
end else
delct(r,tv,len,TT_HEX);
end else
if(FNumbers[c]) and(not(ct))then
begin
//delct(r,ct,len,TT_SYM);
v := c+Pnumber();
delct(r,v,len,TT_NUM);
end else
if c="{" then
begin
//pnumber := false;
delct(r,ct,len,TT_SYM);
delct(r,c,len,TT_SIG);
ct:="";
@ -310,33 +307,11 @@ type TTmfParserToken = class(TTmfParserbase)
end
end
end else
// if c="}" then
// begin
// delct(r,ct,len,TT_SYM);
// delct(r,c,len,TT_SIG);
// pnumber := true;
// end else
if sns[c]then
begin
delct(r,ct,len,TT_SYM);
delct(r,c,len,TT_SIG);
end else
{if c ="." then
begin
delct(r,ct,len,TT_SYM);
delct(r,c,len,TT_POI);
end else }
if c="-" then
begin
delct(r,ct,len,TT_SYM);
delct(r,c+Pnumber(),len,TT_NUM);
end else
if(FNumbers[c])and pnumber and(not(ct)) {(not(ct)) and (r[len][0]="=")}then
begin
delct(r,ct,len,TT_SYM);
v := c+Pnumber();
delct(r,v,len,TT_NUM);
end else
begin
ct += c;
end
@ -380,6 +355,34 @@ type TTmfParserToken = class(TTmfParserbase)
c := lowercase(c);
//its := inttostr(0 -> 9)union array("a","b","c","d","e","f");
r := "";
case c of
"x":
begin
while whileok() do
begin
c := cchar();
if not(FHexnumbers[c])then
begin
cback();
break;
end
r += c;
end
if r then return eval(&("0x"+r));
return 0;
end
"l":
begin
return 0;
end
else
begin
cback();
return "d";
end
end;
if c="x" then
begin
while whileok() do
@ -483,11 +486,14 @@ type TTmfParser = class(TTmfParserbase)
if (fs <> s) and ifstring(s) then
begin
FParsers.Script := s;
//setprofiler(1+2+4+8);
FTokens := FParsers.gettokens();
FTokenlen := length(FTokens);
FCurrent := 0;
FTree := nil;
ftreeobj := nil;
//d := getprofilerinfo();
//exportfile(ftstream(),"","d:\\tst\\abc.stm",d);
end
end
public