设计器

优化体验

designer/tslvcldesigner.tsf

@@ -1203,6 +1203,18 @@ type TVclDesigner = class(tvcform)
                 end 
             end 
         end 
+        ebtn := FProjectManager.FTslEditer.gettoolbarbtn((3->13));//处理其他的工具按钮
+        for i,v in ebtn do 
+        begin
+            v._tag := array(function(o,e)begin FProjectManager.ShowEditor(); end ,v.onclick);  
+            v.onclick := function(o,e)
+            begin
+                for i,v in o._tag do 
+                begin
+                    CallDataFunction(v,o,e);
+                end 
+            end   
+        end 
         tlbar.Align := alLeft;
         tlbar.width :=450;
         tlbar.parent := self;

designer/udesignerproject.tsf

@@ -489,6 +489,7 @@ type TProjectView = class(TVCForm) //
         FOpenMenu.OnClick := thisfunction(OpenTreeNode);
         FOpenMenu.parent := fpm;
         FTree.OnSelChanged := thisfunction(TreeNodeChanged);
+        ftree.OnSelChanging := thisfunction(treenodechanging);
         FTree.OnDblClick := function(o,e)
         begin
             OpenTreeNode();
@@ -499,6 +500,7 @@ type TProjectView = class(TVCForm) //
     end
     function setnodesel(nd);
     begin
+        if fopenbuzy then return ;
         ftree.setsel(nd);
     end 
     function OpenTreeNode(); //打开当前节点
@@ -517,8 +519,16 @@ type TProjectView = class(TVCForm) //
             OpenFileByName(cn.FName);
         end
     end
+    function treenodechanging(o,e);
+    begin
+        if fopenbuzy then 
+        begin
+            e.skip := true;
+        end 
+    end 
     function TreeNodeChanged(o,e); //节点切换
     begin
+        
         if FTree.PopUpMenu then 
         begin 
             it := e.itemnew;
@@ -772,6 +782,7 @@ type TProjectView = class(TVCForm) //
 
     function OpenFileByName(n); //打开文件 
     begin
+        if fopenbuzy then return ;
         fio := ioFileseparator();
         if not(n and ifstring(n)) then return FDesigner.ExecuteCommand("hiddrennode",nil);;
         nopend := FTree.NameInTree(n,nil,true);
@@ -784,6 +795,7 @@ type TProjectView = class(TVCForm) //
         begin
             return 0;
         end
+        
         FCurrentOpend := nopend;
         case FCurrentOpend["type"]of
             "tsl","tsf":
@@ -816,6 +828,8 @@ type TProjectView = class(TVCForm) //
                     return messageboxa("非窗口类,或者该文件已经损坏","错误",0,self);
                 end
                 //打开界面
+            
+                fopenbuzy := true;
                 FDesigner.caption := "TVCL界面设计器 "+FprojName+"->"+FCurrentOpend["name"];
                 FTmfParser.fssourdirs := FCurrentOpend.gettmfdirs();
                 tfm := FCurrentOpend.gettmfname();
@@ -833,6 +847,7 @@ type TProjectView = class(TVCForm) //
                     FDesigner.LoadTreeNode(FTmfParser,inh,FCurrentOpend);
                     FDesigner.EditerCodeChanged();
                 end 
+                fopenbuzy := false;
             end else
             begin
                 FDesigner.ExecuteCommand("hiddrennode",nil);
@@ -842,6 +857,7 @@ type TProjectView = class(TVCForm) //
                 return;
             end
         end
+        fopenbuzy := false;
     end
     function getwindowinherited2(fn);
     begin
@@ -1667,6 +1683,7 @@ end
     FTslEditer;  
     property tree read ftree;  
     private 
+    fopenbuzy;
 end
 
 type TTslEditer = class(TEditer)

designer/utslcodeeditor.tsf

@@ -2144,8 +2144,19 @@ type TEditer=class(TCustomcontrol) //
     begin
         return fcoolbar;//FToolbar;
     end 
-    function gettoolbarbtn();
+    function gettoolbarbtn(idxs);
     begin
