diff --git a/designer/tslvcldesigner.tsf b/designer/tslvcldesigner.tsf index 6b76ccb..ad7904f 100644 --- a/designer/tslvcldesigner.tsf +++ b/designer/tslvcldesigner.tsf @@ -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 diff --git a/designer/utslvcldcomponents.tsf b/designer/utslvcldcomponents.tsf index 233a826..b446aca 100644 --- a/designer/utslvcldcomponents.tsf +++ b/designer/utslvcldcomponents.tsf @@ -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,12 +388,14 @@ 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)), ("type":"menu","caption":"粘贴","id":"paste","onclick":thisfunction(pasteclick)), ("type":"menu","caption":"上移","onclick":thisfunction(MoveComponentUp)), - ("type":"menu","caption":"下移","onclick":thisfunction(MoveComponentDown)) + ("type":"menu","caption":"下移","onclick":thisfunction(MoveComponentDown)) ); if not IsContainer() then r := select * from r where ["caption"]<>"粘贴" end; return r; @@ -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 diff --git a/designer/utslvcldebuger.tsf b/designer/utslvcldebuger.tsf index b31dac9..13f9ced 100644 --- a/designer/utslvcldebuger.tsf +++ b/designer/utslvcldebuger.tsf @@ -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(); @@ -889,11 +893,19 @@ type TTslDebuga=class(TCustomControl) end "DebugInfo": //调试信息 begin - if "dbgdetach"=remotewaitinit(d)then return; - toolbtnState("暂停"); + 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 ; @@ -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 diff --git a/funcext/tvclib/uvcpropertytypespersistence.tsf b/funcext/tvclib/uvcpropertytypespersistence.tsf index bcea958..73e124f 100644 --- a/funcext/tvclib/uvcpropertytypespersistence.tsf +++ b/funcext/tvclib/uvcpropertytypespersistence.tsf @@ -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 + 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 c="0" and (not ct)then begin tv := PHexNumber(); if tv="d" then begin ct := c; end else - delct(r,tv,len,TT_HEX); - end else - if c='"' or c="'" then + delct(r,tv,len,TT_HEX); + end else + if(FNumbers[c]) and(not(ct))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",";",",") - begin - if ct="0" and pnumber then delct(r,ct,len,TT_NUM); - else delct(r,ct,len,TT_SYM); + //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:=""; @@ -309,34 +306,12 @@ type TTmfParserToken = class(TTmfParserbase) ct+=c; 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 } + 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