更新界面库

designer/ctl_mgr/t_compile_config.tfm

@@ -169,7 +169,7 @@ object ed_script:t_compile_config
          leftrightspacing=2
          topbottomspacing=2
       >
-      height=73
+      height=71
       left=10
       parentcolor=true
       top=149
@@ -178,14 +178,14 @@ object ed_script:t_compile_config
          left=6
          top=21
          width=58
-         height=23
+         height=21
          autosize=true
          caption="函数目录"
       end
       object ed_f_dirs:tedit
          autosize=true
          caption="edit1"
-         height=23
+         height=21
          left=66
          top=21
          width=312
@@ -193,7 +193,7 @@ object ed_script:t_compile_config
       object bt_f_dir:tbtn
          autosize=true
          caption=".."
-         height=23
+         height=21
          left=380
          onclick=bt_f_dir_clk
          top=21
@@ -201,7 +201,7 @@ object ed_script:t_compile_config
       end
       object label2:tlabel
          left=6
-         top=46
+         top=44
          width=58
          height=21
          autosize=true
@@ -212,7 +212,7 @@ object ed_script:t_compile_config
          caption="edit2"
          height=21
          left=66
-         top=46
+         top=44
          width=312
       end
       object bt_s_dir:tbtn
@@ -221,7 +221,7 @@ object ed_script:t_compile_config
          height=21
          left=380
          onclick=bt_s_dir_clk
-         top=46
+         top=44
          width=28
       end
    end
@@ -239,7 +239,7 @@ object ed_script:t_compile_config
       height=139
       left=10
       parentcolor=true
-      top=232
+      top=230
       width=452
       object lb_s_type:tlabel
          left=6
@@ -385,7 +385,7 @@ object ed_script:t_compile_config
       height=97
       left=10
       parentcolor=true
-      top=381
+      top=379
       width=452
       object label9:tlabel
          left=6
@@ -521,7 +521,7 @@ object ed_script:t_compile_config
       >
       height=25
       left=10
-      top=488
+      top=486
       width=452
       wsdlgmodalframe=false
       object bt_cmd:tbtn

designer/ctl_mgr/t_compile_config.tsf

@@ -1,6 +1,5 @@
 type t_compile_config=class(tdcreateform)
     uses tslvcl;    
-    
     gp_dir:tgroupbox;
     bt_f_dir:tbtn;
     bt_s_dir:tbtn;
@@ -14,20 +13,13 @@ type t_compile_config=class(tdcreateform)
     cb_type:tcombobox;
     lb_output:tlabel;
     ed_output:tedit;    
-    
     gp_other:tgroupbox;    
-    
-    
-    
     bt_i_s:tbtn;
     lb_ico:tlabel;
     ed_ico:tedit;
     bt_ico:tbtn;
     bt_output:tbtn;
     f_op:topenfileadlg;    
-    
-    
-    
     bt_outputname:tbtn;
     lb_output_f:tlabel;
     ed_out_f:tedit;
@@ -134,6 +126,17 @@ type t_compile_config=class(tdcreateform)
         ed_ico.text := r["buildico"];  
         ed_tsg.text := r["pkg"];
         e_namespace.text := r["nspace"];
+        if r["designer"] then 
+        begin 
+            e_script.Enabled := false;    
+            cb_type.Enabled := false;    
+            ck_gui.Enabled := false;    
+        end else 
+        begin
+            e_script.Enabled := true; 
+            cb_type.Enabled := true; 
+            ck_gui.Enabled := true; 
+        end 
         //ck_s_rp.Checked := r["resourcekeepdir"];        
     end 
     function get_config();

designer/ctl_mgr/t_editor_color_mgr.tfm

@@ -33,9 +33,9 @@ object ditor_color_mgr:t_editor_color_mgr
       itemindex=0
       left=10
       onselchanged=colorcombobox1_onselchanged
+      parentfont=false
       top=18
       width=132
-      parentfont=false
    end
    object listbox1:tlistbox
       caption="listbox1"
@@ -54,9 +54,9 @@ object ditor_color_mgr:t_editor_color_mgr
       itemindex=0
       left=154
       onselchanged=colorcombobox2_onselchanged
+      parentfont=false
       top=18
       width=177
-      parentfont=false
    end
    object openfileadlg1:topenfileadlg
       left=314

designer/ctl_mgr/t_editor_config.tfm

@@ -217,6 +217,7 @@ object editor_config:t_editor_config
          caption="取消"
          height=31
          left=191
+         onclick=bt_cancel_clk
          top=8
          width=94
       end

designer/ctl_mgr/t_editor_config.tsf

@@ -33,7 +33,7 @@ type t_editor_config=class(tdcreateform)
     end
     function bt_cancel_clk(o;e);
     begin
-        o.Visible := false;
+        Visible := false;
         //calldatafunction(foncancel_clk,self,e);
     end
     function bt_ok_clk(o;e);

designer/ctl_mgr/t_function_finder.tfm

@@ -29,7 +29,7 @@ object functionfinder:t_function_finder
       align=altop
       autosize=true
       caption="panel1"
-      height=41
+      height=39
       left=0
       top=0
       width=804
@@ -55,7 +55,7 @@ object functionfinder:t_function_finder
       object ck_prev:tcheckbtn
          autosize=true
          caption="从头匹配"
-         height=27
+         height=25
          left=371
          top=8
          visible=true
@@ -82,11 +82,11 @@ object functionfinder:t_function_finder
       text="函数"
       >
       ]
-      height=566
+      height=568
       left=0
       ondblclick=listfunc_ondblclick
       popupmenu=popupmenu1
-      top=41
+      top=39
       width=804
    end
    object popupmenu1:tpopupmenu

designer/ctl_mgr/textcompclassadder.tfm

@@ -1,80 +1,109 @@
 object extcompclassadder:textcompclassadder
+   autosize=true
    caption="添加"
    height=406
    left=474
    minmaxbox=false
    onclose=extcompclassadder_close
    top=316
-   width=402
+   width=420
    wssizebox=false
-   object e_classname:tedit
-      caption="edit1"
-      height=25
-      left=99
-      readonly=true
-      top=28
-      width=247
-   end
-   object label1:tlabel
-      left=20
-      top=21
-      width=72
-      height=32
-      caption="控件类"
-   end
-   object b_classfile:tbtn
-      caption="..."
-      height=24
-      left=354
-      onclick=b_classfile_clk
-      top=29
-      width=21
-   end
-   object label2:tlabel
-      left=20
-      top=72
-      width=65
-      height=33
-      caption="图标"
-   end
    object p_imgshow:tpanel
+      autosize=false
       caption="img"
-      height=195
+      height=120
-      left=91
+      left=183
-      top=107
+      top=181
-      width=245
+      width=130
       wsdlgmodalframe=false
    end
-   object b_img:tbtn
-      caption="添加图标"
-      height=25
-      left=100
-      onclick=b_img_clk
-      top=72
-      width=176
-   end
    object b_ok:tbtn
+      autosize=true
       caption="确定"
       enabled=true
-      height=31
+      height=21
-      left=134
+      left=64
       onclick=b_ok_clk
-      top=306
+      top=322
-      width=72
+      width=42
    end
    object b_cancel:tbtn
+      autosize=true
       caption="取消"
-      height=31
+      height=21
-      left=271
+      left=276
       onclick=b_cancel_clk
-      top=306
+      top=321
-      width=73
+      width=42
    end
    object f_open:topenfileadlg
-      left=22
+      left=42
-      top=146
+      top=184
       height=30
       width=30
       caption="文件选择"
    end
+   object panel1:tpanel
+      align=altop
+      autosize=true
+      caption="panel1"
+      childsizing=<
+         layout=1
+         controlsperline=3
+         horizontalspacing=10
+         verticalspacing=10
+         leftrightspacing=10
+         topbottomspacing=10
+      >
+      height=72
+      left=0
+      top=0
+      width=366
+      wsdlgmodalframe=false
+      object label1:tlabel
+         left=10
+         top=10
+         width=44
+         height=21
+         caption="控件类"
+      end
+      object e_classname:tedit
+         caption="edit1"
+         height=21
+         left=64
+         readonly=true
+         top=10
+         width=247
+      end
+      object b_classfile:tbtn
+         caption="..."
+         height=21
+         left=321
+         onclick=b_classfile_clk
+         top=10
+         width=35
+      end
+      object label2:tlabel
+         left=10
+         top=41
+         width=44
+         height=21
+         caption="图标"
+      end
+      object b_img:tbtn
+         caption="添加图标"
+         height=21
+         left=64
+         onclick=b_img_clk
+         top=41
+         width=247
+      end
+      object label3:tlabel
+         left=321
+         top=41
+         width=35
+         height=21
+         caption=""
+      end
+   end
 end

designer/ctl_mgr/textcompclassadder.tsf

@@ -1,14 +1,16 @@
 type textcompclassadder=class(tdcreateform)
     uses tslvcl;    
-    e_classname:tedit;
-    label1:tlabel;
-    b_classfile:tbtn;
-    label2:tlabel;
     p_imgshow:tpanel;        
-    b_img:tbtn;    
     b_ok:tbtn;
     b_cancel:tbtn;
     f_open:topenfileadlg;    
+    panel1:tpanel;
+    label1:tlabel;
+    e_classname:tedit;
+    b_classfile:tbtn;
+    label2:tlabel;
+    b_img:tbtn;
+    label3:tlabel;
     function Create(AOwner);override; //构造
     begin		
         inherited;

designer/ctl_mgr/textcompclassmgr.tfm

@@ -1,11 +1,13 @@
 object extcompclassmgr:textcompclassmgr
+   autosize=true
    caption="注册控件-管理"
-   height=467
+   height=444
-   left=447
+   left=930
    minmaxbox=false
    onclose=extcompclassmgr_close
-   top=272
+   top=287
-   width=484
+   width=446
+   wspopup=false
    wssizebox=true
    object listbox1:tlistbox
       caption="listbox1"
@@ -16,49 +18,61 @@ object extcompclassmgr:textcompclassmgr
       width=344
    end
    object b_del:tbtn
+      autosize=true
       caption="删除"
       enabled=false
-      height=31
+      height=21
-      left=364
+      left=368
       onclick=b_del_clk
-      top=224
+      top=73
-      width=88
+      width=42
    end
    object b_add:tbtn
+      autosize=true
       caption="添加"
-      height=31
+      height=21
-      left=364
+      left=368
       onclick=b_add_clk
-      top=279
+      top=176
-      width=88
+      width=42
    end
    object b_ok:tbtn
+      autosize=true
       caption="完成"
-      height=31
+      height=21
-      left=364
+      left=368
       onclick=b_ok_clk
-      top=346
+      top=288
-      width=88
+      width=42
-      wssizebox=false
-      wssysmenu=false
    end
    object statusbar1:tstatusbar
+      autosize=true
       caption="statusbar1"
-      height=25
+      height=19
       items=   [< 
       width=500
       text="控件管理"
       >
       ]
       left=0
-      top=403
+      parentfont=false
-      width=468
+      top=386
+      width=430
    end
    object label1:tlabel
       left=8
       top=5
       width=176
       height=36
+      parentfont=false
       caption="控件列表"
    end
+   object label2:tlabel
+      left=394
+      top=388
+      width=16
+      height=17
+      autosize=true
+      caption="  "
+   end
 end

designer/ctl_mgr/textcompclassmgr.tsf

@@ -6,29 +6,21 @@ type textcompclassmgr=class(tdcreateform)
     b_ok:tbtn;
     statusbar1:tstatusbar;
     label1:tlabel;
+    label2:tlabel;
     function Create(AOwner);override; //¹¹Ôì
     begin		
         inherited;
     end 
-    function extcompclassmgr_close(o;e);virtual;
+    function extcompclassmgr_close(o;e);
     begin
-     
-        {**
-            @explan(说明) 主窗口关闭回调 %%
-            @param(e)(tuievent) 消息对象 %%
-            @param(o)(ttimer) 当前主窗口 %%
-        **}
         e.skip:= true;
         Visible := false;
-        inherited;
-
     end
-
+    function b_ok_clk(o;e);
-    function b_ok_clk(o;e);virtual;
     begin
         Visible := false;
     end
-    function b_del_clk(o;e);virtual;
+    function b_del_clk(o;e);
     begin
         idx := listbox1.ItemIndex;
         if idx>=0 and parent then 

designer/ctl_mgr/vcldesginer.tpj

@@ -1,71 +1,16 @@
-array(
+
-   "name":"vcldesginer",
+array("name":"vcldesginer","version":"1.1.2","dir":
-   "version":"1.1.2",
+(),"files":
-   "dir":(
+("textcompclassadder":
-   ),
+("name":"textcompclassadder","type":"form","dir":""),"textcompclassmgr":
-   "files":(
+("name":"textcompclassmgr","type":"form","dir":""),"tfm_inheritedwnd":
-      "textcompclassadder":(
+("name":"tfm_inheritedwnd","type":"form","dir":""),"t_bconfig_cmd_shower":
-         "name":"textcompclassadder",
+("name":"t_bconfig_cmd_shower","type":"form","dir":""),"t_code_format_mgr":
-         "type":"form",
+("name":"t_code_format_mgr","type":"form","dir":""),"t_compile_config":
-         "dir":""
+("name":"t_compile_config","type":"form","dir":""),"t_dir_list":
-      ),
+("name":"t_dir_list","type":"form","dir":""),"t_editor_color_mgr":
-      "textcompclassmgr":(
+("name":"t_editor_color_mgr","type":"form","dir":""),"t_editor_config":
-         "name":"textcompclassmgr",
+("name":"t_editor_config","type":"form","dir":""),"t_function_finder":
-         "type":"form",
+("name":"t_function_finder","type":"form","dir":""),"t_m_list_editor":
-         "dir":""
+("name":"t_m_list_editor","type":"form","dir":""),"t_shortcut_keys_view":
-      ),
+("name":"t_shortcut_keys_view","type":"form","dir":"")),"mainform":"textcompclassmgr")
-      "tfm_inheritedwnd":(
-         "name":"tfm_inheritedwnd",
-         "type":"form",
-         "dir":""
-      ),
-      "t_bconfig_cmd_shower":(
-         "name":"t_bconfig_cmd_shower",
-         "type":"form",
-         "dir":""
-      ),
-      "t_compile_config":(
-         "name":"t_compile_config",
-         "type":"form",
-         "dir":""
-      ),
-      "t_dir_list":(
-         "name":"t_dir_list",
-         "type":"form",
-         "dir":""
-      ),
-      "t_m_list_editor":(
-         "name":"t_m_list_editor",
-         "type":"form",
-         "dir":""
-      ),
-      "t_function_finder":(
-         "name":"t_function_finder",
-         "type":"form",
-         "dir":""
-      ),
-      "t_shortcut_keys_view":(
-         "name":"t_shortcut_keys_view",
-         "type":"form",
-         "dir":""
-      ),
-      "tsl1":(
-         "name":"tsl1",
-         "type":"tsl",
-         "dir":""
-      ),
-      "t_editor_color_mgr":(
-         "name":"t_editor_color_mgr",
-         "type":"form",
-         "dir":""
-      ),
-      "t_editor_config":(
-         "name":"t_editor_config",
-         "type":"form",
-         "dir":""
-      )
-   ),
-   "mainform":"t_shortcut_keys_view",
-   "entryscript":"vcldesginer",
-   "commandline":"\"$(TSL_EXE)\" \"$(FULL_CURRENT_PATH)\" -libpath \"$(SEARCH_PATH)\""
-)