+        if ifarray(idxs) then 
+        begin 
+            r := array();
+            ri := 0;
+            for i,v in idxs do 
+            begin
+                bi := ftoolbara.getbtnbyindex(v);
+                if bi then r[ri++] := bi;
+            end 
+            return r;
+        end 
         return array(ftoolbara.getbtnbyindex(1),ftoolbara.getbtnbyindex(2));
     end 
     function ShowLogWnd(flg);

funcext/tvclib/tcustomscrollcontrol.tsf

@@ -1,4 +1,7 @@
 type tcustomscrollcontrol = class(TCustomControl)
+{**
+    @explan(说明)带滚动条的窗口类 %%
+**}
     uses utslvclmemstruct;
     {**
     @explan(说明) 带滚动条的自绘制窗口 %%
@@ -232,7 +235,7 @@ type tcustomscrollcontrol = class(TCustomControl)
             // 用户拖动滚动条
             SB_THUMBTRACK:
             begin
-                if ThumbTrack then
+                if FThumbTrack then
                 begin
                     FSI.nPos := FSI.nTrackPos;
                 end
@@ -296,7 +299,7 @@ type tcustomscrollcontrol = class(TCustomControl)
             // 用户拖动滚动条
             SB_THUMBTRACK:
             begin
-                if ThumbTrack then
+                if FThumbTrack then
                 begin
                     FSI.nPos := FSI.nTrackPos;
                 end
@@ -364,6 +367,7 @@ type tcustomscrollcontrol = class(TCustomControl)
     function AfterConstruction();override;
     begin
         inherited;
+        FThumbTrack := true;
         FLocalX := 0;
         FLocalY := 0;
         FLocalXold := 0;
@@ -372,8 +376,13 @@ type tcustomscrollcontrol = class(TCustomControl)
         FSI := new TScrollinfo();
         FSI.cbSize := FSI._size_;
     end 
-    property AutoScroll read FAutoScroll write SetAutoScroll;
+    property AutoScroll:integer read FAutoScroll write SetAutoScroll;
-    property ThumbTrack read FThumbTrack write FThumbTrack;
+    property ThumbTrack:bool read FThumbTrack write FThumbTrack;
-    property WhileStep read FWhileStep write SetWhileStep; //滚动步长
+    property WhileStep:integer  read FWhileStep write SetWhileStep; //滚动步长
+    {**
+        @param(AutoScroll)(integer) 0,1,2,3 滚动条模式 %%     
+        @param(ThumbTrack)(bool) 拖动按钮 %%     
+        @param(WhileStep)(integer) 滚动步长 %%     
+    **}
 
 end 

funcext/tvclib/utslmemo.tsf

@@ -632,6 +632,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
     @explan(说明) 带滚动条的编辑控件 %%
     **}
     private
+    ftmemlockv;
     fundoing; //清空unredo标记
     fredoing; //清空unredo标记
     fselectbkcolor;//rgb(192,192,192);
@@ -1006,6 +1007,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
     function Create(AOwner);override;
     begin
         inherited;
+        ftmemlockv := new tmemlockv();
         FGutterColor := rgb(228,228,228);
         fcurrentLineColor := rgb(232,232,255);
         fselectbkcolor := rgb(192,192,192);
@@ -1106,7 +1108,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
     end
     function MouseDown(o,e);override; //按下鼠标
     begin
-        if class(tmemlocker).haslocker then return ;
+        if ftmemlockv.haslocker then return ;
         inherited;
         if e.skip then return ;
         IncPaintLock();
@@ -1153,7 +1155,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
     end
     function MouseUp(o,e);override;
     begin
-        if class(tmemlocker).haslocker then return ;
+        if ftmemlockv.haslocker then return ;
         inherited;
         if e.skip then return;
         UnClipCursor();
@@ -1180,7 +1182,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
     end
     function keypress(o,e);override;  //输入字符
     begin
-        if class(tmemlocker).haslocker then return ;
+        if ftmemlockv.haslocker then return ;
         if e.skip then return;
         c := e.wparam;
         if ReadOnly then return;
@@ -1248,7 +1250,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
     begin
         if fUndoList.CanUndo then
         begin
-            lk := new tmemlocker();
+            lk := new tmemlocker(ftmemlockv);
             UndoItem();
         end
     end
