界面库

优化调试

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,10 +1089,6 @@ 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);
         end 
         for i,v in d["object"] do 
@@ -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 

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,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":"保存窗口");
+        r := inherited;
-        idx := 0;
+        r := select * from r where ["caption"] in array("打开tfm文件","打开tsf文件","粘贴") end;
-        r[idx++] := array("type":"menu","caption":"打开tsf文件","onclick":thisfunction(OpenClass));
+        idx := length(r);
-        r[idx++] := array("type":"menu","caption":"打开tfm文件","onclick":thisfunction(opentfm));
+        //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

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();
@@ -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

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,14 +251,28 @@ 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
@@ -279,19 +281,14 @@ type TTmfParserToken = class(TTmfParserbase)
                 end else
                     delct(r,tv,len,TT_HEX);
             end else            
-            if c='"' or c="'" then
+            if(FNumbers[c]) and(not(ct))then
             begin
-                delct(r,ct,len,TT_SYM);
+                //delct(r,ct,len,TT_SYM);
-                delct(r,Pstring(c),len,TT_STR);
+                v := c+Pnumber();
-            end else
+                delct(r,v,len,TT_NUM);
-            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);
             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