designer/udesignerproject.tsf

@@ -13,6 +13,10 @@ type TProjectManagerForm = class(TVCForm) //
         minmaxbox := false;
         Border := false;
         FProjectCoder := new TDesignerProjectsRecoder();
+        fbtncontainer := new tpanel(self);
+        fbtncontainer.Align := alBottom;
+        fbtncontainer.autosize := true;
+        fbtncontainer.parent := self;
         FDesigner := AOwner;
         visible := false;
         WsSizeBox := true;
@@ -20,23 +24,15 @@ type TProjectManagerForm = class(TVCForm) //
         WsPopUp := true;
         WsSysMenu := true;
         rc := _wapi.GetScreenRect();
-        //l :=(rc[2]-rc[0])/2-280;
-        //t :=(rc[3]-rc[1])/2-230;
-        //SetBoundsRect(array(l,t,480+l,300+t));
         SetBoundsRect(array(100,100,700,500));
         FList := new TProgValueList(self);
+        FList.Align := alClient;
         FList.Border := true;
         d := GetAllProjects();
         p := array();
         for i,v in d do p[i]:= array("caption":v["name"],"value":v["file"]);
         FList.SetData(p);
         if p then FList.SetCurrentSelection(0);
-        FLinea := new TLabel(self);
-        FLinea.caption := "";
-        FLinea.height := 2;
-        FLinea.left :=-1;
-        FLinea.Color := rgb(30,144,255);
-        FLinea.parent := self;
         FList.parent := self;
         FList.OnDblClick := thisfunction(OpenSelectedObject);
         FDelBtn := new TBtn(self);
@@ -45,8 +41,7 @@ type TProjectManagerForm = class(TVCForm) //
         FOpenBtn.height := 28;
         FDelBtn.height := 28;
         FOpenBtn.caption := "打开";
-        FDelBtn.parent := self;
+        
-        FOpenBtn.parent := self;
         FDelBtn.OnClick := function(o,e)
         begin
             cid := FList.getCurrentSelection();
@@ -62,6 +57,23 @@ type TProjectManagerForm = class(TVCForm) //
             end
         end
         FOpenBtn.OnClick := thisfunction(OpenSelectedObject);
+        spc := new TLabel(self);
+        spc2 := new TLabel(self);
+        spc.caption := "   ";
+        spc2.caption := " ";
+        FOpenBtn.autosize := true;
+        spc.autosize := true;
+        spc2.autosize := true;
+        FDelBtn.autosize := true;
+        FDelBtn.Align := alRight;
+        FOpenBtn.Align := alRight;
+        spc.Align := alRight;
+        spc2.Align := alRight;
+        spc2.parent := fbtncontainer;
+        FOpenBtn.parent := fbtncontainer;
+        spc.parent := fbtncontainer;
+        FDelBtn.parent := fbtncontainer;
+        
     end
     function OpenSelectedObject();
     begin
@@ -105,23 +117,7 @@ type TProjectManagerForm = class(TVCForm) //
         if it then n := it["value"];
         return n;
     end
-    function DoControlAlign();override;
+
-    begin
-        if FList and FDelBtn and FOpenBtn and FLinea then
-        begin
-            rc := ClientRect;
-            rc1 := rc;
-            rc1[3]-= 35;
-            FList.SetBoundsRect(rc1);
-            FLinea.top := rc1[3]+2;
-            tp := rc1[3]+5;
-            FDelBtn.Top := tp;
-            FDelBtn.left := rc[2]-200;
-            FOpenBtn.Top := tp;
-            FOpenBtn.left := rc[2]-100;
-            if rc[2]>FLinea.width then FLinea.width := rc[2];
-        end
-    end
     function CreateTpjFomFile(f);
     begin
         if AddAproject(F)then
@@ -188,7 +184,7 @@ end
         ls := FProjectCoder.ListProjects();
         return ls;
     end
-    FLinea;
+    fbtncontainer;
     FList;
     FDelBtn;
     FOpenBtn;
@@ -541,7 +537,7 @@ type TProjectView = class(TVCForm) //
         fnewmenu.Enabled := false;
         fgoformmenu.Enabled := false;
         fnewmenu.caption := "新建";
-        for i,v in array("form","panel","script","tsf") do 
+        for i,v in array("form","panel","script","tsf","继承窗口") do 
         begin
             it := new TMenu(self);
             it.caption := v;
@@ -593,7 +589,9 @@ type TProjectView = class(TVCForm) //
             if it=ftree.RootNode then 
             begin
                 if FAddtoolbtn then FAddtoolbtn.Enabled := false;
-                return FDesigner.ExecuteCommand("hiddrennode",nil);
+                r :=  FDesigner.ExecuteCommand("hiddrennode",nil);
+                FCurrentOpend := nil;
+                return r;
             end 
             if it then
             begin
@@ -673,6 +671,10 @@ type TProjectView = class(TVCForm) //
             begin
                 AddFormToCurrentDir(createnamea("form"),cnd);
             end 
+            "继承窗口":
+            begin
+                add_inherited();
+            end 
         
         end 
     end 
@@ -904,6 +906,10 @@ type TProjectView = class(TVCForm) //
     function ShowEditor(); //显示函数编辑
     begin
         //FTslEditer.Show(SW_SHOWNOACTIVATE); //
+        if _wapi.IsIconic(FTslEditer.Handle)<>0 then 
+        begin 
+            FTslEditer.Show(SW_RESTORE);    
+        end else 
             FTslEditer.Show(); //
         _wapi.bringWindowToTop(FTslEditer.Handle);
         it := FTslEditer.GetCurrentEditer();
@@ -990,11 +996,17 @@ type TProjectView = class(TVCForm) //
     begin
         if fopenbuzy then return ;
         fio := ioFileseparator();
-        if not(n and ifstring(n)) then return FDesigner.ExecuteCommand("hiddrennode",nil);;
+        if not(n and ifstring(n)) then 
+        begin
+            r := FDesigner.ExecuteCommand("hiddrennode",nil);
+            FCurrentOpend := nil;
+            return r;
+        end 
         nopend := FTree.NameInTree(n,nil,true);
         if not nopend then 
         begin
             FDesigner.ExecuteCommand("hiddrennode",nil);
+            FCurrentOpend := nil;
             return ;
         end 
         if nopend=FCurrentOpend then
@@ -1248,7 +1260,7 @@ end %%,fn);
                 DeleteAllFiles(FCProjectPath+dp);
             end
             FCurrentOpend := nil;
-            FTree.DeleteCurrentNode();
+            FTree.DeleteCurrentNode(cn);
             SaveProjInfo();
         end
     end
@@ -1274,7 +1286,7 @@ end %%,fn);
                     end
                 end;
             end
-            FTree.DeleteCurrentNode();
+            FTree.DeleteCurrentNode(nd);
             SaveProjInfo();
         end
     end
@@ -1657,6 +1669,7 @@ end
             exit;
         end 
         d := get_config_info();
+        d["designer"] := true;
         ShowEditor();
         d := FTslEditer.build_with_data(FCProjectPath,d);
         if d then 
@@ -1687,14 +1700,7 @@ end
             
             end else 
             begin
-                for i := length(exename) downto 2 do
+                exename := gettslexefullpath();
-                begin
-                    if exename[i]="\\" then 
-                    begin
-                        exename := exename[1:i]+"tsl.exe";
-                        break;    
-                    end 
-                end 
                 filecopy("",exename,"",FWrapFolder.Folder+"\\tsl\\tsl.exe",false);
             end 
             ReWriteString(FWrapFolder.Folder+"\\start.cmd",s);
@@ -1738,6 +1744,15 @@ end
     end
     function saveCurrentEdit(nd); //编辑的节点,不送入保存当前节点
     begin
+        if nd = "all" then 
+        begin
+            r := FDesigner.ExecuteCommand("allopendnod",nil);
+            for i,v in r do 
+            begin
+                saveCurrentEdit(v);
+            end
+            return ;
+        end 
         if not nd then nd := FCurrentOpend;
         if nd then
         begin
@@ -1794,6 +1809,7 @@ end
             begin 
                 FDesigner.UnLoadTreeNode(nd);
                 if nd = FCurrentOpend then FCurrentOpend := nil;
+                FTree.CurrentNode := nd.parent;  //跳转到当前关闭节点的父节点 20151205
             end 
         end
     end
@@ -2637,9 +2653,9 @@ type TFileTree = class(TTreeCtl)
     begin
         FPNode.RecyclingChildren();
     end
-    function DeleteCurrentNode(); //删除节点
+    function DeleteCurrentNode(c); //删除节点
     begin
-        C := CurrentNode;
+        if not c then C := CurrentNode;
         if not c then return false;
         if FPNode=c then return false;
         //pc := c.parent;

designer/utslcodeeditor.tsf

@@ -856,6 +856,7 @@ type TExecuteEditer=class(TCustomControl) //ִ
     begin
         FMemo.ExecuteCommand(FMemo.ecGotoXY,array(1,1));
         FMemO.SetFocus();
+        center_popup_wnd(self);
         show();
     end
     function Create(AOwner);
@@ -1800,6 +1801,30 @@ type TPageEditer=class(TPage) //
     end 
     [weakref]FPageItemOnRClick;
 end
+type teditorcoolbar = class(tcoolbar)
+    function create(AOwner);
+    begin
+        inherited;
+    end 
+    function doControlALign();override;
+    begin
+        inherited;
+        r := ClientRect;
+        cts := Controls;
+        h := 0;
+        for i := 0 to cts.count-1 do 
+        begin
+            vi := cts[i];
+            if vi.Visible then 
+            begin
+                h := max(h,vi.Height+vi.top);
+                w := max(w,vi.Width+vi.left);
+            end     
+        end
+        if (h>Height) or (h<Height-30) then Height := h;
+        if w>Width then Width := w;
+    end 
+end 
 type TTslChmHelp=class()
     function SearchWord(s);
     begin
@@ -1851,9 +1876,11 @@ type TEditer=class(TCustomcontrol) //
         ftoolbara := new TToolBar(self); //工具栏
         ftoolbarb := new TToolBar(self); //工具栏
         FStatus := new TStatusBar(self); //状态栏
-        fcoolbar := new tcoolbar(self);       
+        fcoolbar := new teditorcoolbar(self);       
         ftoolbara.Align := alNone;
         ftoolbarb.Align := alNone;
+        ftoolbarb.autosize := true;
+        ftoolbara.autosize := true;
         fcoolbar.autosize := true;
         FInfoShowWnd := new TEditerAuxiliary(self);
         FPageEditer := new TPageEditer(self); 
@@ -1949,14 +1976,8 @@ type TEditer=class(TCustomcontrol) //
         ////////
         FListPages.Visible := false;
         ////////////////////////////
-        FPageMenu := new TPopUpMenu(self);
+        init_page_title_popmenu();        
-        for i,v in array("关闭","关闭其他标签","关闭左侧所有","关闭右侧所有","复制文件名","复制文件全名","重新加载","打开目录","另存为") do
+        /////////////////////////////////////////////////////////////////////////////////////
-        begin
-            mi := new TMenu(self);
-            mi.Caption := v;
-            mi.Parent := FPageMenu;
-            mi.OnClick := thisfunction(PageMenuClick);
-        end
         FExecuteEditer := new TExecuteEditer(self);
         FExecuteEditer.visible := false;
         ////////////
@@ -2065,6 +2086,54 @@ type TEditer=class(TCustomcontrol) //
         fsyssizemgr := new tsyssizemgr(self);
         fsyssizemgr.Parent := self;
     end
+    function init_page_title_popmenu(); //初始化page的标题菜单
+    begin
+        FPageMenu := new TPopUpMenu(self);
+        mi := new TMenu(self);
+        mi.Caption := "关闭";
+        mi.Parent := FPageMenu;
+        mi.OnClick := thisfunction(do_close_cpage);
+        
+        mi := new TMenu(self);
+        mi.Caption := "关闭其他标签";
+        mi.Parent := FPageMenu;
+        mi.OnClick := thisfunction(do_close_lrpage);
+        
+        mi := new TMenu(self);
+        mi.Caption := "关闭左侧所有";
+        mi.Parent := FPageMenu;
+        mi.OnClick := thisfunction(do_close_lpage);
+        
+        mi := new TMenu(self);
+        mi.Caption := "关闭右侧所有";
+        mi.Parent := FPageMenu;
+        mi.OnClick := thisfunction(do_close_rpage);
+        
+        mi := new TMenu(self);
+        mi.Caption := "复制文件名";
+        mi.Parent := FPageMenu;
+        mi.OnClick := thisfunction(do_copy_page_name);
+        
+        mi := new TMenu(self);
+        mi.Caption := "复制文件全名";
+        mi.Parent := FPageMenu;
+        mi.OnClick := thisfunction(do_copy_page_path);
+        
+        mi := new TMenu(self);
+        mi.Caption := "重新加载";
+        mi.Parent := FPageMenu;
+        mi.OnClick := thisfunction(do_reload_page);
+        
+        mi := new TMenu(self);
+        mi.Caption := "打开目录";
+        mi.Parent := FPageMenu;
+        mi.OnClick := thisfunction(do_open_page_dir);
+        
+        mi := new TMenu(self);
+        mi.Caption := "另存为";
+        mi.Parent := FPageMenu;
+        mi.OnClick := thisfunction(do_save_page_as);        
+    end 
     function modifysyssize();
     begin
         global editorglobalinfo;
@@ -2648,17 +2717,17 @@ type TEditer=class(TCustomcontrol) //
         end
         DeletePageItem(it);
     end 
-    function PageMenuClick(o,e);
+    ///////////////////////////////////////////////////////////////////
+    function do_close_cpage(); //关闭当前
     begin
         it := GetCurrentItem();
         if not it then return ;
-        case o.Caption of
-            "关闭":
-            begin
         docloseapageitem(it);   
     end 
-            "关闭左侧所有":
+    function do_close_lpage(); //关闭左侧所有
     begin
+        it := GetCurrentItem();
+        if not it then return ;
         its := GetAllPageItems();
         itss := array();
         for i := 0 to its.Length()-1 do   
@@ -2677,10 +2746,11 @@ type TEditer=class(TCustomcontrol) //
             fcloseflag := false;
         end;
         if itss then FPageEditer.CallSelChanged(); 
-                
     end 
-            "关闭右侧所有":
+    function do_close_rpage(); //关闭右侧
     begin
+        it := GetCurrentItem();
+        if not it then return ;
         dodel := 0;
         its := GetAllPageItems();
         itss := array();
@@ -2703,8 +2773,10 @@ type TEditer=class(TCustomcontrol) //
         end;
         if dodel then FPageEditer.CallSelChanged();  
     end
-            "关闭其他标签":
+    function do_close_lrpage(); //关闭其他
     begin
+        it := GetCurrentItem();
+        if not it then return ;
         Cit := it;
         its := GetAllPageItems();
         fcloseflag := true;
@@ -2734,8 +2806,10 @@ type TEditer=class(TCustomcontrol) //
             fcloseflag := false;    
         end;  
     end
-            "另存为":
+    function do_save_page_as(); //另存为
     begin
+        it := GetCurrentItem();
+        if not it then return ;
         if JudgeItemState(it)then return;
                 //FFileopen.OverwritePrompt := true;
         if FFileSave.OpenDlg()then