@@ -1256,7 +1258,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
     begin
         if fRedoList.CanUndo then 
         begin
-            lk := new tmemlocker();
+            lk := new tmemlocker(ftmemlockv);
             RedoItem();
         end 
     end
@@ -4094,17 +4096,33 @@ type TSynMemoNorm = class(TsynCustomMemo) //
     FSheetTabFlage;   
 end 
 Implementation
-type tmemlocker = class() //锁定对象
+type tmemlockv = class()
-    static haslocker;
+    haslocker;
     function create();   
+    begin
+        haslocker := 0;
+    end  
+    function add();
     begin
         haslocker++;
     end 
-    function destroy();
+    function del();
     begin
         haslocker--;    
     end 
 end 
+type tmemlocker = class() //Ëø¶¨¶ÔÏó
+    function create(v);
+    begin
+        flk := v;
+        flk.add();
+    end 
+    function destroy();
+    begin
+        flk.del();
+    end 
+    flk;
+end 
 function CreateATslMemoUndoItem(AReason,AStart,AEnd,ChangeText,SelMode);
 begin
     return new TTslMemoUndoItem(AReason,AStart,AEnd,ChangeText,SelMode);

funcext/tvclib/utslvclcoolbar.tsf

@@ -13,6 +13,7 @@ type tcustomcoolbar=class(tcustomcontrol)
         fcoolbands := new tcoolbarlines();
         fbtnwidth := 20;
         fautosize := true;
+        fdoaligncount :=0;
         inherited;
              
     end
@@ -41,15 +42,14 @@ type tcustomcoolbar=class(tcustomcontrol)
     end
     function Notification(o,op);override;
     begin
-        if  class(tcoolbarlocker).haslocker then  return ;
+        if fsizelocker then return ;
         if (o is class(TWinControl)) and o.WsPopUp then return ;
         if HandleAllocated() and ifarray(op) and (op["type"]="possize") then //位置大小发送变化 
         begin 
             ctls := controls;
             if (ctls.IndexOf(o)>=0)  then //子控件大小变化
             begin 
-                doControlALign();
+                doControlALign();//InvalidateRect(nil,false);
-                InvalidateRect(nil,false);
                 return ;               
             end     
         end 
@@ -177,7 +177,7 @@ type tcustomcoolbar=class(tcustomcontrol)
         y := 0;
         rhs := fcoolbands.getrowheights(); 
         bal := Align;
-        if autosize and ( bal =alTop or bal=alBottom) then 
+        if fdoaligncount<5 and autosize and ( bal =alTop or bal=alBottom) then 
         begin 
             rc := ClientRect;
             nh := sum(rhs);
@@ -189,10 +189,12 @@ type tcustomcoolbar=class(tcustomcontrol)
                 Align := alNone;
                 Height := bw+nh;
                 Align := bal;
+                fdoaligncount++;
                 return ;
             end 
         end 
-        lk := new tcoolbarlocker();
+        fdoaligncount := 0;
+        fsizelocker := true;
         for i,v in fcoolbands.data2 do 
         begin
             x := 0;   
@@ -245,6 +247,7 @@ type tcustomcoolbar=class(tcustomcontrol)
             end 
 
         end 
+        fsizelocker := false;
     end 
     function paint();override; //绘制
     begin
@@ -278,6 +281,7 @@ type tcustomcoolbar=class(tcustomcontrol)
     property arrange:lazystr read getarrange write setarrange;
     property dragbtncolor:color read fdragbtncolor write fdragbtncolor;
     private
+    fdoaligncount;
     fautosize ;
     fdragbtncolor;
     fsizelocker;
@@ -682,17 +686,6 @@ type tcoolbarlines = class() //
     end 
     flines;
 end
-type tcoolbarlocker = class() //Ëø¶¨¶ÔÏó
-    static haslocker;
-    function create();
-    begin
-        haslocker++;   
-    end 
-    function destroy();
-    begin
-        haslocker--;
-    end 
-end  
 function getmovebmp(); //移动图片
 begin
     return "0502000000060400000074797065000203000000696D670006040000006461746

funcext/tvclib/utslvcltree.tsf