@@ -2759,24 +2833,31 @@ type TEditer=class(TCustomcontrol) //
                 end 
             end
         end 
-                //FFileopen.OverwritePrompt  := false;
     end
-            "重新加载":
+    function do_reload_page(); //重新加载
     begin
+        it := GetCurrentItem();
+        if not it then return ;
         LoadFromFile(it,true);  
     end
-            "复制文件全名":
+    function do_copy_page_path(); //复制文件全名
     begin
+        it := GetCurrentItem();
+        if not it then return ;
         if not FCliper then FCliper := new TClipBoard(self);
         FCliper.text := it.OrigScriptPath;   
     end
-            "复制文件名":
+    function do_copy_page_name(); //复制文件名
     begin
+        it := GetCurrentItem();
+        if not it then return ;
         if not FCliper then FCliper := new TClipBoard(self);
         FCliper.text := it.Caption;  
     end
-            "打开目录":
+    function do_open_page_dir(); //打开文件夹
     begin
+        it := GetCurrentItem();
+        if not it then return ;
         p := it.ScriptPath;
         if FileExists("",p)then
         begin
@@ -2792,40 +2873,20 @@ type TEditer=class(TCustomcontrol) //
             _wapi.openresourcemanager(p);
         end 
     end
-            "采用cmd执行":
+    //////////////////////////////////////////////////////////////
-            begin
-                //ExecutePageItemWithCmd(it);
-            end
-        end
-    end
     function PageItemOnRClick(o,e);
     begin
         if FPageEditer.GetItemIndexByPos(e.pos)>= 0 then o.PopUpMenu := FPageMenu;
         else o.PoPupMenu := nil;
     end
-    function PageEditerMenuClick(o,e);
+    /////////////右键菜单/////////////////////////////////////////
-    begin
+    function do_to_unix_lf();//linux行结尾
-        cp := o.Caption;
-        if ("转unix(LF)"=cp) then 
     begin
         it := GetCurrentItem();
         it.scripttype := 1;
         SavePageItem(it,1);
-            //it.FEditer.ChangedFlag := true;
+    end 
-            return ;
+    function do_copy_page();//复制
-        end else 
-        if ("转windows(CR LF)"=cp) then 
-        begin
-            it := GetCurrentItem();
-            it.scripttype := 0;
-            SavePageItem(it,1);
-            return ;
-        end else 
-        if ("另存为"=cp) then 
-        begin
-            return PageMenuClick(o,e);        
-        end else 
-        if pos("复制",cp)=1 then
     begin
         it := GetCurrentItem();
         if it then
@@ -2835,11 +2896,9 @@ type TEditer=class(TCustomcontrol) //
             begin
                 ed.ExecuteCommand(ed.ecCopy);
             end
-                //it.FEditer.ReadOnly := not(o.Checked);
         end
-            return;
+    end 
-        end else
+    function do_past_page();//粘贴
-        if pos("粘贴",cp)=1 then
     begin
         it := GetCurrentItem();
         if it then
@@ -2849,11 +2908,9 @@ type TEditer=class(TCustomcontrol) //
             begin
                 ed.ExecuteCommand(ed.ecPaste);
             end
-                //it.FEditer.ReadOnly := not(o.Checked);
         end
-            return;
+    end 
-        end else
+    function do_cut_page();//剪切
-        if pos("剪切",cp)=1 then
     begin
         it := GetCurrentItem();
         if it then
@@ -2863,57 +2920,56 @@ type TEditer=class(TCustomcontrol) //
             begin
                 ed.ExecuteCommand(ed.ecCut);
             end
-                //it.FEditer.ReadOnly := not(o.Checked);
         end
-            return;
+    end 
-        end else
+    function do_goto_line();//定位
-        if pos("定位",cp)=1 then
     begin
         center_popup_wnd(FGotoLineWnd,true);//InitShowWndPos(FGotoLineWnd,"g",200,200);
         FGotoLineWnd.ShowGoto();
-            return;
+    end 
-        end else
+    function do_to_win_lf();//win 行结尾
-        if pos("查看",cp)=1 then
+    begin
+        it := GetCurrentItem();
+        it.scripttype := 0;
+        SavePageItem(it,1);
+    end 
+    function do_goto_func(o);//查看函数
     begin
         cs := o.Caption;
         if length(cs)<6 then return;
         s :=(o.Caption)[6:];
         GetCurrentEditer().Tryjump(s);
-            return;
+    end 
-        end else
+    function do_read_only(o);//只读
-        if pos("只读",cp)=1 then
     begin
         it := GetCurrentItem();
         if it then
         begin
             it.FEditer.ReadOnly := not(o.Checked);
         end
-            return;
+    end
-        end else
+    function do_execute_page();//执行
-        if pos("执行",cp)=1 then
     begin
         it := GetCurrentItem();
         ExecutePageItem(it);
-            return;
+    end
-        end else
+    function do_execute_stop();//停止执行
-        if pos("停止",cp)=1 then
     begin
         if FEchoWnd.Exeing()then FEchoWnd.EndExe();
-            return;
+    end 
-        end else 
+    function do_upper_case();//转大写
-        if cp = "转换为大写" then 
     begin
         upperorlowercase(1);
-        end else 
+    end
-        if cp = "转换为小写" then 
+    function do_lower_case();//转大写
     begin
         upperorlowercase(0);
-        end else 
+    end
-        if cp = "删除尾空白" then
+    function do_del_line_end();//删除行尾空白
     begin
         seltrimright();
     end 
-    end
+    ///////////////////////////////////////////////////////////
     function PageEditerOnRClick(o,e);
     begin            
         o.popupMenu := nil;
@@ -2921,28 +2977,92 @@ type TEditer=class(TCustomcontrol) //
         begin
             FPageEditerMenu := new TPopUpMenu(self);
             FPageEditerMenus := array();
-            for i,v in array("查看","复制(C)","粘贴(V)","剪切(X)","定位(G)","只读","转换为大写","转换为小写","删除尾空白","文档格式","执行(F9)","停止执行","另存为") do
-            begin
-                it := new TMenu(self);
-                it.Caption := v;
             
+            it := new TMenu(self);
+            it.Caption := "查看";
             it.parent := FPageEditerMenu;
-                if "文档格式"=v then 
+            FPageEditerMenus["查看"] := it;
-                begin
+            it.OnClick := thisfunction(do_goto_func);
-                    for j,vj in array("转unix(LF)","转windows(CR LF)") do
+            
-                    begin 
             subit := new TMenu(self);
-                        FPageEditerMenus[vj]:= subit;
+            subit.Caption := "文档格式";
-                        subit.Caption := vj ;
+            subit.Parent := FPageEditerMenu;
-                        subit.Parent := it;
+            it := new TMenu(self);
-                        subit.OnClick := thisfunction(PageEditerMenuClick);
+            it.Caption := "转unix(LF)";
-                    end 
+            it.parent := subit;
-                    FPageEditerMenus[v] := it;
+            FPageEditerMenus["转unix(LF)"] := it;
-                    continue;
+            it.OnClick := thisfunction(do_to_unix_lf);
-                end 
+            
-                FPageEditerMenus[v]:= it;
+            it := new TMenu(self);
-                it.OnClick := thisfunction(PageEditerMenuClick);
+            it.Caption := "转windows(CR LF)";
-            end
+            it.parent := subit;
+            FPageEditerMenus["转windows(CR LF)"] := it;
+            it.OnClick := thisfunction(do_to_win_lf);
+            
+            it := new TMenu(self);
+            it.Caption := "复制(C)";
+            it.parent := FPageEditerMenu;
+            FPageEditerMenus["复制(C)"] := it;
+            it.OnClick := thisfunction(do_copy_page);
+            
+            it := new TMenu(self);
+            it.Caption := "粘贴(V)";
+            it.parent := FPageEditerMenu;
+            FPageEditerMenus["粘贴(V)"] := it;
+            it.OnClick := thisfunction(do_past_page);
+            
+            it := new TMenu(self);
+            it.Caption := "剪切(X)";
+            it.parent := FPageEditerMenu;
+            FPageEditerMenus["剪切(X)"] := it;
+            it.OnClick := thisfunction(do_cut_page);
+            
+            it := new TMenu(self);
+            it.Caption := "定位(G)";
+            it.parent := FPageEditerMenu;
+            FPageEditerMenus["定位(G)"] := it;
+            it.OnClick := thisfunction(do_goto_line);
+            
+            it := new TMenu(self);
+            it.Caption := "只读";
+            it.parent := FPageEditerMenu;
+            FPageEditerMenus["只读"] := it;
+            it.OnClick := thisfunction(do_read_only);
+            
+            it := new TMenu(self);
+            it.Caption := "转换为大写";
+            it.parent := FPageEditerMenu;
+            FPageEditerMenus["转换为大写"] := it;
+            it.OnClick := thisfunction(do_upper_case);
+            
+            it := new TMenu(self);
+            it.Caption := "转换为小写";
+            it.parent := FPageEditerMenu;
+            FPageEditerMenus["转换为小写"] := it;
+            it.OnClick := thisfunction(do_lower_case);
+            
+            it := new TMenu(self);
+            it.Caption := "删除尾空白";
+            it.parent := FPageEditerMenu;
+            FPageEditerMenus["删除尾空白"] := it;
+            it.OnClick := thisfunction(do_del_line_end);
+            
+            it := new TMenu(self);
+            it.Caption := "执行(F9)";
+            it.parent := FPageEditerMenu;
+            FPageEditerMenus["执行(F9)"] := it;
+            it.OnClick := thisfunction(do_execute_page);
+            
+            it := new TMenu(self);
+            it.Caption := "停止执行";
+            it.parent := FPageEditerMenu;
+            FPageEditerMenus["停止执行"] := it;
+            it.OnClick := thisfunction(do_execute_stop);
+            it := new TMenu(self);
+            it.Caption := "另存为";
+            it.parent := FPageEditerMenu;
+            FPageEditerMenus["另存为"] := it;
+            it.OnClick := thisfunction(do_save_page_as);
         end
         iflx := GetCurrentItem().scripttype = 1;
         FPageEditerMenus["转unix(LF)"].Enabled := not iflx;

designer/utslcodeformat.tsf

@@ -152,6 +152,7 @@ type TFormatParser = class
         begin
             FSynParser2.add(v);
         end 
+        fmreadword := array("return":1,"rdo":1,"rdo2":1,"echo":1);
         FHtmlParser := NEW TTire();
         FHtmlParser.Add("<?tsl");
         FArrayType := 1;
@@ -289,12 +290,19 @@ type TFormatParser = class
             begin 
                 FFormatStr[fl-1:fl]:=" "+tk.FStr+"\r\n";
             end 
-            else FFormatStr+= " "+tk.FStr+ "\r\n";
+            else 
+            begin
+                if FFormatStr and FFormatStr[length(FFormatStr)]=" " then FFormatStr+=tk.FStr+ "\r\n";
+                else 
+                    FFormatStr+= " "+tk.FStr+ "\r\n";
+            end 
             FCWordCount :=0;  
             FLWordLength :=0;      
         end else 
         if (tk.FType .& TK_SYN_S){ and (tk.FStr="*")} then  //修正(**) 问题 20231127修正
         begin
+            if FFormatStr and FFormatStr[length(FFormatStr)]=" " then FFormatStr+= tk.FStr+" "; 
+            else 
                 FFormatStr+= " "+tk.FStr+" ";    
         end else
         if (tk.FType .& TK_SYN) and (tk.FStr=";") then 
@@ -321,6 +329,8 @@ type TFormatParser = class
                 
                 if FCWordCount then 
                 begin
+                    if FFormatStr and FFormatStr[length(FFormatStr)]=" " then FFormatStr +=tk.FStr;  
+                    else 
                         FFormatStr +=" "+tk.FStr;        
                 end else 
                 begin
@@ -399,18 +409,25 @@ type TFormatParser = class
                     FFormatStr+="\r\n";  
                 end 
             end 
+            if (tk.FType=TK_W) and fmreadword[ lowercase(tk.FStr)]  then 
+            begin 
+                spc :=" ";
+            end else 
+                spc :="";
             if FCWordCount then 
             begin
                 ttk := GetPrevTK(); 
                 if ttk and ( (tk.FTypeSub .& TK_DO) or (tk.FTypeSub .& TK_END) or (((ttk.FType .& TK_W) or (ttk.FType .& TK_KEY) or (ttk.FType .& TK_STR) ) and ((tk.FType .& TK_W) or (tk.FType .& TK_KEY) or (tk.FType .& TK_STR))) ) then 
                // if ttk and ((ttk.FType .& TK_W) or (ttk.FType .& TK_KEY)) or ((tk.FType .& TK_W) or (tk.FType .& TK_KEY)) then  
                 begin
-                    FFormatStr+=" "+tk.FStr; 
+                    if FFormatStr and FFormatStr[length(FFormatStr)]=" " then FFormatStr+=tk.FStr+spc; 
+                    else 
+                        FFormatStr+=" "+tk.FStr+spc; 
                 end 
-                else FFormatStr+=tk.FStr  
+                else FFormatStr+=tk.FStr+spc;  
             end else
             begin 
-                FFormatStr+=FHier.HierStr()+tk.FStr;
+                FFormatStr+=FHier.HierStr()+tk.FStr+spc;
             end  
             FCWordCount++;  
             FLWordLength+=tk.FStrL;
@@ -1446,6 +1463,7 @@ type TFormatParser = class
         end    
     end 
     private 
+    fmreadword;
     FAlignBlockComment;
     FAtRowFirst;
     FArrayType;

designer/utslsynmemo.tsf

@@ -271,11 +271,6 @@ type TTSLCompletion= class(TSynCompletion)
     class function GetCodeBlocks();
     begin
         r := array();
-        {try
-        FCodeBlocks := GetTslCompletionCodeBlocks();
-        except
-            FCodeBlocks := array();
-        end}
         if ifarray(FCodeBlocks) then 
         begin 
             idx := 0;

designer/utslvcldcomponents.tsf

@@ -22,6 +22,19 @@ type TDComponent = class()
     static const cst_m_savewindow = "保存窗口";
     static const cst_tip_willcut = "即将剪切:";
     static const cst_tip_willdelete = "即将删除:";
+    private //注册设计控件
+    class function dcompisok(v,o); //判断注册的控件是否OK
+    begin
+        n := "";
+        try 
+            o := createobject(v);
+            n := o.dclassname();
+            oo := createobject(o.WndClass(),nil);
+        except
+            return 0;
+        end  
+        return n;
+    end
     public //注册设计控件
     class function GetClassItem(n);
     begin
@@ -44,8 +57,7 @@ type TDComponent = class()
         begin
             if (v is class(TDComponent) )  then 
             begin
-                o := createobject(v);
+                n := dcompisok(v,o);
-                n := o.dclassname();
                 if n and ifstring(n) then 
                 begin
                     n := lowercase(n);
@@ -62,12 +74,7 @@ type TDComponent = class()
         begin
             if (v is class(TDComponent) )  then 
             begin
-                try
+                n := dcompisok(v,o);
-                o := createobject(v);                 
-                n := o.dclassname();
-                except
-                continue;
-                end 
                 if n and ifstring(n) then 
                 begin
                     n := lowercase(n);
@@ -677,6 +684,22 @@ type TDComponent = class()
         "body":
 ""      ); 
         SetDefalutEvent(ev,true); 
+///////////////////////////////////////////////////////////////
+        ev :=array(
+        "event":"onmouseenter",
+        "name":"mouseenter",
+        "param":array(pm[0]),
+        "body":
+""      ); 
+        SetDefalutEvent(ev,true); 
+///////////////////////////////////////////////////////////////
+        ev :=array(
+        "event":"onmouseleave",
+        "name":"mouseleave",
+        "param":array(pm[0]),
+        "body":
+""      ); 
+        SetDefalutEvent(ev,true); 
 ///////////////////////////////////////////////////////
         ev :=array(
         "event":"ondblclick",
@@ -1042,6 +1065,7 @@ type TDRootComponent = class(TDComponent)
     function Create(AOwner);override;
     begin                                                            
         inherited;
+        excludepropertys := array("width","height");
     end  
     function CheckParentWnd(Pwnd);override;
     begin
@@ -1587,7 +1611,6 @@ type TDImageList = class(TDRootComponent)
     function GetPublishProperties();override;
     begin
         r := inherited;
-        r :=  r[ array("name","top","left","images","imgwidth","imgheight")];
         return r;
     end 
 
@@ -2401,7 +2424,7 @@ BFC6105000000097048597300000EC300000EC301C76FA864000000E549444154
     function Create(AOwner);override;
     begin
         inherited;
-        fiscontainerdcmp := false;
+        //fiscontainerdcmp := false;
     end 
 
 end 
@@ -2627,6 +2650,10 @@ type TDActionList = class(TDRootComponent)
     begin
         inherited;
     end 
+    function GetPublishProperties();override;
+    begin
+        return inherited;
+    end 
 end 
 //**************FMainMenu********************************
 type TPopUpMenuWindow = class(TDVirutalWindow)

designer/utslvcldebuger.tsf

@@ -446,23 +446,54 @@ type TTslDebuga=class(TCustomControl)
     begin
         return filedelete("",(TS_ModulePath()+"FunCache.ini"));
     end
+    /////////按钮图标///////////////////////////////
+    [weakref]
+    fdbtn_continue;
+    fdbtn_breakpoint;
+    
+    fdbtn_pause;    
+    fdbtn_into;
+    fdbtn_out;
+    fdbtn_minstep;
+    fdbtn_next;
+    fdbtn_stop;
+    fdbtn_flushsyms;
+    fdbtn_flushsym;    
     public
     property runbtncall read frunbtncall write frunbtncall;   
+    //"添加/删除断点F5","暂停","继续","进入","跳出","单步","下一行(F8)","终止","刷新符号表","刷新当前符号" 
     function addbtns(btns); //添加菜单
     begin
         FBtns := btns ;
-        for i,v in Fbtns do
+        fdbtn_continue := btns["继续"];
-        begin
+        fdbtn_breakpoint := btns["添加/删除断点F5"];
-            v.onClick := thisfunction(Dbgtooldo);
+        
-            if v.Caption="添加/删除断点F5" then continue;
+        fdbtn_pause := btns["暂停"];   
-            if v.Caption="继续" then 
+        fdbtn_into := btns["进入"];
-            begin
+        fdbtn_out := btns["跳出"];
-                v.onClick := thisfunction(dbgtooldorun);
+        fdbtn_minstep := btns["单步"];
-                v.Caption := "调试运行";
+        fdbtn_next := btns["下一行(F8)"];
-                continue;
+        fdbtn_stop := btns["终止"];
-            end 
+        fdbtn_flushsyms := btns["刷新符号表"];
-            v.Visible := false;
+        fdbtn_flushsym  := btns["刷新当前符号"]; 
-        end
+        fdbtn_continue.onClick := thisfunction(dbgtooldorun);
+        fdbtn_continue.Caption := "调试运行";
+        
+        fdbtn_breakpoint.onClick:= thisfunction(Dbgtooldo);
+        fdbtn_pause.onClick:= thisfunction(Dbgtooldo);
+        fdbtn_pause.Visible := false;
+        fdbtn_into.onClick:= thisfunction(Dbgtooldo);
+        fdbtn_into.Visible := false;
+        fdbtn_out.onClick:= thisfunction(Dbgtooldo);
+        fdbtn_out.Visible := false;
+        fdbtn_next.onClick:= thisfunction(Dbgtooldo);
+        fdbtn_next.Visible := false;
+        fdbtn_stop.onClick:= thisfunction(Dbgtooldo);
+        fdbtn_stop.Visible := false;
+        fdbtn_flushsyms.onClick:= thisfunction(Dbgtooldo);
+        fdbtn_flushsyms.Visible := false;
+        fdbtn_flushsym.onClick:= thisfunction(Dbgtooldo);
+        fdbtn_flushsym.Visible := false;
     end
     function DbgNextLine(); //下一行
     begin
@@ -570,6 +601,7 @@ type TTslDebuga=class(TCustomControl)
             fdbgselwnd.cancel_clk := thisfunction(serwnd_cclk);
             fdbgselwnd.dbg_clk := thisfunction(dbg_clk);
         end
+        center_popup_wnd(fdbgselwnd);
         fdbgselwnd.setlist();
         if flg then
         begin
@@ -834,15 +866,14 @@ type TTslDebuga=class(TCustomControl)
     end 
     function Dbgtooldo(o,e)
     begin
-        cp := o.Caption;
+        case o of
-        case cp of
+            fdbtn_continue:
-            "调试运行":
             begin
                 //echo "调试运行";
                 it := Owner.GetCurrentItem(); //Owner.GetAllPageItems();
                 Debuglocal(it);
             end
-            "添加/删除断点F5":
+            fdbtn_breakpoint:
             begin
                 it := Owner.GetCurrentItem();
                 if it then
@@ -850,7 +881,7 @@ type TTslDebuga=class(TCustomControl)
                     it.FEditer.SwitchMarkLine();
                 end
             end
-            "暂停":
+            fdbtn_pause:
             begin
                 ExecuteCommand("dbgpause");
                 if Fdebugedwhandle then 
@@ -858,45 +889,35 @@ type TTslDebuga=class(TCustomControl)
                     _Wapi.postmessagea(Fdebugedwhandle,WM_NULL,0,0);
                 end 
             end
-            "进入":
+            fdbtn_into:
             begin
                 ExecuteCommand("dbgstep")
             end           
-            "单步":
+            fdbtn_next:
-            begin
-                //dbgstep();
-            end
-            "下一行(F8)":
             begin
                 ExecuteCommand("dbgstepover");
             end
-            "跳出":
+            fdbtn_out:
             begin
                 ExecuteCommand("dbgstepout");
             end
-            "继续":
+            //"继续":dbgtooldorun(o,e); 
-            begin
+            fdbtn_stop:
-                dbgtooldorun(o,e);    
-            end
-            "终止":
             begin
                 ExecuteCommand("dbgreset");
             end
-            "单步":
+            fdbtn_flushsyms:
-            begin
-            end
-            "刷新符号表":
             begin
                 ExecuteCommand("dbggetallvalue");
             end
-            "刷新当前符号":
+            fdbtn_flushsym:
             begin
                 ExecuteCommand("dbggetcurrentnode");
             end
-            "清除文本框":
+            {"清除文本框":
             begin
                 FShowText.Text := "";
-            end
+            end}
         end;
     end
     function dbgeventcall(d); //回调
@@ -1584,6 +1605,10 @@ type TTslDebuga=class(TCustomControl)
                 FBtns["刷新符号表"].Visible := true;
                 FBtns["刷新当前符号"].Visible := true;
                 FBtns["继续"].Visible := (flg = "暂停") ;
+                if (flg = "暂停") then 
+                begin
+                    FBtns["继续"].Caption := "继续";
+                end 
                 //FBtns["终止"].Visible := true;
             end
             "继续":
@@ -1604,6 +1629,7 @@ type TTslDebuga=class(TCustomControl)
             begin
                 hiddenbtns();
                 FBtns["继续"].Visible := true;
+                FBtns["继续"].Caption := "调试运行";
             end
         end
     end
@@ -2665,7 +2691,28 @@ type tdbgvalueshowgrid=class(TDrawGrid)
             o.show();
         end
     end
+    fmdim1;
+    fmdim2;
+    fmstring;
+    fmjson;
     public
+    function dim1clk();
+    begin
+        Twodimensional := false;
+    end 
+    function dim2clk();
+    begin
+        if FCanedit then return;
+        Twodimensional := true;
+    end
+    function showstring1();
+    begin
+        return showstring(1);
+    end 
+    function showstring0();
+    begin
+        return showstring(0);
+    end 
     function create(AOwner);override;
     begin
         inherited;
@@ -2688,34 +2735,22 @@ type tdbgvalueshowgrid=class(TDrawGrid)
         FStringAlign := AL9_CENTERLEFT;
         FDefAlign := AL9_CENTER;
         mu := new TPopupmenu(self);
-        for i,v in array("一维","二维","原串","json") do
+        fmdim1 := new TMenu(self);
-        begin
+        fmdim1.Caption := "一维";
-            mi := new TMenu(self);
+        fmdim1.onClick := thisfunction(dim1clk);
-            mi.parent := mu;
+        fmdim2 := new TMenu(self);
-            mi.caption := v;
+        fmdim2.Caption := "二维";
-            mi.OnClick := function(o,e)
+        fmdim2.onClick := thisfunction(dim2clk);
-            begin
+        fmstring := new TMenu(self);
-                case o.caption of
+        fmstring.Caption := "原串";
-                    "一维":
+        fmstring.onClick := thisfunction(showstring0);
-                    begin
+        fmjson := new TMenu(self);
-                        Twodimensional := false;
+        fmjson.Caption := "json";
-                    end
+        fmjson.onClick := thisfunction(showstring1);
-                    "二维":
+        fmdim1.parent := mu;
-                    begin
+        fmdim2.parent := mu;
-                        if FCanedit then return;
+        fmstring.parent := mu;
-                        Twodimensional := true;
+        fmjson.parent := mu;
-                    end
-                    "原串":
-                    begin
-                        showstring();
-                    end
-                    "json":
-                    begin
-                        showstring(1);
-                    end
-                end
-            end
-        end
         PopupMenu := mu;
         onfontchanged := function()begin
             ft := font;

designer/utslvcldesigner.tsf

@@ -47,11 +47,11 @@ type TVclDesigner = class(tvcform)
     begin
         FProjectManager.WrapTo();
     end 
-    function designerondo();
+    function designerondo();//撤销
     begin
         if fdolist then fdolist.undo();
     end 
-    function designerredo();
+    function designerredo();//反撤销
     begin
         if fdolist then fdolist.redo();
     end 
@@ -542,7 +542,10 @@ type TVclDesigner = class(tvcform)
         if itemnames then itemnames := itemnames[1:];
         return r;
     end 
-
+    function saveallform();
+    begin 
+        FProjectManager.saveCurrentEdit("all");    
+    end 
     function saveCurrentForm();  //保存当前编辑
     begin
         FProjectManager.saveCurrentEdit();
@@ -554,10 +557,10 @@ type TVclDesigner = class(tvcform)
     **}
         return array(
         ("type":"menu","caption":"文件","filed":"ffilemenu","onclick",nil,"items":(
-            ("type":"menu","caption":"保存","onclick":thisfunction(saveCurrentForm), 
+            ("type":"menu","caption":"打开工程","onclick":thisfunction(OpenFileFromTpjFile),"bitmap":GetOpenFileBitmapInfo()),
-            "bitmap":getsaveallbitmapinfo()),
+            ("type":"menu","caption":"代码编辑","onclick":thisfunction(openclassfile),"bitmap":geteditcodebitmapinfo()),  
-            ("type":"menu","caption":"代码编辑","onclick":thisfunction(openclassfile),
+            ("type":"menu","caption":"保存","onclick":thisfunction(saveallform), "bitmap":getsaveallbitmapinfo()),                      
-            "bitmap":geteditcodebitmapinfo())
+            ("type":"menu","caption":"退出","onclick":thisfunction(sendclosedesigner))
             )),
         ("type":"menu","caption":"视图","filed":"fviewmenu","items":(
             ("type":"menu","caption":"工程文件管理","checked":1,"bitmap":GetWindowMgrBmp(),"onclick":thisfunction(ShowProjectView)),
@@ -598,13 +601,10 @@ type TVclDesigner = class(tvcform)
             )),
         ("type":"menu","caption":"帮助","items":(
             ("type":"menu","caption":"关于","onclick":thisfunction(openabout)),
-            ("type":"menu","caption":"使用手册","onclick":thisfunction(OpenHelp)),
+            ("type":"menu","caption":"使用手册","onclick":thisfunction(designer_help)),
-            ("type":"menu","caption":"tsl语言","onclick":thisfunction(OpenHelp),            
+            ("type":"menu","caption":"tsl语言","onclick":thisfunction(tsl_help),"bitmap":getmanubmpinfo()),
-            "bitmap":getmanubmpinfo()),
+            ("type":"menu","caption":"控件详情","onclick":thisfunction(ctldetail_help),"bitmap":getctlsbmpinfo()),
-            ("type":"menu","caption":"控件详情","onclick":thisfunction(OpenHelp),
+            ("type":"menu","caption":"范例","onclick":thisfunction(OpenExaple),"bitmap":getexamplesbmpinfo())
-            "bitmap":getctlsbmpinfo()),
-            ("type":"menu","caption":"范例","onclick":thisfunction(OpenExaple),
-            "bitmap":getexamplesbmpinfo())
             ),
             
         )
@@ -675,13 +675,30 @@ type TVclDesigner = class(tvcform)
         end         
         return s;
     end 
-    function OpenHelp(o,e); //打开帮助
+    ////////////////打开帮助//////////////////////////////////////////////////////
+    function tsl_help();//tsl语言帮助
+    begin
+        OpenHelp("tsl语言");    
+    end 
+    function designer_help();//设计器帮助
+    begin
+        OpenHelp("使用手册"); 
+    end 
+    function ctl_help();//常用控件
+    begin
+        OpenHelp("常用控件"); 
+    end 
+    function ctldetail_help();//详情
+    begin
+        OpenHelp("控件详情"); 
+    end 
+    function OpenHelp(c); //帮助
     begin
         if not FChmHelper then 
         begin 
             FChmHelper := new unit(UtslCodeEditor).TTslChmHelp(_wapi);
         end 
-        case o.caption of 
+        case c of 
             "tsl语言":
             begin
                 FChmHelper.ChmName := "help"$ioFileseparator()$"LANGUAGEGUIDE.CHM"; 
@@ -694,7 +711,6 @@ type TVclDesigner = class(tvcform)
                //_wapi.WinExec(format('start "%s"',p),0);
                 //_wapi.WinExec('cmd.exe /C start http://bzjj.sinaapp.com/tslvclhelp/index.html',0);
                 //_wapi.WinExec('cmd.exe /C "start http://bzjj.sinaapp.com/tvcldesignerhelp/tvcldesigner.pdf"',0);                
-                
             end 
             "常用控件":
             begin
@@ -738,6 +754,10 @@ type TVclDesigner = class(tvcform)
         p.Invalidaterect(nil,0);
         //setcomponentfocus(o,false);
     end 
+    function sendclosedesigner(); //发送消息关闭窗口
+    begin
+        _send_(WM_CLOSE,self.Handle,0,0,1);
+    end 
     function DesignerClose(o,e) //控件窗口关闭
     begin
     {**
@@ -1664,9 +1684,11 @@ type TVclDesigner = class(tvcform)
         //******************toolbar ***************
         tlbar := FProjectManager.FTslEditer.gettoolbar();
         savebtn := FProjectManager.FTslEditer.gettoolbarbtn();
+        savebtn[0]._tag := array(thisfunction(saveallform),savebtn[0].onclick);
+        savebtn[1]._tag := array(thisfunction(saveCurrentForm),savebtn[1].onclick);
         for i,v in  savebtn do  //处理一下保存工程
         begin
-            v._tag := array(thisfunction(saveCurrentForm),v.onclick);
+            //v._tag := array(thisfunction(saveCurrentForm),v.onclick);
             v.onclick := function(o,e)
             begin
                 for i,v in o._tag do 
@@ -1692,14 +1714,18 @@ type TVclDesigner = class(tvcform)
         tlbar.parent := self;
         tlbar.arrange :="0;1";
         sp1 := new tsplitter(self);
+        sp1.width := 10;
+        sp1.TRANSPARENT := false;
+        sp1.Color := _wapi.GetSysColor(COLOR_MENUBAR);;
         sp1.Align := alLeft;
         sp1.parent := self;
         FToolBars := new TDesignertoolbars(self);        
-        
         FToolBars.Imagelist := fdimagelist;
         addtoolbuttons();
-        FToolBars.Align := alClient;
+        FToolBars.Align := alLeft;//alClient;
         FToolBars.parent := self;
+        FToolBars.GetPreferredSize(wt,ht);
+        tlbar.width :=twidth-wt-80;
         //************菜单******************************
         createmainmenubyarray(mainmenus(),FMenu0,self);
         Mainmenu := FMenu0;
@@ -1716,6 +1742,7 @@ type TVclDesigner = class(tvcform)
         FProjectFilesave.parent := self;
         FProjectManager.FTslEditer.setdbugruncall(thisfunction(debugproject)); //设置调试回调
         FProjectManager.newmenu.parent :=  ffilemenu;// 
+        FProjectManager.newmenu.Zorder := 3;
         FProjectManager.goformmenu.parent :=  fviewmenu;// 
         FToolBars.onnotification := function(o,e)begin
             d := e.msg;
@@ -1727,6 +1754,8 @@ type TVclDesigner = class(tvcform)
         FTslParser := new unit(utslvclsyntaxparser).ttslscripparser();
         //OnChange
         //fnewmenu
+        WSSizebox := false;
+        autosize := true;
     end 
     property VariableSelecter read FVariableSelecter; //当前控件树的变量对象
     private  //其他资源函数
@@ -2090,7 +2119,6 @@ type TPropEditGrid = class(TPropGrid) //
     function Create(AOwner);
     begin
         inherited;
-        FobjProptype := p_properys;
     end
     function getneedpublished(v);virtual;
     begin
@@ -2106,7 +2134,6 @@ type TEventEditGrid = class(TPropEditGrid)   //
     function Create(AOwner);
     begin
         inherited;
-        FobjProptype := p_evnets;
         OndblClick := thisfunction(GridCellDblClick);
     end 
     function getneedpublished(v);override;
@@ -2212,6 +2239,7 @@ type TDesignertoolbars = class(TPageControl)  //
         FToolsheets := array();
         ftoolbars := array();
         inherited;
+        autosize := true;
         //ParentFont := false;
         
         align := alClient;
@@ -2227,6 +2255,7 @@ type TDesignertoolbars = class(TPageControl)  //
         if not st then 
         begin
             st := new TTabSheet(self);
+            st.autosize := true;
             st.caption := t;           
             if t<>"隐藏"  then 
             begin
@@ -2340,6 +2369,7 @@ type TViewBitmap = class(TvcForm)
         lb := new TLabel(self);
         FLB := lb;
         lb.caption := "浏览图片:";
+        lb.autosize := true;
         lb.left := 650;
         lb.top := 20;
         lb.width := 200;

designer/utslvcldpropertytypes.tsf

@@ -604,9 +604,6 @@ type TPropGrid = class(TTSLDataGrid)
     @explan(说明)属性编辑器 %%
 **}
     protected
-    FobjProptype;
-    static const p_properys="peopery";
-    static const p_evnets="pevents";
     FDesigner;
     private
     FCellEditers;
@@ -701,6 +698,7 @@ type TPropGrid = class(TTSLDataGrid)
                 bkfc := FComponent;
                 FComponent := nil;
                 SetComponent(bkfc);
+                InvalidateRect(rec,true);
             end else
             begin 
                 rec := GetSubItemRect(i,j);

designer/utslvclsyntaxparser.tsf

@@ -75,6 +75,28 @@ type tslparser = class(tslparserbase) //
     begin
         return FTokener.tslstr;
     end
+    function format_c_inherited(pa);
+    begin
+        lenpa := length(pa);
+        if lenpa<2 then return ;
+        npa := array(pa[0]);
+        npai := 0;
+        pa_i := 1;
+        while pa_i<lenpa do 
+        begin 
+            if pa[pa_i]="." then 
+            begin
+                if pa_i+1<lenpa then npa[npai]+= "."+pa[pa_i+1];
+                pa_i++;
+            end else 
+            begin
+                npai++;
+                npa[npai] := pa[pa_i];
+            end 
+            pa_i++;  
+        end 
+        if npa<>pa then pa := npa;
+    end 
     public
     function create();
     begin
@@ -117,6 +139,8 @@ type tslparser = class(tslparserbase) //
                             if tk="," then continue;
                             else inh[length(inh)]:= tk;
                         end
+                        format_c_inherited(inh);
+                        
                         r["inherited"]:= inh;
                     end
                     while true do
@@ -235,6 +259,9 @@ type tslparser = class(tslparserbase) //
                     end
                     if tk <> "," then pa[length(pa)]:= tk;                    
                 end
+                ////////20251106///////////////////////////////////
+                format_c_inherited(pa);
+                //////////////////////////////////////
                 r["inherited"]:= pa;
             end else
             begin

funcext/tvclib/tcontrol.tsf

@@ -115,7 +115,7 @@ type tcontrol = class(tcomponent)
         end
         if ifnil(Value)then
         begin
-            if FActionLink then
+            if (FActionLink is class(TActionLink) ) then
             begin
                 FActionLink.SetAction(nil);
             end
@@ -124,7 +124,7 @@ type tcontrol = class(tcomponent)
         if Value is class(TBasicAction)then
         begin
             includestate(FControlStyle,csActionClient);
-            if ifnil(FActionLink)then FActionLink := createobject(GetActionLinkClass(),self);
+            if not(FActionLink is class(TActionLink) )then FActionLink := createobject(GetActionLinkClass(),self);
             FActionLink.Action := Value;
             FActionLink.Onchange := thisfunction(DoActionChange);
             ActionChange(Value,csLoading in Value.ComponentState);
@@ -145,7 +145,7 @@ type tcontrol = class(tcomponent)
         begin
             return FActionLink;
         end
-        if FActionLink then
+        if FActionLink is class(TActionLink) then
         begin
             return FActionLink.Action;
         end
@@ -298,7 +298,6 @@ type tcontrol = class(tcomponent)
         @ignore 忽略 %% 
         @explan(说明) 绑定处理函数到消息id %%
         **}