@@ -88,7 +88,6 @@ type TcustomTreeCtlNode = class(TVirtualListItem)
     FExpandWidth; //展开按钮宽度
     FCheckWidth; //checkbox宽度
     FFocusColor;
-    //FNodeHash;
     FHierarchyWidth;
     function DrawCheckBox(cvs,x,rec,sz,flag); //绘制checkbox
     begin
@@ -108,7 +107,7 @@ type TcustomTreeCtlNode = class(TVirtualListItem)
             end else
             if ChildChecked()then
             begin
-                cvs.brush.color := rgb(10,10,10);
+                cvs.brush.color :=0x0a0a0a ;//rgb(10,10,10);
                 cvs.fillrect(dr[0]+8 union dr[1]-4);
                 ow := Owner;
                 if self=ow.CurrentNode then cvs.brush.color := FFocusColor[ow.hasFocus()];
@@ -175,7 +174,7 @@ type TcustomTreeCtlNode = class(TVirtualListItem)
         **}
         ow := Owner;
         if not ow then return;
-        cvs.Pen.Color := rgb(50,50,50);
+        cvs.Pen.Color := 0x323232;//rgb(50,50,50);
         cvs.Pen.style := PS_SOLID;
         cvs.Pen.width := 1;
         inv := 3;
@@ -243,11 +242,11 @@ type TcustomTreeCtlNode = class(TVirtualListItem)
         cvs.drawtext(FCaption,FCaptionRect,DT_VCENTER .| DT_SINGLELINE .| DT_NOPREFIX);
         if ow.HasLine then
         begin
-            cvs.Pen.Color := rgb(150,150,150);
+            cvs.Pen.Color := 0x969696;
             cvs.Pen.style := PS_DOT;
             for i,v in ow.GetHierarchyByHandle(self.Handle) do
             begin
-                FLG := TRUE;
+                //FLG := TRUE;
                 //nx := cbase-FHierarchyWidth*(i+1)+6;
                 nx := cbase+FHierarchyWidth *(i-FHierarchy-1)+6;
                 if nx>cbase-5 then break;
@@ -265,8 +264,8 @@ type TcustomTreeCtlNode = class(TVirtualListItem)
         {**
         @explan(说明) 点击消息处理
         **}
-        ps := e.pos;
+        //ps := e.pos;
-        px := ps[0];
+        px := e.xpos;//ps[0];
         rec := o.GetIndexRect(o.GetItemIndexByYpos(e.ypos)); //获得位置
         recx := rec[0];
         if(FItems.Count or FDirtype)and px >= FExpandPos and px <=(FExpandPos+FExpandWidth)then //点击展开
@@ -308,8 +307,7 @@ type TcustomTreeCtlNode = class(TVirtualListItem)
         FVisible := true;
         FMouseCanChecked := true;
         FModifyChildrenChecked := true;
-        FFocusColor := array(rgb(230,240,250),rgb(0,192,250));
+        FFocusColor := array(0xfaf0e6,0xfac000) ;//array(rgb(230,240,250),rgb(0,192,250));
-        //FNodeHash := array();
         FCheckWidth := 16;
         FExpandWidth := 12;
         FBasePos := 10;
@@ -1657,7 +1655,7 @@ type TcustomTreeCtl = class(TVirtualList)
         for i,it in its do if it is class(TcustomTreeCtlNode)then lst[lsti++]:= it;
         inherited InsertItems(lst,idx);
     end
-    function WMKEYUP(o,e):WM_KEYUP;virtual;
+    function WMKEYUP(o,e);override;
     begin
         if not FCurrentNode then return;
         if e.skip then return ;
@@ -1833,8 +1831,6 @@ type TcustomTreeCtl = class(TVirtualList)
     end
     function Recycling();override;
     begin
-        //setprofiler(1+2+4);
-        //exportfile(ftstream(),"","d:\\tst\\abc.stm",getprofilerinfo(true));
         flockchangedcall := true;
         if FRootItem then FRootItem.Recycling();
         flockchangedcall := false;
@@ -1842,7 +1838,6 @@ type TcustomTreeCtl = class(TVirtualList)
         FCurrentNode := nil;
         FOnSelChanging := nil;
         FonEmptyNodeExapanding := nil;