-        if not ifarray(FMessagehandle)then FMessagehandle := array();
         if ifnumber(id)and (iffuncptr(func))then FMessagehandle[id]:= func;
     end
     private //事件绑定处理
@@ -335,6 +334,10 @@ type tcontrol = class(tcomponent)
             if v["access"]in array(2,3)then continue;
             fstring := v["functionname"];
             if not ifstring(fstring)then continue;
+            vpms := v["parameter"];
+            if not ifarray(vpms) then continue;
+            lvpms := length(vpms);
+            if lvpms=1 then continue;            
             //f := findfunction(fstring,o);
             returntype := v["returntype"];
             try
@@ -664,7 +667,7 @@ type tcontrol = class(tcomponent)
         end 
         end }
     end
-    function MouseHover(o,e);virtual;
+    function MouseEnter(o,e);virtual;
     begin
         if not FMouseEntereded then
         begin
@@ -845,14 +848,7 @@ type tcontrol = class(tcomponent)
         CallMessgeFunction(FOnMouseDown,o,e);
         MouseDown(o,e);
     end
-    function WMMOUSEHOVER(o,e):WM_MOUSEHOVER;virtual;
+    
-    begin
-        MouseHover(o,e);
-    end
-    function WMMOUSELEAVE(o,e):WM_MOUSELEAVE;virtual;
-    begin
-        MouseLeave(o,e);
-    end
     function WMMouseMove(o,e):LM_MOUSEMOVE;virtual;
     begin
         CallMessgeFunction(FOnMouseMove,o,e);
@@ -1073,8 +1069,24 @@ type tcontrol = class(tcomponent)
             if SetTempCursor(cr)then e.skip := true;
         end
     end
+    function CMMouseEnter(o,e):CM_MOUSEENTER;virtual;
+    begin
+        MouseEnter(o,e);
+    end
+    function CMMouseLeave(o,e):CM_MOUSELEAVE;virtual;
+    begin
+        MouseLeave(o,e);
+    end
     public //暂时不用的消息
     {
+    function WMMOUSEHOVER(o,e):WM_MOUSEHOVER;virtual;
+    begin
+        MouseHover(o,e);
+    end
+    function WMMOUSELEAVE(o,e):WM_MOUSELEAVE;virtual;
+    begin
+        MouseLeave(o,e);
+    end
     function WMWindowPosChanged(o,e):LM_WINDOWPOSCHANGED;virtual;
     begin
     end
@@ -1096,12 +1108,7 @@ type tcontrol = class(tcomponent)
     function CMHitTest(o,e):CM_HITTEST;virtual;
     begin
     end
-    function CMMouseEnter(o,e):CM_MOUSEENTER;virtual;
+    
-    begin
-    end
-    function CMMouseLeave(o,e):CM_MOUSELEAVE;virtual;
-    begin
-    end
     function CMHintShow(o,e):CM_HINTSHOW;virtual;
     begin
     end
@@ -1199,6 +1206,7 @@ type tcontrol = class(tcomponent)
     end
     function create(aOwner);override; //构造函数
     begin
+        FMessagehandle := array(); 
         inherited;
         fignore_childsizing := false;
         FControlFlags := array(); 
@@ -1363,7 +1371,7 @@ type tcontrol = class(tcomponent)
         @param(e)(tuieventbase) 消息类及其子类 %%
         **}
         id := e.Msg;
-        if ifnumber(id) and FMessagehandle then 
+        if (id>0 or id<0) and FMessagehandle then 
         begin 
             func := FMessagehandle[id];
             if func then call(func,o,e);
@@ -1622,8 +1630,8 @@ type tcontrol = class(tcomponent)
     	@param(OnPopupMenu)(function[TControl,TMMouse]) 弹出菜单回调函数 %%
     	@param(OnMouseDown)(function[TControl,TMMouse]) 鼠标按下回调函数 %%
     	@param(OnMouseUp)(function[TControl,TMMouse]) 鼠标松开回调函数 %%
-    	@param(OnClick)(function[TControl,TMMouse]) 鼠标点击回调函数 %%
+    	@param(OnClick)(function[TControl]) 鼠标点击回调函数 %%
-    	@param(OnDblClick)(function[TControl,TMMouse]) 鼠标双击回调函数 %%
+    	@param(OnDblClick)(function[TControl]) 鼠标双击回调函数 %%
     	@param(PopupMenu)(tpopupmenu) 弹出菜单%%
     	@param(Parent)(tcontrol) 父控件 %%
     	@param(Visible)(bool) 是否可见 %%
@@ -1660,16 +1668,16 @@ type tcontrol = class(tcomponent)
     property ControlFlags read fControlFlags ; 
     property Color:color read getcolor write  SetColor;//FColor;
     property BKBitmap:tbitmap read FBKBitmap write SetBitmap;
-    //property OnMouseEnter:eventhandler read FOnMouseEnter write FOnMouseEnter;
+    property OnMouseEnter:eventhandler read FOnMouseEnter write FOnMouseEnter;
-    //property OnMouseLeave:eventhandler read FOnMouseLeave write FOnMouseLeave;
+    property OnMouseLeave:eventhandler read FOnMouseLeave write FOnMouseLeave;
     property Controls read FControls;
     property Canvas: TCanvas read FCanvas;		
     property ignore_childsizing read fignore_childsizing write fignore_childsizing; //忽略
     {**
     	@param(Canvas)(TCanvas) 画布对象 %%
     	@param(Controls)(TFpList of tcontrol) 子组件 %%
-    	@param(OnMouseLeave)(function[TControl,tuieventbase]) 鼠标离开回调 %%
+    	@param(OnMouseLeave)(function[TControl]) 鼠标离开回调 %%
-    	@param(OnMouseEnter)(function[TControl,tuieventbase]) 鼠标进入回调 %%
+    	@param(OnMouseEnter)(function[TControl]) 鼠标进入回调 %%
     	@param(Color)(integer) 背景色 %%
     **}
     function isCustomPaint(); //提供给gtk使用

funcext/tvclib/tcustomcontrol.tsf

@@ -90,64 +90,14 @@ type tcustomcontrol=class(TWinControl)
     begin
         return DoHScroll(o,e);
     end
-
+    function MainWndProc(hwnd,message,wparam,lparam);override;
-    function WMLButtonDown(o,e);override;//拖拽释放
-    begin
-        if fhassplitter<1 then return inherited;
-        if csDesigning in ComponentState then exit;
-        case fcurspltype of
-            alLeft,alRight:
-            begin
-                drgidx := 1;    
-            end 
-            alTop,alBottom:
-            begin
-                drgidx := 0;
-            end 
-            else
-            begin
-                return inherited;
-            end         
-        end ;  
-        if fsplitterwilldrag then
-        begin
-            cimgst();
-            fsplitterwilldrag := false;
-            fsplitterdraging := true;
-            nxy := clienttowindow(e.xpos,e.ypos);
-            _wapi.ImageList_BeginDrag(fsplitterdragimglist.Handle,drgidx,12,12);
-            _wapi.ImageList_DragEnter(self.Handle,nxy[0],nxy[1]);
-            crect := clientrect;
-            ps := array(clienttoscreen(crect[0],crect[1]),clienttoscreen(crect[2],crect[3]));
-            _wapi.clipcursor(ps);
-            splitterenabled(false);
-            return ;
-        end
-        //end
-        inherited;
-    end
-    function WMLBUTTONUP(o,e);override;//拖拽实现
-    begin
-        if fhassplitter<1 then return inherited;
-        if csDesigning in ComponentState then return ;
-        if fsplitterdraging then
-        begin
-            cimgst();
-            _wapi.ImageList_DragLeave(self.Handle);
-            _wapi.ImageList_EndDrag();                   
-            splitterenabled(true);
-            fsplitterwilldrag := true;
-            fsplitterdraging := false;
-            sizeprive(e.pos); 
-            _wapi.clipcursor(0);
-            return ;
-        end
-        return inherited;
-    end
-    function WMMouseMove(o,e);override; //移动
     begin
         if fhassplitter<1 then return inherited;
         if csDesigning in ComponentState then return inherited;
+        case message of
+            WM_MOUSEMOVE:  //移动
+            begin                  
+                e := new unit(utslvclevent).TMMouse(message,wparam,lparam,hwnd); 
                 if fsplitterdraging then
                 begin
                     cimgst();
@@ -162,7 +112,7 @@ type tcustomcontrol=class(TWinControl)
                     fcursplitter := nil;
                     for i,v in Controls.data do 
                     begin
-                if (v is class(tcustomsplitter)) and (v.Visible) and (v.enabled) and  pointinrect(xy,v.BoundsRect) and (v<>fcursplitter) then //拖拽
+                        if (v is class(tcustomsplitter)) and (v.Visible) and (v.enabled) and  pointinrect(xy,v.BoundsRect) and (v<>fcursplitter) and (v.Align in array(alLeft,alRight,alTop,alBottom)) then //拖拽
                         begin
                             va := v.Align;
                             if va in array(alLeft,alRight) then 
@@ -181,11 +131,61 @@ type tcustomcontrol=class(TWinControl)
                                 fcursplitterid := i;
                                 return ;
                             end         
-
                         end                
                     end 
                     cursor := OCR_NORMAL;       
                 end         
+            end 
+            WM_LBUTTONDOWN: //按下
+            begin
+                case fcurspltype of
+                    alLeft,alRight:
+                    begin
+                        drgidx := 1;    
+                    end 
+                    alTop,alBottom:
+                    begin
+                        drgidx := 0;
+                    end 
+                    else
+                    begin
+                        return inherited;
+                    end         
+                end ;                  
+                if fsplitterwilldrag then
+                begin
+                    e := new unit(utslvclevent).TMMouse(message,wparam,lparam,hwnd); 
+                    cimgst();
+                    fsplitterwilldrag := false;
+                    fsplitterdraging := true;
+                    nxy := clienttowindow(e.xpos,e.ypos);
+                    _wapi.ImageList_BeginDrag(fsplitterdragimglist.Handle,drgidx,12,12);
+                    _wapi.ImageList_DragEnter(self.Handle,nxy[0],nxy[1]);
+                    crect := clientrect;
+                    ps := array(clienttoscreen(crect[0],crect[1]),clienttoscreen(crect[2],crect[3]));
+                    _wapi.clipcursor(ps);
+                    splitterenabled(false);
+                    return ;
+                end            
+            end 
+            WM_LBUTTONUP:
+            begin
+                if fsplitterdraging then
+                begin
+                    e := new unit(utslvclevent).TMMouse(message,wparam,lparam,hwnd); 
+                    cimgst();
+                    _wapi.ImageList_DragLeave(self.Handle);
+                    _wapi.ImageList_EndDrag();                   
+                    splitterenabled(true);
+                    fsplitterwilldrag := true;
+                    fsplitterdraging := false;
+                    sizeprive(e.pos); 
+                    _wapi.clipcursor(0);
+                    return ;
+                end
+            end 
+        
+        end 
         return inherited;    
     end 
     property OnPaint:eventhandler read FOnPaint write FOnPaint;

funcext/tvclib/tcustomsplitter.tsf

@@ -13,15 +13,22 @@ type tcustomsplitter = class(tgraphiccontrol)
     function paint();override;
     begin
         //inherited;
+        p := parent;
+        if not p then return ;
         r := ClientRect;
         dc := Canvas;
         if Border then 
         begin                        
             dc.pen.color := 0;
             dc.pen.Width := 2;
-            dc.draw("polygon",array(r[0:1],r[array(2,1)],r[array(2,3)],r[array(0,3)],r[0:1]));
+            dc.draw("polyline",array(r[0:1],r[array(2,1)],r[array(2,3)],r[array(0,3)],r[0:1]));
         end 
-        clr := 0x123232;
+        ////////////点的颜色/////////////////////////
+        if TRANSPARENT then c := p.color;
+        else 
+            c := color;
+        ////////////////////////////
+        clr := sys_complementar_color(c);
         x := integer(r[0]+(r[2]-r[0])/2);
         y := integer(r[1]+(r[3]-r[1])/2);
         sz := 4;
@@ -39,8 +46,18 @@ type tcustomsplitter = class(tgraphiccontrol)
             end 
         end 
     end 
-    function SetAlign(a);override;
+    private 
+    function sys_complementar_color(c);
+    begin
+        uses utslvclauxiliary;
+        if (c .& 0xff000000) then 
+        begin 
+            return complementary_color( _wapi.GetSysColor(c .& 0x00ffffff));
+        end   
+        return complementary_color(c);  
+    end
+    {function SetAlign(a);override;
     begin
         inherited;
-    end 
+    end }
 end 

funcext/tvclib/tslvcl.tsf

@@ -313,6 +313,11 @@ type tapplication=class(tcomponent)
             fexitdolist.Push(f);
         end 
     end 
+    function DoBeforeMouseMessage(ctl);
+    begin
+        UpdateMouseControl(ctl);     
+    end 
+    published
     property color read getcolor write setcolor;
     property font read getfont write setfont;
     property Visible read FVisible write SetVisible;
@@ -321,6 +326,25 @@ type tapplication=class(tcomponent)
     property MainForm read Fmainform write SetMainForm;
     private 
     fexitdolist;
+    [weakref]FMouseControl;//鼠标所在的控件
+    private 
+    function UpdateMouseControl(ctl);
+    begin
+        if FMouseControl=ctl then return ;
+        if FMouseControl then 
+        begin
+            FMouseControl.Perform(new tuieventbase(CM_MOUSELEAVE,0,0,0)); //        
+        end
+        FMouseControl := ctl;
+        //////////////处理提示///////////////////
+        
+        ////////////////////////////////////
+        if FMouseControl then 
+        begin
+            FMouseControl.Perform(new tuieventbase(CM_MOUSEENTER,0,0,0));     
+        end 
+             
+    end 
     function exitloopdo();
     begin        
         if fexitdolist then 

funcext/tvclib/twincontrol.tsf

@@ -27,7 +27,6 @@ type TWinControl = class(tcontrol)
     FWMNCHITTEST;
     FImageList;
     fchildsizing;
-    //FTRACKMOUSEEVENT;
     FHandle:HWND; //窗口句柄
     private //窗口相关
     FBorderStyle;
@@ -325,6 +324,23 @@ type TWinControl = class(tcontrol)
         end
         UpdateControlState();
     end
+    function Hitcontrol(p);
+    begin
+        {**
+        @explan(说明) 命中自绘制控件 %%
+        **}
+        for i := ControlCount-1 downto 0 do
+        begin
+            it := Controls[i];
+            if it is class(TGraphicControl)then
+            begin
+                if it.Enabled and it.Visible and pointinrect(p,it.GetBoundsRect)then
+                begin
+                    return it;
+                end
+            end
+        end
+    end
     protected
     function SetParentFont(v:bool);override;
     begin
@@ -607,82 +623,43 @@ type TWinControl = class(tcontrol)
             end }
         end
     end
-    function Hitcontrol(p);
+    
-    begin
-        {**
-        @explan(说明) 命中控件 %%
-        **}
-        for i := ControlCount-1 downto 0 do
-        begin
-            it := Controls[i];
-            if it is class(TGraphicControl)then
-            begin
-                if it.Enabled and it.Visible and pointinrect(p,it.GetBoundsRect)then
-                begin
-                    return it;
-                end
-            end
-        end
-    end
-    function MouseHover(O,e);override;
-    begin
-        inself := true;
-        initem := 0;
-        for i := ControlCount-1 downto 0 do
-        begin
-            it := FControls[i];
-            if(it is class(TGraphicControl))and it.visible then
-            begin
-                if inself and pointinrect(array(e.lolparamsigned,e.hilparamsigned),it.GetBoundsRect)and it.Enabled then
-                begin
-                    initem := it;
-                    inself := false;
-                end else
-                begin
-                    it.Perform(messagecreater(nil,WM_MOUSELEAVE,0,0));
-                end
-            end
-        end
-        if inself then return inherited;
-        else self.Perform(messagecreater(nil,WM_MOUSELEAVE,0,0));
-        if initem then initem.Perform(messagecreater(nil,WM_MOUSEHOVER,0,0));
-    end
     public //消息绑定函数
     function WMMouseMove(o,e):LM_MOUSEMOVE;override;
     begin