-        FNodeHierarchyWidth := 20;
         //fnodecreator := nil;
         inherited;
     end
@@ -1853,12 +1848,15 @@ type TcustomTreeCtl = class(TVirtualList)
     function EmptyNodeExpanding(item);
     begin
         if HandleAllocated()then
+        begin
+            if FonEmptyNodeExapanding then 
             begin 
                 e := new TTreeSelCHngedEvent(self.Handle,0,0,0);
                 e.item := item;
                 e.ItemNew := item;
                 e.ItemOld := item;
-            calldatafunction(onEmptyNodeExapanding,self(true),e);
+                calldatafunction(FonEmptyNodeExapanding,self(true),e);
+            end 
         end
     end
     function Clean();override;

funcext/tvclib/uvcpropertytypespersistence.tsf

@@ -84,6 +84,7 @@ type TTmfParserToken = class(TTmfParserbase)
     FScriptLen;
     FCurrent;
     FNumbers;
+    FHexnumbers;
     Ffloat;
     FTokens;
     FSplitter; //·Ö¸ô·û
@@ -246,6 +247,8 @@ type TTmfParserToken = class(TTmfParserbase)
         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);
         while whileok() do
         begin
             c := cchar();
@@ -263,23 +266,38 @@ type TTmfParserToken = class(TTmfParserbase)
                 delct(r,ct,len,TT_SYM);
                 delct(r,Pstring(c),len,TT_STR);
             end else
-            if c in array(' ','\t',"\r","\n",";",",")then
+            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;
+                //pnumber := false;
                 delct(r,ct,len,TT_SYM);
                 delct(r,c,len,TT_SIG); 
-            end else
+                ct:=""; 
+                while  whileok() do 
+                begin
+                    c := cchar();
+                    if kb[c] then continue;
                     if c="}" then 
                     begin
-                delct(r,ct,len,TT_SYM);
+                        delct(r,ct,len,TT_BIN);
                         delct(r,c,len,TT_SIG);
-                pnumber := true;
+                        break;
                     end else 
+                    begin
+                        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 c in array("=",":","(",")","<",">","[","]")then
             begin
                 delct(r,ct,len,TT_SYM);
@@ -295,7 +313,7 @@ type TTmfParserToken = class(TTmfParserbase)
                 delct(r,ct,len,TT_SYM);
                 delct(r,c+Pnumber(),len,TT_NUM);
             end else
-            if(c in FNumbers)and pnumber and(not(ct)) {(not(ct))  and (r[len][0]="=")}then
+            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();
@@ -342,14 +360,14 @@ type TTmfParserToken = class(TTmfParserbase)
         **}
         c := cchar();
         c := lowercase(c);
-        its := inttostr(0 -> 9)union array("a","b","c","d","e","f");
+        //its := inttostr(0 -> 9)union array("a","b","c","d","e","f");
         r := "";
         if c="x" then
         begin
             while whileok() do
             begin
-                c := lowercase(cchar());
+                c := cchar();
-                if not(c in its)then
+                if not(FHexnumbers[c])then
                 begin
                     cback();
                     break;
@@ -389,8 +407,23 @@ type TTmfParserToken = class(TTmfParserbase)
     function create();override;
     begin
         inherited;
-        FNumbers := inttostr(0 -> 9);
+        //FNumbers := inttostr(0 -> 9);
-        Ffloat := FNumbers union array(".");
+        FNumbers := array();
+        FHexnumbers := array();
+        for i := 0 to 9 do 
+        begin
+            FNumbers[inttostr(i)] := true;
+            FHexnumbers[inttostr(i)] := true;
+        end 
+        for i,v in array("A","B","C","D","E","F") do 
+        begin
+            FHexnumbers[v] := true;
+        end 
+        for i,v in array("a","b","c","d","e","f") do 
+        begin
+            FHexnumbers[v] := true;
+        end 
+        //Ffloat := FNumbers union array(".");
         FSplitter := array(' ','\t',"\r","\n",";",",");
         FSyms := array("=",":","(",")","<",">","[","]");
         FNumberChar := inttostr(0 -> 9);