-        it := Hitcontrol(e.pos);
+        {it := Hitcontrol(e.pos);
         if it then
         begin
             return it.WMMouseMove(it,new TMMouse(LM_MOUSEMOVE,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
             //return it.Perform(new TMMouse(LM_MOUSEMOVE,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
-        end
+        end}
         inherited;
     end
     function WMLButtonUp(o,e):LM_LBUTTONUP;override;
     begin
-        it := Hitcontrol(e.pos);
+        {it := Hitcontrol(e.pos);
         if it then
         begin
             return it.WMLButtonUp(it,new TMMouse(LM_LBUTTONUP,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
-        end
+        end}
         inherited;
     end
     function WMRButtonUp(o,e):LM_RBUTTONUP;override;
     begin
-        it := Hitcontrol(e.pos);
+        {it := Hitcontrol(e.pos);
         if it then
         begin
             return it.WMRButtonUp(it,new TMMouse(LM_RBUTTONUP,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
-        end
+        end}
         inherited;
     end
     function WMMButtonUp(o,e):LM_MBUTTONUP;override;
     begin
-        it := Hitcontrol(e.pos);
+        {it := Hitcontrol(e.pos);
         if it then
         begin
             return it.WMMButtonUp(it,new TMMouse(LM_MBUTTONUP,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
-        end
+        end}
         inherited;
     end
     function WMContextMenu(o,e):LM_CONTEXTMENU;override;
@@ -701,39 +678,39 @@ type TWinControl = class(tcontrol)
     end
     function WMLButtonDown(o,e):LM_LBUTTONDOWN;override;
     begin
-        it := Hitcontrol(e.pos);
+        {it := Hitcontrol(e.pos);
         if it then
         begin
             return it.WMLButtonDown(it,new TMMouse(LM_LBUTTONDOWN,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
-        end
+        end}
         inherited;
     end
     function WMRButtonDown(o,e):LM_RBUTTONDOWN;override;
     begin
-        it := Hitcontrol(e.pos);
+        {it := Hitcontrol(e.pos);
         if it then
         begin
             return it.WMRButtonDown(it,new TMMouse(LM_RBUTTONDOWN,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
             //return it.Perform(new TMMouse(LM_MOUSEMOVE,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
-        end
+        end}
         inherited;
     end
     function WMMButtonDown(o,e):LM_MBUTTONDOWN;override;
     begin
-        it := Hitcontrol(e.pos);
+        {it := Hitcontrol(e.pos);
         if it then
         begin
             return it.WMMButtonDown(it,new TMMouse(LM_MBUTTONDOWN,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
-        end
+        end}
         inherited;
     end
     function WMLButtonDBLCLK(o,e):LM_LBUTTONDBLCLK;override;
     begin
-        it := Hitcontrol(e.pos);
+        {it := Hitcontrol(e.pos);
         if it then
         begin
             return it.WMLButtonDBLCLK(it,new TMMouse(LM_LBUTTONDBLCLK,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
-        end
+        end}
         inherited;
     end
     public //设计器相关杂项
@@ -1040,10 +1017,7 @@ type TWinControl = class(tcontrol)
             rc.right := rc.right - wd;
         end
     end
-    function WMMOUSEHOVER(o,e):WM_MOUSEHOVER;virtual;
+    
-    begin
-        MouseHover(o,e);
-    end
     function WMMOUSELEAVE(o,e):WM_MOUSELEAVE;virtual;
     begin
         MouseLeave(o,e);
@@ -1986,7 +1960,6 @@ type TWinControl = class(tcontrol)
         FUpDateCount := 0;
         FTabStop := false;
         FBorderStyle := bsNone;
-        //FTRACKMOUSEEVENT := NEW TTRACKMOUSEEVENT();
         FWsPopUp := false;
         FWsSysMenu := false;
         FWsCapton := false;
@@ -2202,12 +2175,6 @@ type TWinControl = class(tcontrol)
         factivated := false;
         if HandleAllocated()then
         begin
-            {FTRACKMOUSEEVENT.hwndtrack := handle;
-            if OnMouseEnter or OnMouseLeave then 
-            begin 
-            FTRACKMOUSEEVENT.dwflags :=  TME_CANCEL .| TME_HOVER .| TME_LEAVE;
-            _wapi.TrackMouseEvent(FTRACKMOUSEEVENT._getptr_);
-            end }
             bv := FVisible;
             _wapi.DestroyWindow(self.Handle);
             FVisible := bv;
@@ -2347,8 +2314,31 @@ type TWinControl = class(tcontrol)
         @explan(说明)窗口主循环 %%
         **}
         //if message=0x85 and  not( WsCaption or border or WsDlgModalFrame) then return ;
+        if message=WM_NCMOUSEMOVE then 
+        begin
+            app := class(tUIglobalData).uigetdata("tuiapplication");
+            if app then app.DoBeforeMouseMessage(nil);    
+        end 
         e := messagecreater(hwnd,message,wparam,lparam); 
         e.sender := self(true);      
+        case message of 
+            LM_MOUSEFIRST to LM_MOUSELAST,
+            LM_MOUSEFIRST2 to LM_RBUTTONQUADCLK,
+            LM_XBUTTONTRIPLECLK to LM_MOUSELAST2 :
+            begin
+                ht := Hitcontrol(e.pos);
+                app := class(tUIglobalData).uigetdata("tuiapplication");
+                if app then app.DoBeforeMouseMessage(ht?:self(true));
+                msgs := array(LM_LBUTTONDBLCLK:1,LM_MBUTTONDOWN:1,LM_MOUSEMOVE:1,LM_LBUTTONUP:1
+                                ,LM_RBUTTONUP:1,LM_MBUTTONUP:1,LM_LBUTTONDOWN:1,LM_RBUTTONDOWN:1);
+                if ht and msgs[message] then 
+                begin                                        
+                    ee := new TMMouse(message,e.wparam,makelong(e.xpos-ht.left,e.ypos-ht.top));                   
+                    ht.dispatch(ht,ee);
+                    return defaulthandler(e);
+                end ;      
+            end
+        end; 
         if message = WM_SYSKEYDOWN or message = WM_KEYDOWN then  //快捷键实现
         begin
             WndProc(const e);
@@ -2435,13 +2425,6 @@ type TWinControl = class(tcontrol)
         //if message = WM_MOUSEMOVE then 
         if message=WM_NCHITTEST then //
         begin
-            {if  OnMouseEnter or OnMouseLeave then 
-            begin 
-            FTRACKMOUSEEVENT.hwndtrack := hwnd;
-            FTRACKMOUSEEVENT.dwflags :=   TME_HOVER .| TME_LEAVE;
-            FTRACKMOUSEEVENT.dwhovertime := 600;
-            _wapi.TrackMouseEvent(FTRACKMOUSEEVENT._getptr_);
-            end }
         end else
         if message=WM_STYLECHANGED then
         begin
@@ -2453,52 +2436,11 @@ type TWinControl = class(tcontrol)
                 __wstyle := e.stylenew;
             end
         end
-        (**else 
-        if message = WM_NCCALCSIZE then 
-        begin
-        if e.wparam=1 then 
-        begin
-        dt := new tNCCALCSIZE_PARAMS(e.lparam)._getvalue_("rgrc");
-        if dt[0]=-32000 then 
-        begin
-        //echo "\r\n隐藏到工具栏";
-        end 
-        else if dt[4] = -32000 then 
-        begin
-        //echo "\r\n从工具栏弹出";
-        end 
-        else
-        begin
-        //rect1 := dt[0:3];
-        //rect2 := dt[4:7];
-        //rect3 := dt[8:];
-        {dx := dt[2]-dt[0]-(dt[6]-dt[4]);
-        dy := dt[3]-dt[1]-(dt[7]-dt[5]);
-        __clientsize := array(dt[10]-dt[8]+dx,dt[11]-dt[9]+dy);
-        x := __clientsize[0];
-        dxsize := x-FClientWdith;
-        if FClientWdith<> x then  FClientWdith := x;
-        y := __clientsize[1];
-        dysize := y-FClientHeight;
-        if FClientHeight <> y then FClientHeight := y;
-        DoControlAnchor(array(dxsize,dysize));	
-        DoControlAlign(array(0,0,x,y));}
-        //__oldclientsize := array(dt[10]-dt[8],dt[11]-dt[9]);
-        end  
-    					
-        end 
-        else 
-        begin
-        //echo "\r\n++++calc:",caption,tostn(new tcrect(e.lparam)._getdata_);
-        end 
-        //echo "\r\ncalcsize:",o.caption,"****",e.wparam;
-        //echo "\r\nleft:", new tcrect(e.lparam).left;
-        end 
-        **)
         WndProc(const e);
         if not(e.skip)then
         begin
-            ret := defaulthandler(e);
+            if ifnil(e.Result) then ret := defaulthandler(e);
+            else ret := e.Result;
         end else
         begin
             {$ifdef linuxgtk}
@@ -2552,10 +2494,6 @@ type TWinControl = class(tcontrol)
             begin
                 e.Result := hit;
                 e.skip := true;  
-                {if (csDesigning in ComponentState) then 
-                begin 
-                    if al <> alNone then _send_(WM_USER,1644,1644,1);
-                end} 
             end             
         end
     end
@@ -2566,12 +2504,12 @@ type TWinControl = class(tcontrol)
     procedure WndProc(e);override; //type_twinctrol
     begin
         //WM_NCHITTEST 
+        msg := e.msg;	
         if (csDesigning in ComponentState)   then 
         begin 
-            msg := e.msg;		 
+            case msg of 
-            if msg = WM_NCHITTEST then 
+                WM_NCHITTEST:
                 begin
-                
                     r := FWMNCHITTEST.hitstyle(self(true),e);
                     if r<>HTCLIENT then 
                     begin 
@@ -2580,8 +2518,8 @@ type TWinControl = class(tcontrol)
                     begin 
                         return e.Result :=  Wnddefaulthandler(e);
                     end
-            end else 
+                end 
-            if msg= WM_LBUTTONDOWN then 
+                WM_LBUTTONDOWN:
                 begin
                     if  not(WsCaption) and DesigningMove() and (Align=alNone) then 
                     begin 
@@ -2594,36 +2532,16 @@ type TWinControl = class(tcontrol)
                     begin
                         CallMessgeFunction(FOnMouseUp,self(true),e);
                     end }
-            end else 
+                end 
-            if msg = WM_LBUTTONDBLCLK then 
+                WM_LBUTTONDBLCLK:
                 begin
                     CallMessgeFunction(FOnDesigDBLClick,self(true),e);	
-            end else 
+                end 
-            if msg = WM_RBUTTONDOWN then 
+                WM_RBUTTONDOWN:
                 begin
                     CallMessgeFunction(FOnDesinedRclick,self(true),e);
-            end else 
-            if msg = WM_USER then 
-            begin
-                if e.wparam=1644 and e.lparam=1644 then
-                begin 
-                    //Align=alNone;
-                    {al := Align;
-                    
-                    if al in array(alLeft,alRight,alTop,alBottom) then 
-                    begin 
-                        bs := UnAlignBounds;
-                        bs2 := BoundsRect;
-                        if bs <> bs2 then 
-                        begin 
-                            Align := alNone;
-                            Align := al;
                 end             
             end 	 
-                    }
-                end  
-                    
-            end 
         end
         inherited;
     end; 
@@ -2867,13 +2785,14 @@ type TWinControl = class(tcontrol)
             it := Controls[I];
             if it then 
             begin 
-                it.WindowProc(e);
+                it.WndProc(e); 
-                if e.skip then Exit;
+                //if e.skip then Exit;
-                if not ifnil(e.Result)then Exit;
+                //if not(ifnil(e.Result) or (e.Result =0))then Exit;
+                if e.Result then Exit;
             end 
         end;
     end;
-    procedure NotifyControls(Msg); //type_twinctrol
+    procedure NotifyControls(Msg:Integer); //type_twinctrol
     begin
         ToAllMessage := new tuieventbase(msg,0,0,0);
         Broadcast(ToAllMessage);

funcext/tvclib/ugtkinterface.tsf

@@ -178,6 +178,10 @@ type tsgtkapi = class(tgtkapis)
 		    function MessageBoxA(hwnd :pointer;txt:string;cap:string;flag:integer);
 		    begin
 		        return gtk_MessageBoxA(hwnd,txt,cap,flag);
+		    end 
+		    function IsIconic(); //×îС»¯
+		    begin
+		    
 		    end 
 		    function IsWindow(h);
 		    begin
@@ -1164,6 +1168,11 @@ type tsgtkapi = class(tgtkapis)
         if not dc then return ;
         if ifnumber(x) and ifnumber(y) then 
         begin
+            cairo_rectangle(dc,x-0.5,y-0.5,1,1); 
+            gtk_rgb_color_rgb(colr,r,g,b);  
+            cairo_set_source_rgb(dc,r,g,b);
+            cairo_fill(dc);        
+            return 1;
             pc := colr;		
             MoveToEx(dc,x,y);            
             pc := gtk_object_get_data(dc,"pen.color");		        
@@ -5858,6 +5867,17 @@ fi
         _f_ := static procedure(window:pointer);cdecl;external getfuncptrbyname(0,functionname());
         return ##_f_(window);
     end  
+      
+    function gtk_window_is_maximized(window:pointer):integer;
+    begin
+        _f_ := static function(window:pointer):integer;cdecl;external getfuncptrbyname(0,functionname());
+        return ##_f_(window);
+    end
+    procedure gtk_window_unmaximize(window:pointer);
+    begin
+        _f_ := static procedure(window:pointer);cdecl;external getfuncptrbyname(0,functionname());
+        return ##_f_(window);
+    end
     procedure gtk_window_maximize(window:pointer);
     begin
         _f_ := static procedure(window:pointer);cdecl;external getfuncptrbyname(0,functionname());
@@ -7864,6 +7884,11 @@ type tgtk_ctl_object = class(_gtkeventtype)
             end 
         end   
         case mn of
+            GS_LEAVE_NOTIFY_EVENT:  //À뿪
+            begin
+                id := a.handle;
+                AddMessageToGtkMessageQueue(id,_const.WM_NCMOUSEMOVE,0,0);
+            end   
             GS_ENTER_NOTIFY_EVENT:
             begin
                 fwindow_cursor := 0;
@@ -7926,7 +7951,7 @@ type tgtk_ctl_object = class(_gtkeventtype)
     function GtkBaseEventName();virtual; //°ó¶¨µÄÏûÏ¢
     begin
         //return array("destroy","map","button-press-event","motion-notify-event","button-release-event","key-press-event","key-release-event","event");   //,"set-focus-child"
-        return array(GS_DESTROY,GS_BUTTON_PRESS_EVENT,GS_MOTION_NOTIFY_EVENT,GS_BUTTON_RELEASE_EVENT,GS_KEY_PRESS_EVENT,GS_KEY_RELEASE_EVENT,GS_FOCUS_IN_EVENT,GS_FOCUS_OUT_EVENT,GS_WINDOW_STATE_EVENT,GS_EVENT,GS_ENTER_NOTIFY_EVENT);   //,"set-focus-child"
+        return array(GS_DESTROY,GS_BUTTON_PRESS_EVENT,GS_MOTION_NOTIFY_EVENT,GS_BUTTON_RELEASE_EVENT,GS_KEY_PRESS_EVENT,GS_KEY_RELEASE_EVENT,GS_FOCUS_IN_EVENT,GS_FOCUS_OUT_EVENT,GS_WINDOW_STATE_EVENT,GS_EVENT,GS_ENTER_NOTIFY_EVENT,GS_LEAVE_NOTIFY_EVENT);   //,"set-focus-child"
     end 
     function CreateWnd(dwExStyle,lpClassName,lpWindowName,dwStyle,x,y,nwidth,nheight,hwndparent,hmenu,hinstance,lpParam);virtual; //¹¹Ôì´°¿Ú
     begin

funcext/tvclib/utslmemo.tsf

@@ -3149,6 +3149,9 @@ type tcustomsynhighlighter = class(TSynHighLighter)
     function create(AOwner);
     begin
         inherited;
+        fkeywords := array();
+        fsysfuncs := array();
+        fsymbols := array();
         fsymcolor := 0xa000a0;
         fnumbercolor := 0x666666;
         fkeywordcolor := 0x0000ff;
@@ -3330,6 +3333,7 @@ type tcustomsynhighlighter = class(TSynHighLighter)
         end
         inherited;
     end 
+    published
     property keywordcolor:color read fkeywordcolor write fkeywordcolor;
     property sysfuncolor:color read fsysfuncolor write fsysfuncolor;
     property stringcolor:color read fstringcolor write fstringcolor;
@@ -3337,6 +3341,9 @@ type tcustomsynhighlighter = class(TSynHighLighter)
     property symcolor:color read fsymcolor write fsymcolor;
     property numbercolor:color read fnumbercolor write fnumbercolor;
     property ignorecase:bool  read fignorecase write setignorecase;
+    property keywords:strings read fkeywords write setkeyword; 
+    property sysfuncs:strings read fsysfuncs write setsysfun; 
+    property symbols:strings read fsymbols write setsyms; 
     private
     function setignorecase(i);
     begin
@@ -3528,9 +3535,14 @@ type tcustomsynhighlighter = class(TSynHighLighter)
     function setkeyword(ws); //设置关键字
     begin
         st := new TTire();
+        fkeywords := array();
         for i,v in ws do 
         begin
-            if v and ifstring(v) then st.add(v);
+            if v and ifstring(v) then 
+            begin
+                st.add(v);
+                fkeywords[length(fkeywords)] := v;
+            end 
         end         
         fkeystires := array(st);
     end 
@@ -3575,12 +3587,14 @@ type tcustomsynhighlighter = class(TSynHighLighter)
     begin
         st := new TTire();
         fsysfuntires := array(st);
+        fsysfuncs := array();
         if not ifarray(d) then return ;
         for i,v in d do 
         begin
             if ifstring(v) and v then 
             begin
                 st.add(v);
+                fsysfuncs[length(fsysfuncs)] := v;
             end 
         end 
     end 
@@ -3588,11 +3602,13 @@ type tcustomsynhighlighter = class(TSynHighLighter)
     begin
         st := new TTire();
         fsymstires := array(st);
+        fsymbols := array();
         for i,v in d do 
         begin
             if ifstring(v) and v then 
             begin
                 st.add(v);
+                fsymbols[length(fsymbols)] := v;
             end 
         end 
     end 
@@ -3716,8 +3732,10 @@ type tcustomsynhighlighter = class(TSynHighLighter)
     FSates; //当前状态
     FTokens; 
     fdolastline; //已经处理到行
-    
+    ////////////////////////////////////
-    
+    fkeywords; //关键字
+    fsysfuncs; //系统函数
+    fsymbols; //符号
     ///////tire树/////////////
     fkeystires;
     fstrstires;

funcext/tvclib/utslvclaction.tsf

@@ -32,7 +32,7 @@ type TBasicAction=class(TComponent)
     {**
     @param(FClients)( TFpList of TActionLink) 关联的组件 %%
     **}
-    procedure Change;virtual;
+    procedure Change();virtual;
     begin
         if iffuncptr(FOnChange) then call(FOnChange,self);
     end
@@ -155,6 +155,7 @@ type TCustomAction=class(TContainedAction)
     @explan(说明) action类 %%
     **}
     private
+    fimageid:Integer;
     FCaption:string;
     FChecked:Boolean;
     FChecking:Boolean;
@@ -199,6 +200,15 @@ type TCustomAction=class(TContainedAction)
         FVisible := nValue;
         Change();
     end
+    procedure Setimageid(Value:Integer);
+    begin
+        if not ifnumber(Value) then return ;
+        nValue := Integer(Value);
+        if nValue=fimageid then exit;
+        for I := 0 to FClients.Count-1 do FClients[I].setimageid(nValue);
+        fimageid := nValue;
+        Change();
+    end
     function getShortCut();
     begin
         return  formatshortcut(FShortCut);
@@ -230,7 +240,7 @@ type TCustomAction=class(TContainedAction)
         if Dest=Self then exit;
         if Dest is class(TCustomAction)then
         begin
-            ps := array("checked","caption","visible","enabled","shortcut");
+            ps := array("checked","caption","visible","enabled","shortcut","imageid");
             for i,v in ps do invoke(Dest,v,1,invoke(self,v));
         end else
         inherited;
@@ -242,6 +252,7 @@ type TCustomAction=class(TContainedAction)
         @explan(说明) 构造 %%
         **}
         inherited;
+        fimageid := -1;
         FEnabled := True;
         FVisible := True;
     end
@@ -275,6 +286,7 @@ type TCustomAction=class(TContainedAction)
     property Checked:bool read FChecked write SetChecked;
     property Enabled:bool read FEnabled write SetEnabled;
     property Visible:bool read FVisible write SetVisible;
+    property imageid:Integer read fimageid write setimageid;
     property ShortCut:string read getshortcut write SetShortCut;  
 end;
 type TCustomactionlist=class(TComponent)
@@ -350,7 +362,7 @@ type TBasicActionLink=class(TSLUIBASE)
     procedure AssignClient(AClient:TObject);virtual;
     begin
     end
-    procedure Change;virtual;
+    procedure Change();virtual;
     begin
         if iffuncptr(FOnChange) then call(OnChange,FAction);
     end
@@ -432,6 +444,9 @@ type TActionLink=class(TBasicActionLink)
     procedure SetVisible(Value:Boolean);virtual;
     begin
     end
+    procedure setimageid(value:Integer);virtual;
+    begin    
+    end 
     function create(AClient);override;
     begin
         inherited;
@@ -461,6 +476,10 @@ type TActionLink=class(TBasicActionLink)
     begin
         return Action is CLASS(TCustomAction);
     end
+    function IsImageIndexLinked():Boolean;virtual;
+    begin
+        return false;
+    end 
 end;
 
 type TControlActionLink=class(TActionLink)

funcext/tvclib/utslvclauxiliary.tsf

@@ -1815,7 +1815,7 @@ type TNode = class() //
     end
     function node_insert_check(it);virtual;
     begin
-        return (it is class(TNode))and(not it.Parent);
+        return (it is class(TNode))and(not it.Parent) and ckchild(it);
     end 
     function Expand();virtual; //展开
     begin
@@ -1904,6 +1904,16 @@ type TNode = class() //
     FCurrentDeleteNode;
     FCurrentAddNode;
     FExpanded;
+    function ckchild(c); //检查子节点
+    begin
+        sf := self(true);
+        while sf do 
+        begin
+            if sf=c then return false;
+            sf := sf.Parent;            
+        end
+        return true;
+    end
     function SetExpand(v);virtual; //已经展开
     begin
         if v then Expanded();
@@ -3450,9 +3460,8 @@ end;
 //////////////////////////////////////
 function iffuncptr(fn);
 begin
-    return datatype(fn) in array(7,37);
+    dt := datatype(fn);
-    //return datatype(fn)=7;
+    return ((dt=7) or (dt=37)); 
-    //return fn and ifobj(fn);
 end 
 function includestate(u,s);
 begin
@@ -3776,18 +3785,6 @@ begin
     end else
     return tostn(d);
 end
-
-function DeleteItemsByIndexs(r,dxs);
-begin
-    {**
-    @explan(说明) 删除数组下标, %%
-    @param(r)(array) 待删除下标的数组,采用字符串下标的数组,变参返回%%;
-    **}
-    if not ifarray(r)then exit;
-    rdx := array();
-    for i,v in dxs do rdx[v]:= nil;
-    return reindex(r,rdx);
-end
 function HexHash();
 begin
     c := array("A","B","C","D","E","F");
@@ -4370,13 +4367,12 @@ begin
             continue;
         end else 
         begin 
+            if i>=len then return false;  //加入判断避免越界
             ordi2 := ord(data[i + 1]);
             //大于127的使用双字节编码
-            if  (ordi >= 0x81 and
+            if  ( ordi >= 0x81 and ordi <= 0xfe) and 
-                ordi <= 0xfe and 
+                (ordi2 >= 0x40 and ordi2 <= 0xfe) and 
-                ordi2 >= 0x40 and 
+                (ordi2 <> 0x7f) then 
-                ordi2 <= 0xfe and 
-                ordi2 <> 0x7f) then 
                 begin 
                 i += 2;
                 continue;

funcext/tvclib/utslvclbase.tsf

@@ -49,7 +49,8 @@ uses uwindowsinterface;
             mh := MonitorFromRect(r1,2);
             info := new TMONITORINFO();
             GetMonitorInfoA(mh,info._getptr_);
-            return info.rcmonitor;
+            //return info.rcmonitor;
+            return info.rcwork;
         end 
         rc := new tcrect();
         SystemParametersInfoA(0x30,0,rc._getptr_(),0);

funcext/tvclib/utslvclmenu.tsf

@@ -358,6 +358,11 @@ private
     protected
     function SetAction(Value);virtual;
     begin
+        if csDesigning in ComponentState then
+        begin
+            FActionLink := Value;
+            return;
+        end
         if ifnil(Value)then
         begin
             if FActionLink then
@@ -369,7 +374,7 @@ private
         if Value is class(TBasicAction)then
         begin
             includestate(FControlStyle,csActionClient);
-            if ifnil(FActionLink)then FActionLink := createobject(GetActionLinkClass(),self);
+            if not(FActionLink is class(TActionLink) ) then FActionLink := createobject(GetActionLinkClass(),self);
             FActionLink.Action := Value;
             FActionLink.Onchange := thisfunction(DoActionChange);
             ActionChange(Value,csLoading in Value.ComponentState);
@@ -382,7 +387,7 @@ private
     end
     function GetAction();virtual;
     begin
-        if FActionLink then
+        if FActionLink is class(TActionLink) then
         begin
             return FActionLink.Action;
         end

funcext/tvclib/utslvclpage.tsf

@@ -22,7 +22,8 @@ type tcustomtabsheet = class(TCustomControl) //
     public 
     function AdjustSize();override;
     begin
-        class(tcontrol).AdjustSize();
+        //class(tcontrol).AdjustSize();
+        inherited;
     end
     function paint();override; //设计器模式下绘制网格
     begin
@@ -817,8 +818,8 @@ type tcustompagecontrol = class(tcustomtabcontrol)
             h := height;
             return ;
         end 
-        w := 100;
+        w := 25;
-        h := 100;  
+        h := 25;  
         for i:= 0 to len-1 do 
         begin 
             FTabItems[i].PageSheet.GetPreferredSize(wi,hi); 

funcext/tvclib/utslvclstdctl.tsf

@@ -3780,7 +3780,7 @@ type TcustomListBox=class(TCustomListBoxbase)
             nh := min(h,16);
             nnh := integer((h-nh)/2); 
             rc2 := array(rc[0]+2,rc[1]+nnh,rc[0]+nh+2,rc[3]-nnh);
-            if fcheckbox=2 then 
+            if FMultisel=0 then 
             begin 
                 cvs.Draw("framecontrol",array(rc2[0:1],rc2[2:3]),DFC_BUTTON,DFCS_BUTTONRADIO);
                 if r then 
@@ -5139,9 +5139,14 @@ type TcustomToolButton=class(tcomponent)
     protected //action 
     function SetAction(Value);virtual;
     begin
+        if csDesigning in ComponentState then
+        begin
+            FActionLink := Value;
+            return;
+        end
         if ifnil(Value)then
         begin
-            if FActionLink then
+            if FActionLink is class(TActionLink) then
             begin
                 FActionLink.SetAction(nil);
             end
@@ -5150,7 +5155,7 @@ type TcustomToolButton=class(tcomponent)
         if Value is class(TBasicAction)then
         begin
             includestate(FControlStyle,csActionClient);
-            if ifnil(FActionLink)then FActionLink := createobject(GetActionLinkClass(),self);
+            if not(FActionLink is class(TActionLink) ) then FActionLink := createobject(GetActionLinkClass(),self);
             FActionLink.Action := Value;
             FActionLink.Onchange := thisfunction(DoActionChange);
             ActionChange(Value,csLoading in Value.ComponentState);
@@ -5163,7 +5168,7 @@ type TcustomToolButton=class(tcomponent)
     end
     function GetAction();virtual;
     begin
-        if FActionLink then
+        if FActionLink is class(TActionLink) then
         begin
             return FActionLink.Action;
         end
@@ -5184,6 +5189,7 @@ type TcustomToolButton=class(tcomponent)
             if(not CheckDefaults)or(Caption='')or(Caption=Name)then Caption := NewAction.Caption;
             if(not CheckDefaults)then ShortCut := NewAction.ShortCut;
             if(not CheckDefaults)or Enabled then Enabled := NewAction.Enabled;
+            if(not CheckDefaults) then imageid := NewAction.imageid;
             //if not CheckDefaults or FChecked then Checked := NewAction.Checked;
         end;
     end
@@ -5471,7 +5477,11 @@ type TcustomToolBar=class(TCustomControl)
                 FButtons.swap(i,i+1);
             end
         end
-        if Btn.Visible then InvalidateRect(nil,false);
+        if Btn.Visible then 
+        begin
+            CalcButtonsRect();
+            InvalidateRect(nil,false);
+        end 
         return cidx;
     end
     function InsertButton(btn,idx);
@@ -5496,10 +5506,11 @@ type TcustomToolBar=class(TCustomControl)
         if nidx >= 0 then SetBtnIndex(btn,nidx);
         if btn.Visible then
         begin
-            IncPaintLock();
+            CalcButtonsRect();
+            //IncPaintLock();            
             InvalidateRect(nil,false);
             FWillModifyToolbar := true;
-            DecPaintLock();
+            //DecPaintLock();
         end
     end
     function DeleteButton(btn); //删除按钮
@@ -5518,10 +5529,11 @@ type TcustomToolBar=class(TCustomControl)
         FButtons.splice(idx,1);
         if btn.Visible then
         begin
-            IncPaintLock();
+            CalcButtonsRect();
+            //IncPaintLock();            
             InvalidateRect(nil,false);
             FWillModifyToolbar := true;
-            DecPaintLock();
+            //DecPaintLock();
         end
     end
     function GetItemRect(btn); //获得按钮区域
@@ -6113,12 +6125,12 @@ type TcustomStatusBar=class(TCustomControl)
     end
     function GetPreferredSize(w,h);override;
     begin
-        class(tcontrol).GetPreferredSize(w,h);
+        if ControlCount>0 then class(TWinControl).GetPreferredSize(w,h);
-        if iffuncptr(onGetPreferredSize) then return ;
+        if iffuncptr(onGetPreferredSize) then return inherited;
-        bs := BoundsRect;
+        ft := Font;
-        cs := ClientRect;
+        if not ft then return;
-        dh := (bs[3]-bs[1])-(cs[3]-cs[1])+2;
+        c := caption;        
-        h+=dh;
+        h := max(h,ft.Height+4); 
         w := Width;
     end 
     published
@@ -8177,6 +8189,10 @@ type TtoolbuttonActionLink=class(TControlActionLink)
     begin
         return FClient and(Action is CLASS(TCustomAction));
     end 
+    function IsImageIndexLinked():Boolean;override;
+    begin
+        return true;
+    end 
     function IsCheckedLinked():Boolean;override;
     begin
         return false;
@@ -8186,6 +8202,10 @@ type TtoolbuttonActionLink=class(TControlActionLink)
     begin
         if IsshortcutLinked() then return FClient.ShortCut := Value;
     end 
+    procedure setImageid(value:Integer);override;
+    begin
+        if IsImageIndexLinked() and FClient then FClient.imageid := value;
+    end 
     function create(AOwner);override;
     begin
         inherited;

funcext/tvclib/utslvcltree.tsf

@@ -102,6 +102,8 @@ type ttreelistwnd = class(TCustomScrollControl)
     public  //常用方法
     function Create(AOwner);override;
     begin
+        fshowseparators := false;
+        fseparatorcolor := 0;
         inherited;                  
     end
     function AfterConstruction();override;
@@ -383,11 +385,28 @@ type ttreelistwnd = class(TCustomScrollControl)
         x := wd *(0-xPos);
         rc := ClientRect;
         PrevPaint(FirstLine,LastLine);
+        ls := array();
         for i := FirstLine to LastLine do
         begin
             nrc := GetIndexRect(i);
             it := FItems[i];
             it.paint(cvs,x,nrc[1],rc[2]-rc[1]-x,ht);
+            if fshowseparators then 
+            begin 
+                ls[i] :=array(nrc[array(0,3)],nrc[array(2,3)]); 
+            end             
+        end
+        if fshowseparators then 
+        begin 
+            cf := cvs.pen;
+            cf.style := 0;
+            cf.Width := 1; 
+            cf.color := fseparatorcolor;
+            for i,v in ls do 
+            begin
+                cvs.MoveTo(v[0]);
+                cvs.LineTo(v[1]);
+            end 
         end 
     end
     function SetTopLine(idx);virtual;
@@ -469,10 +488,14 @@ type ttreelistwnd = class(TCustomScrollControl)
     property ItemHeight read FItemHeight write SetItemHeight;
     property ItemMaxWidth read FxClientMax;
     property ItemMinWidth read FItemMinWidth write SetItemMinWidth; 
+    property showseparators:bool read fshowseparators write setshowseparators;
+    property separatorcolor:color read fseparatorcolor write setseparatorcolor;
     {**
     @param(Items)(array of TcustomTreeCtlNode) 项 %%
     @param(ItemMaxWidth)(integer) 最大宽度 %%
     @param(ItemHeight)(integer) 项高度 %% 
+    @param(showseparators)(bool) 显示分割线 %% 
+    @param(separatorcolor)(color) 分割线颜色 %% 
     **}
     private //其他中间函数
     function GetIndexClientRect(idx);virtual;
@@ -486,7 +509,25 @@ type ttreelistwnd = class(TCustomScrollControl)
             return rc;
         end
     end
+    function setseparatorcolor(v);
+    begin
+        if (v<>fseparatorcolor) and  (v>0 or v<=0) then 
+        begin
+            fseparatorcolor := v;    
+        end 
+    end    
+    function setshowseparators(v); 
+    begin
+        nv := v?true:false;
+        if nv<>fshowseparators then 
+        begin
+            fshowseparators := nv;
+            InvalidateRect(nil,false);
+        end 
+    end 
     private   //属性变量
+    fshowseparators;//分割线
+    fseparatorcolor;
     FHashItems;
     FItemHeight; //项高	
     FColCount; //列数
@@ -822,7 +863,11 @@ type TcustomTreeCtlNode = class(tsluibase) //
         //cvs.Pen.style := PS_SOLID;
         //cvs.Pen.width := 1;
         inv := 3;
+        /////////////处理最顶层/////////////////////////////
+        if Hierarchy=0 then BasePos := x;
+        else 
             BasePos := FBasePos+x; 
+        ///////////////////////////////////       
         FCheckPos := BasePos;
         fitemcountflg := ItemCount or FDirtype;
         for i := 1 to Hierarchy do 
@@ -865,17 +910,19 @@ type TcustomTreeCtlNode = class(tsluibase) //
         begin
             if(ifsel and FSelImgId >= 0)or(FImgId >= 0)or(FExpandImgId >= 0 and fitemcountflg>0 and FExpanded)then //绘制selimage 
             begin
+                imh := img.Height;
+                dimh := integer((h-imh)/2);
                 if(FExpandImgId >= 0)and fitemcountflg>0 and FExpanded then
                 begin
-                    img.Draw(FExpandImgId,cvs,BasePos,y+1,nil);
+                    img.Draw(FExpandImgId,cvs,BasePos,y+1+dimh,nil);
                 end else
                 if(ifsel and FSelImgId >= 0)then
                 begin
-                    img.Draw(FSelImgId,cvs,BasePos,y+1,nil);
+                    img.Draw(FSelImgId,cvs,BasePos,y+1+dimh,nil);
                 end else
                 if FImgId >= 0 then
                 begin
-                    img.Draw(FImgId,cvs,BasePos,y+1,nil);
+                    img.Draw(FImgId,cvs,BasePos,y+1+dimh,nil);
                 end
                 BasePos += img.Height;
                 BasePos += inv;
@@ -1167,6 +1214,7 @@ type TcustomTreeCtlNode = class(tsluibase) //
         begin
             if(it is class(TcustomTreeCtlNode))and(not it.Parent)then
             begin
+                if not ckchild(it) then continue;
                 odexp := it.Expanded;
                 it.UnExpand();
                 FItems.InsertBefor(it,idx0);
@@ -1198,6 +1246,7 @@ type TcustomTreeCtlNode = class(tsluibase) //
         **}
         if(it is class(TcustomTreeCtlNode))and(not it.Parent)then
         begin
+            if not ckchild(it) then return false;
             if idx<0 then idx := 0;
             if idx>FItems.Count then idx := FItems.Count;
             if not(idx >= 0)then idx := 0;
@@ -1491,6 +1540,16 @@ type TcustomTreeCtlNode = class(tsluibase) //
     FChecked; //选择
     static fnodehandlebase; //////
     private //普通属性设置
+    function ckchild(c); //检查子节点
+    begin
+        sf := self(true);
+        while sf do 
+        begin
+            if sf=c then return false;
+            sf := sf.Parent;            
+        end
+        return true;
+    end 
     function initnodehandle();//给当前节点分配一个id
     begin
         if not(fnodehandlebase>0) then fnodehandlebase:= 0xff;
@@ -1891,7 +1950,7 @@ type TcustomTreeCtl = class(ttreelistwnd)
         end
         return inherited;
     end
-    published //属性
+    published //属性输出
     property CurrentNode read FCurrentNode write setcurrentnode; //20221118 加上写
     property selectionColor:color read FselectionColor write SetselectionColor;
     property CheckBox:bool read FCheckBox write SetCheckBox;