跟新

d_examples/desktop.ini

@@ -0,0 +1,4 @@
+[ViewState]
+Mode=
+Vid=
+FolderType=Generic

designer/ctl_mgr/t_compile_config.tfm

@@ -10,12 +10,12 @@ object ed_script:t_compile_config
       topbottomspacing=10
    >
 
-   height=560
+   height=562
    left=638
    minmaxbox=false
    onclose=compile_config_close
    top=208
-   width=484
+   width=488
    wssizebox=true
    object panel1:tpanel
       autosize=true
@@ -31,7 +31,7 @@ object ed_script:t_compile_config
       height=25
       left=10
       top=10
-      width=448
+      width=452
       wsdlgmodalframe=false
       object lb_input:tlabel
          left=2
@@ -74,7 +74,7 @@ object ed_script:t_compile_config
       left=10
       parentcolor=true
       top=45
-      width=448
+      width=452
       object lb_ype:tlabel
          left=6
          top=21
@@ -121,13 +121,12 @@ object ed_script:t_compile_config
          top=44
          width=324
       end
-      object bt_output:tbtn
+      object bt_outputname:tbtn
          autosize=true
          caption=".."
-         enabled=false
          height=21
          left=408
-         onclick=bt_output_clk
+         onclick=bt_outputname_clk
          top=44
          width=28
       end
@@ -148,12 +147,13 @@ object ed_script:t_compile_config
          top=67
          width=324
       end
-      object bt_outputname:tbtn
+      object bt_output:tbtn
          autosize=true
          caption=".."
+         enabled=false
          height=21
          left=408
-         onclick=bt_outputname_clk
+         onclick=bt_output_clk
          top=67
          width=28
       end
@@ -169,23 +169,23 @@ object ed_script:t_compile_config
          leftrightspacing=2
          topbottomspacing=2
       >
-      height=71
+      height=73
       left=10
       parentcolor=true
       top=149
-      width=448
+      width=452
       object label1:tlabel
          left=6
          top=21
          width=58
-         height=21
+         height=23
          autosize=true
          caption="º¯ÊýĿ¼"
       end
       object ed_f_dirs:tedit
          autosize=true
          caption="edit1"
-         height=21
+         height=23
          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=21
+         height=23
          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=44
+         top=46
          width=58
          height=21
          autosize=true
@@ -212,7 +212,7 @@ object ed_script:t_compile_config
          caption="edit2"
          height=21
          left=66
-         top=44
+         top=46
          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=44
+         top=46
          width=28
       end
    end
@@ -239,8 +239,8 @@ object ed_script:t_compile_config
       height=139
       left=10
       parentcolor=true
-      top=230
+      top=232
-      width=448
+      width=452
       object lb_s_type:tlabel
          left=6
          top=21
@@ -256,10 +256,10 @@ object ed_script:t_compile_config
          left=94
          text="*.tfm,*.ini"
          top=21
-         width=318
+         width=322
       end
       object label7:tlabel
-         left=414
+         left=418
          top=21
          width=28
          height=20
@@ -281,13 +281,13 @@ object ed_script:t_compile_config
          height=21
          left=94
          top=43
-         width=318
+         width=322
       end
       object bt_i_s:tbtn
          autosize=true
          caption=".."
          height=21
-         left=414
+         left=418
          onclick=bt_i_s_clk
          top=43
          width=28
@@ -307,13 +307,13 @@ object ed_script:t_compile_config
          height=21
          left=94
          top=66
-         width=318
+         width=322
       end
       object bt_i_f:tbtn
          autosize=true
          caption=".."
          height=21
-         left=414
+         left=418
          onclick=bt_i_f_clk
          top=66
          width=28
@@ -333,13 +333,13 @@ object ed_script:t_compile_config
          height=21
          left=94
          top=89
-         width=318
+         width=322
       end
       object bt_tsgadd:tbtn
          autosize=true
          caption=".."
          height=21
-         left=414
+         left=418
          onclick=bt_tsgadd_clk
          top=89
          width=28
@@ -359,13 +359,13 @@ object ed_script:t_compile_config
          height=21
          left=94
          top=112
-         width=318
+         width=322
       end
       object bt_d_f:tbtn
          autosize=true
          caption=".."
          height=21
-         left=414
+         left=418
          onclick=bt_d_f_clk
          top=112
          width=28
@@ -385,8 +385,8 @@ object ed_script:t_compile_config
       height=97
       left=10
       parentcolor=true
-      top=379
+      top=381
-      width=448
+      width=452
       object label9:tlabel
          left=6
          top=21
@@ -521,8 +521,8 @@ object ed_script:t_compile_config
       >
       height=25
       left=10
-      top=486
+      top=488
-      width=448
+      width=452
       wsdlgmodalframe=false
       object bt_cmd:tbtn
          autosize=true

designer/ctl_mgr/t_compile_config.tsf

@@ -95,7 +95,7 @@ type t_compile_config=class(tdcreateform)
     function bt_tsgadd_clk(o;e);virtual;
     begin
         tp := array("tsg¿â":"*.tsg");
-        if show_dir_list(s_to_array(ed_tsg.text,true),tp)then
+        if show_dir_list(s_to_array(ed_tsg.text,true),tp,"tsg库目录")then
         begin
             ed_tsg.text := array_to_s(dir_list.get_dirs(),true);
         end
@@ -183,6 +183,7 @@ type t_compile_config=class(tdcreateform)
     function bt_outputname_clk(o;e);virtual;
     begin
         f_op.filter := array(get_type():"*"+get_type());
+        f_op.Caption := "输出文件名";
         if f_op.OpenDlg()then
         begin
             ed_output.text :=relative_path(  f_op.filename);
@@ -201,6 +202,7 @@ type t_compile_config=class(tdcreateform)
     function bt_script_clk(o;e);virtual;
     begin
         f_op.filter := array("tsl½Å±¾":"*.tsf;*.tsl");
+        f_op.Caption := "入口脚本";
         if f_op.OpenDlg()then
         begin
             e_script.text := relative_path( f_op.filename);
@@ -210,6 +212,7 @@ type t_compile_config=class(tdcreateform)
     function bt_ico_clk(o;e);virtual;
     begin
         f_op.filter := array("icoͼ±ê":"*.ico");
+        f_op.Caption := "图标文件";
         if f_op.OpenDlg()then
         begin
             ed_ico.text := relative_path( f_op.filename);
@@ -217,28 +220,28 @@ type t_compile_config=class(tdcreateform)
     end
     function bt_d_f_clk(o;e);virtual;
     begin
-        if show_m_editor(s_to_array(ed_exclude_f.text))then
+        if show_m_editor(s_to_array(ed_exclude_f.text),"排除函数")then
         begin
             ed_exclude_f.text := array_to_s(m_list_editor.get_data());    
         end
     end
     function bt_i_f_clk(o;e);virtual;
     begin
-        if show_m_editor(s_to_array(ed_include_f.text))then
+        if show_m_editor(s_to_array(ed_include_f.text),"指定函数")then
         begin
             ed_include_f.text := array_to_s(m_list_editor.get_data());    
         end
     end
     function bt_i_s_clk(o;e);virtual;
     begin
-        if show_m_editor(s_to_array(ed_include_s.text))then
+        if show_m_editor(s_to_array(ed_include_s.text),"指定资源")then
         begin
             ed_include_s.text := array_to_s(m_list_editor.get_data());    
         end
     end
     function bt_output_clk(o;e);
     begin
-        if show_m_editor(s_to_array(ed_out_f.text))then
+        if show_m_editor(s_to_array(ed_out_f.text),"输出函数")then
         begin
             ed_out_f.text := array_to_s(m_list_editor.get_data());
         end
@@ -246,14 +249,14 @@ type t_compile_config=class(tdcreateform)
     
     function bt_s_dir_clk(o;e);
     begin        
-        if show_dir_list(s_to_array(ed_s_dirs.text,true))then
+        if show_dir_list(s_to_array(ed_s_dirs.text,true),nil,"资源目录")then
         begin
             ed_s_dirs.text := array_to_s(dir_list.get_dirs(),true);
         end
     end
     function bt_f_dir_clk(o;e);
     begin
-        if show_dir_list(s_to_array(ed_f_dirs.text,true))then
+        if show_dir_list(s_to_array(ed_f_dirs.text,true),nil,"函数目录")then
         begin
             ed_f_dirs.text := array_to_s(dir_list.get_dirs(),true);
         end
@@ -274,19 +277,21 @@ type t_compile_config=class(tdcreateform)
             invoke(self,v["name"],nil);
         end
     end
-    function show_dir_list(data,filetype);
+    function show_dir_list(data,filetype,cp);
     begin
         dir_list.Left := Left-20;
         dir_list.top := top+50;
         dir_list.set_dirs(data);
         dir_list.fopentype := filetype;
+        if ifstring(cp) then dir_list.Caption := cp;
         return dir_list.ShowModal();
     end
-    function show_m_editor(data);
+    function show_m_editor(data,cp);
     begin
         m_list_editor.Left := Left-20;
         m_list_editor.top := top+50;
         m_list_editor.set_data(data);
+        if ifstring(cp) then m_list_editor.Caption := cp;
         return m_list_editor.ShowModal();
     end
     function enabled_script_input(f);

designer/ctl_mgr/t_editor_color_mgr.tfm

@@ -35,6 +35,7 @@ object ditor_color_mgr:t_editor_color_mgr
       onselchanged=colorcombobox1_onselchanged
       top=18
       width=132
+      parentfont=false
    end
    object listbox1:tlistbox
       caption="listbox1"
@@ -55,6 +56,7 @@ object ditor_color_mgr:t_editor_color_mgr
       onselchanged=colorcombobox2_onselchanged
       top=18
       width=177
+      parentfont=false
    end
    object openfileadlg1:topenfileadlg
       left=314

designer/udesignerproject.tsf

@@ -4,7 +4,7 @@ interface
     @param(说明) 设计器工程相关工具,包括历史工程,工程目录管理,代码编辑器 %%
     @date(20220518)
 **}
-uses utslvclauxiliary,tslvcl,utslmemo,UTslSynMemo,UVCPropertyTypesPersistence,UtslCodeEditor,utslvclsyntaxparser;
+uses utslvclauxiliary,utslvcldcomponents,tslvcl,utslmemo,UTslSynMemo,UVCPropertyTypesPersistence,UtslCodeEditor,utslvclsyntaxparser;
 function SetWndPostWithMouse(wnd,lft);
 type TProjectManagerForm = class(TVCForm) //工程管理 TCustomControl
     function Create(AOwner);override;
@@ -175,7 +175,7 @@ end
 %%,n,n+"main");
         ReWriteString(cprojpath+n+".tsl",r);
         ReWriteString(cprojpath+n+"main.tsf",CreateAForm(n+"main"));
-        ReWriteString(cprojpath+n+format("%smain.tfm",n),CreateAtfm(n+"main",n+"main"));
+        ReWriteString(cprojpath+n+"main.tfm",CreateAtfm(n+"main",n+"main"));
         //ReWriteString(cprojpath+"resource.tfm"+fio+format("%smain.tfm",n),CreateAtfm(n+"main",n+"main"));
         //写入缓存
         FProjectCoder.AddProject(n,f);
@@ -352,6 +352,8 @@ type TProjectView = class(TVCForm) //
         FInput.visible := false;
         FInput.parent := self;
         FTslEditer := new TTslEditer(AOwner);
+        FTslEditer.ParentFont := false;
+        FTslEditer.dbclkcreate := false;
         FTslEditer.Notification(FTslEditer,"change_editor_keys");
         FTslEditer.FExecuteEditer.cannotadd := true;
         FTslEditer.FExecuteEditer.onsaveclk := function(o,e)
@@ -402,11 +404,12 @@ type TProjectView = class(TVCForm) //
             begin   
                 app := initializeapplication();
                 app.font := array("width":ginfo["fontsize"],"height" :ginfo["fontsize"]*2);
+                FTslEditer.font := array("width":ginfo["fontsize"],"height" :ginfo["fontsize"]*2);
                 NotifyComponent(self,ginfo); 
             end  
             
         end
-        FTslEditer.Parent := AOwner;
+        //FTslEditer.Parent := AOwner;
         FTmfParser := new TTmfParser();
         FTslParser := new ttslscripparser();
         FTreeTool := new TToolBar(self);
@@ -553,6 +556,11 @@ type TProjectView = class(TVCForm) //
         if fopenbuzy then return ;
         ftree.setsel(nd);
     end 
+    function getall_class_tsf();//列表
+    begin
+        ls := FTree.get_leaf_nodes();
+        return ls;  
+    end 
     function OpenTreeNode(); //打开当前节点
     begin
         if not FCProjectPath then return Messageboxa("工程没打开","提示",0,self);
@@ -895,8 +903,11 @@ type TProjectView = class(TVCForm) //
     
     function ShowEditor(); //显示函数编辑
     begin
-        FTslEditer.Show(SW_SHOWNOACTIVATE); //
+        //FTslEditer.Show(SW_SHOWNOACTIVATE); //
+        FTslEditer.Show(); //
         _wapi.bringWindowToTop(FTslEditer.Handle);
+        it := FTslEditer.GetCurrentEditer();
+        if it then return it.SetFocus();
     end
     function hiddeneditor(rc);//隐藏
     begin
@@ -965,9 +976,10 @@ type TProjectView = class(TVCForm) //
             return r;
         end
     end
-    function GoToAFunction(n); //Ìøתµ½º¯Êý
+    function GoToAFunction(n,fn); //跳转到函数
     begin
-        fn := FCurrentOpend.gettsfname();
+        if not fn then 
+            fn := FCurrentOpend.gettsfname();
         r := FTslEditer.GoToFunction(fn,n);
         saveformcode(fn);
         ShowEditor();
@@ -1037,9 +1049,13 @@ type TProjectView = class(TVCForm) //
                     
                     //FTfmComponets := array();
                     //FTmfParser.GetAllSubObjects(nil,FTfmComponets);
-                    FDesigner.LoadTreeNode(FTmfParser,inh,FCurrentOpend);
                     xx := FTslEditer.OpenAndGotoFileByName(FCurrentOpend.gettsfname());
+                    FDesigner.LoadTreeNode(FTmfParser,inh,FCurrentOpend);                    
                     FDesigner.EditerCodeChanged(FCurrentOpend);
+                end else //缺少tfm文件
+                begin
+                    xx := FTslEditer.OpenAndGotoFileByName(FCurrentOpend.gettsfname());
+                    ShowEditor();                    
                 end 
                 fopenbuzy := false;
             end else
@@ -1330,7 +1346,7 @@ end
 %%,n,nd.Fname,us);
             ReWriteString(ph,r);            
             FTmfParser.ScriptPath := nd.gettmfname();
-            r := FTmfParser.inheritedcoy(n+"1",n,nd.Fname);
+            r := FTmfParser.inheritedcopy(n+"1",n,nd.Fname);
             ReWriteString(tfm,r);
             //ReWriteString((FCProjectPath+"resource.tfm"+fio+n+".tfm"),r);
         end  else 
@@ -2206,7 +2222,7 @@ BD141CA912494F502D48D224F45050274A21E03806FF2C7CA7516022D7D000000
     function GoToFunction(fn,n);
     begin
         it := OpenAndGotoFileByName(fn);
-        if it then it.GotoFunction(n);
+        if it then return it.GotoFunction(n);
     end 
     function AddFunction(n,fn,finfo); //添加函数 
     begin
@@ -2429,6 +2445,12 @@ type TFileTree = class(TTreeCtl)
     end
     fprojectpath;
     fio;
+    function get_leaf_nodes();
+    begin
+        leafs := array();
+        GetNodeLeafs(FPNode,leafs);
+        return leafs;
+    end 
     function GetInfo(dir,files); //获得信息
     begin
         leafs := array();
@@ -3117,6 +3139,7 @@ end
 ////////////////////////////////////////////////////////////////
 function move_tfm_to_tsf(dir);
 begin
+    if not(FileList("",dir+iofileseparator()+"resource.tfm"+iofileseparator()+"*.tfm")) then return ;
     tsfs := array();
     tfms := array();
     find_tsf_tfm(dir,tsfs,tfms); 
@@ -3248,41 +3271,6 @@ function LegalFolderName(n); //Ŀ¼
 begin
     return ifstring(n) and n and  (1=ParseRegExpr("^[A-Za-z_]\\w{2,}$",n,v,vp,vl))  and (lowercase(n)<>"con");
 end 
-function createtslfunction(f);//¹¹Ô캯Êý
-begin
-    n := f["name"];
-    p := f["param"];
-    b := f["body"];
-    ps := "";
-    if ifarray(p)then
-    begin
-        len := length(p);
-        for i := 0 to len-1 do
-        begin
-            v := p[i];
-            if ifstring(v)then ps += v;
-            if i<len-1 then ps += ";";
-        end
-    end
-    hs := nil;
-    vt := "";
-    if f["virtual"] then vt := "virtual;";
-    if ifstring(n) and ifstring(b)then
-    begin
-        //hs := "\r\nfunction "+n+"("+ps+");"+vt+"\r\n\tbegin\r\n"+b+"\r\n\tend\r\n";
-        bs := str2array(b,"\r\n");
-        bs2 := "";
-        for i,v in bs do
-        begin
-            if not v then continue;
-            bs2 += "    "+v+"\r\n";
-        end
-        hs := "\r\n\    function "+n+"("+ps+");"+vt+"\r\n\    begin\r\n"+bs2+"\r\n\    end\r\n";
-    end
-    //hs := "\r\n\tfunction "+n+"("+ps+");"+vt+"\r\n\tbegin\r\n"+b+"\r\n\tend\r\n";
-    return hs;
-end
-
 function SetWndPostWithMouse(wnd,lft);
 begin
     {**

designer/utslcodeeditor.tsf

@@ -1229,12 +1229,23 @@ type TPageEditerItem=class(TPageItem)
             p := crec[0];
             if ifarray(p)then
             begin
+                tpl := FEditer.TopLine;
+                cxy := FEditer.CaretY;
                 FEditer.ExecuteCommand(FEditer.ecGotoXY,p);
                 FEditer.ExecuteCommand(FEditer.ecString,fld+";\r\n    ");
+                if p[1]<cxy then 
+                begin 
+                    FEditer.TopLine := tpl+1;
+                    FEditer.CaretY := cxy+1;
+                end else 
+                begin
+                    FEditer.TopLine := tpl;
+                    FEditer.CaretY := cxy;
+                end
             end
         end
     end
-    function getuses();
+    function getuses();//获取uses
     begin 
         if not FTslParser then return 0;
         d := GetClassInfo();        
@@ -1262,8 +1273,19 @@ type TPageEditerItem=class(TPageItem)
                    p := rec[0];
                    if ifarray(p) then 
                    begin 
-                       FEditer.ExecuteCommand(FEditer.ecGotoXY,rec[0]);
+                        tpl := FEditer.TopLine;
-                       FEditer.ExecuteCommand(FEditer.ecString,adus);
+                        cxy := FEditer.CaretY;
+                        FEditer.ExecuteCommand(FEditer.ecGotoXY,rec[0]);
+                        FEditer.ExecuteCommand(FEditer.ecString,adus);
+                        if p[1]<cxy then 
+                        begin 
+                            FEditer.TopLine := tpl+1;
+                            FEditer.CaretY := cxy+1;
+                        end else 
+                        begin
+                            FEditer.TopLine := tpl;
+                            FEditer.CaretXY := cxy;
+                        end
                    end 
                end 
            end   
@@ -1305,11 +1327,23 @@ type TPageEditerItem=class(TPageItem)
             if v["name"]=nfld then
             begin
                 frec := GetInfoRowCol2(v);
+                tpl := FEditer.TopLine;
+                cxy := FEditer.CaretY;
                 if ifarray(frec[0])and ifarray(frec[1])then
                 begin
                     FEditer.ExecuteCommand(FEditer.ecGotoXY,frec[0]);
                     FEditer.ExecuteCommand(FEditer.ecSelGotoXY,frec[1]);
                     FEditer.SelText := nn?(nn+";"):"";
+                    if cxy>=frec[1,1] then //删除
+                    begin
+                        cn := frec[1,1]-frec[0,1];
+                        FEditer.TopLine := tpl-cn;
+                        FEditer.CaretY := cxy-cn;    
+                    end else 
+                    begin
+                        FEditer.TopLine := tpl;
+                        FEditer.CaretY := cxy;
+                    end                                         
                 end
                 wek := v["dstatic"];
                 if wek then 
@@ -1332,12 +1366,11 @@ type TPageEditerItem=class(TPageItem)
                         FEditer.ExecuteCommand(FEditer.ecSelGotoXY,frec[1]);
                         FEditer.SelText := nn?(nn+";"):"";
                     end
-                end 
+                end                 
-                
             end
         end
     end
-    function GoToFunction(fn);
+    function GoToFunction(fn);//定位到函数
     begin
         if not(ifstring(fn))then return false;
         nfld := lowercase(fn);
@@ -1355,6 +1388,7 @@ type TPageEditerItem=class(TPageItem)
                 return true;
             end
         end
+        return d["inherited",0];
     end
     function AddFunction(fn,finfo); //添加函数 
     begin
@@ -1429,6 +1463,7 @@ type TPageEditerItem=class(TPageItem)
         if cp then cp.PrePareCompletion(t);
         RepreComple := false;
     end
+    //////////转码/////////////////////////
     function ToUnicode_big();
     begin
         if FEnCode="UCS2-big" then return;
@@ -1497,6 +1532,7 @@ type TPageEditerItem=class(TPageItem)
             FEnCode := "ANSI";
         end
     end
+    ///////////////////////////////
     function SetLoadScript(s); //保存文件
     begin
         if not ifstring(s)then return;
@@ -1576,8 +1612,7 @@ type TPageEditerItem=class(TPageItem)
     end
     function getmfunctioninfo();
     begin
-        if not ftslparser2 then 
+        if not ftslparser2 then ftslparser2 := new ttslscripparser();
-            ftslparser2 := new ttslscripparser();
         ftslparser2.Script :=FEditer.Text;  
         return  ftslparser2.gettslfunctions();         
     end 
@@ -1799,6 +1834,7 @@ type TEditer=class(TCustomcontrol) //
     function Create(AOwner);override;
     begin
         inherited;
+        fdbclkcreate := true;
         if not Fhightercolor then 
             Fhightercolor := new thighlitcolor(self);                        
         FOpenHistory := new TMyarrayb();
@@ -1980,7 +2016,7 @@ type TEditer=class(TCustomcontrol) //
             DoControlAlign();
         end
         /////////////////////
-        FStatus.Items := array(("text":"","width":0.85),("text":"","width":0.16));
+        FStatus.Items := array(("text":"","width":0.7),("text":"","width":0.31));
         /////////////////////////////////////////
         //FInfoShowWnd.Caption := "信息:";
         ////构造节点////////////////////////////////////////////////////  
@@ -2041,6 +2077,7 @@ type TEditer=class(TCustomcontrol) //
             sz := editorglobalinfo["fontsize"];
             sz2 := sz*2;
             app.font := array("width":sz,"height":sz2);
+            self.font := array("width":sz,"height":sz2);
             if not(r) or (ifarray( r ) and r["imgsize"]<>editorglobalinfo["imgsize"]) then NotifyComponent(fsyssizemgr,editorglobalinfo);  
         end 
     end 
@@ -3407,6 +3444,7 @@ type TEditer=class(TCustomcontrol) //
     end
     function CreateAFile(); //构造文件
     begin
+        if not fdbclkcreate then return ;
         if FTslCacheDir then 
         begin
             idx := 0;
@@ -3885,6 +3923,7 @@ type TEditer=class(TCustomcontrol) //
     end
     published //property 位置
     FHistoryDir;
+    property dbclkcreate read fdbclkcreate write fdbclkcreate;
     property hltcolor read gethclor write sethclor;
     function showhltcolor();
     begin
@@ -3982,13 +4021,15 @@ type TEditer=class(TCustomcontrol) //
         fs := data["target"];
         finder := finder_set_info(data,ed.Text);
         idx := 0;
-        rsult := finder.replace_all(r);
+        rsult := finder.replace_all(r);        
         if rsult then 
         begin 
+            FFindListWnd.ffindstr := fs;
             idx := length(rsult);
             ed.ExecuteCommand(ed.ecSelectAll);    
             ed.SelText := r;
             lastidx := -1;
+            sct := integer((FFindListWnd.Width-10)/(FFindListWnd.font.Width))-17;
             for i,v in rsult do 
             begin 
                 if i=0 then 
@@ -3997,12 +4038,11 @@ type TEditer=class(TCustomcontrol) //
                 if rdx=lastidx then continue;
                 lastidx := rdx;
                 if not ifstring(v[3]) then continue;
-                scap := format("    %d:(µÚ%dÐÐ) ",i,rdx)+limitstringlength(v[3]);
+                scap := format("    %d:(第%d行) ",i,rdx)+ limitstringlength(v[3],sct);
                 FFindListWnd.AppendItem(array("caption":scap,"file":it.OrigScriptPath,"line":rdx));
             end 
         end 
     end 
-
     
     function Find_InFiles(d,o,rep,ct);
     begin
@@ -4133,8 +4173,13 @@ type TEditer=class(TCustomcontrol) //
         lastidx := -1;       
         if rsult then 
         begin 
+            if not fnoshow then
+            begin 
+                FFindListWnd.ffindstr := fs;
+            end 
             rt := length(rsult);
             iits := 0;
+            sct := integer((FFindListWnd.Width-10)/(FFindListWnd.font.Width))-17;
             for i,v in rsult do 
             begin 
                 if i=0 and (not fnoshow) then 
@@ -4145,7 +4190,7 @@ type TEditer=class(TCustomcontrol) //
                     if rdx=lastidx then continue;
                     lastidx := rdx;
                     if not ifstring(v[3]) then continue;
-                    scap := format("    %d:(µÚ%dÐÐ) ",i,rdx)+limitstringlength(v[3]);
+                    scap := format("    %d:(第%d行) ",i,rdx)+ limitstringlength(v[3],sct);
                     FFindListWnd.AppendItem(array("caption":scap,"file":it.OrigScriptPath,"line":rdx));
                     iits++;
                     if iits>80 then 
@@ -4313,6 +4358,7 @@ type TEditer=class(TCustomcontrol) //
     FGoBackB; // := new TMyarrayB();
     FRebackFlag;
     FPageEditer;
+    fdbclkcreate;
     fcoolbar;
     ftoolbara;
     ftoolbarb;
@@ -5281,15 +5327,18 @@ type TFindListWnd=class(TListBox) //
     function Create(AOwner);
     begin
         inherited;
-        //font := array("width":11,"height":22);
+        ffindstr := "";
-        //ParentFont := false;
+        ownerdraw := true;
-        {onnotification := function(o,e)begin
+        ondrawlist := thisfunction(findbox_drawlist); //绘制
-            ms := e.message;
+    end
-            if ifarray(ms) and ms[0] ="font" then 
+    function FontChanged(o);override;
-            begin
+    begin
-                font := ms[1];        
+        ft := font;
-            end 
+        if ft then 
-        end }
+        begin 
+            if ownerdraw then ItemHeight :=  font.Height+4;
+            return inherited;
+        end 
     end
     function CheckListItem(s);override;
     begin
@@ -5302,6 +5351,62 @@ type TFindListWnd=class(TListBox) //
         if not ifstring(r)then return "";
         return r;
     end
+    ffindstr; //查找的串
+    fignorcase;//忽略大小写
+    function findbox_drawlist(sender:tlistbox; evnt:tlistdrawevent; cvs:tcanvas; idx:integer; ARect:array of integer);
+    begin
+        ft := cvs.font;
+        w := ft.Width;
+        s := GetItemText(idx);
+        if not s then return ;
+        rc := ARect;
+        if pos("find:",s)=1 then 
+        begin
+            ft.Color := 0xf0a000;
+            return cvs.DrawText(s,rc);
+        end 
+        if ffindstr  then 
+        begin
+            x := 0;            
+            ls := length(s);
+            ct := integer((rc[2]-rc[0])/w)-3;
+            if ct>1 and ct<ls then 
+            begin
+                if bytetype(s,ct)=1 then 
+                begin
+                    s := s[1:(ct-1)]+"...";
+                end else s := s[1:ct]+"..."; 
+            end 
+            p := 1;
+            ss := str2array(lowercase(s),lowercase(ffindstr));
+            lenf := length(ffindstr);
+            lenss := length(ss)-1;
+            for i,v in ss do 
+            begin
+                if v then 
+                begin 
+                    ft.Color := 0;
+                    lenv := length(v);
+                    rc[2] := lenv*w+x;
+                    cvs.DrawText(s[p:(p+lenv-1)],rc);
+                    x := rc[2];
+                    rc[0] := x;
+                    p+=lenv;
+                end 
+                if x>ARect[2] then break;
+                if lenss>i then 
+                begin
+                    ft.Color := 244;
+                    rc[2] := lenf*w+x;
+                    cvs.DrawText(s[p:(p+lenf-1)],rc);
+                    p+=lenf;
+                    x := rc[2];
+                    if x>ARect[2] then break;
+                    rc[0] := x;
+                end                 
+            end 
+        end 
+    end
 end
 type TFindWnd=class(TPage)
     type TFindBtn=class(TBtn)
@@ -5775,8 +5880,6 @@ type TGoToLineWnd=class(TVCForm) //
     function Create(AOwner);override;
     begin
         inherited;
-        //ParentFont := false;
-        //font := array("width":10,"height":20);
         wssizebox := false;
         minmaxbox := false;
         WsDlgModalFrame := true;
@@ -5815,9 +5918,6 @@ type TGoToLineWnd=class(TVCForm) //
         childsizing := array("layout":1,"leftrightspacing":5,"topbottomspacing":10,"verticalspacing":5,"controlsperline":3);
         autosize := true;
     end
-    function DoControlAlign();override;
-    begin
-    end
     function ShowGoto();
     begin
         show();
@@ -5937,6 +6037,7 @@ type tsyssizemgr = class(TVCForm)
         pal.Parent := self;
         childsizing := array("layout":1,"controlsperline":2);
         pal.childsizing := array("layout":1,"controlsperline":2,"topbottomspacing":3);
+        fpal2 := pal;
         autosize := true;
         fok.onclick := thisfunction(okclk);
         fcancel.onclick := thisfunction(cancelclk);
@@ -5948,6 +6049,7 @@ type tsyssizemgr = class(TVCForm)
         ft := font;
         e.Height := ft.Height+5;
         e.Width := ft.Width*7;
+        if fpal2 then e.Width :=fpal2.Width;
     end 
     function okclk(o,e);
     begin
@@ -5982,7 +6084,8 @@ type tsyssizemgr = class(TVCForm)
         setinfo(editorglobalinfo?:array());
         center_popup_wnd(self);
         return ShowModal(); 
-    end     
+    end  
+    fpal2;   
     fsysimg;
     fsysfont;
 end 
@@ -6062,10 +6165,11 @@ function gettslexe();
 begin
     return static gettslexefullpath();
 end   
-function limitstringlength(s);
+function limitstringlength(s,n);
 begin
+    return trim(s);
     len := length(s); 
-    n := 150;
+    if not(n>30) then n := 150;
     if len>n then 
     begin
         if bytetype(s,n)=1 then 

designer/utslcodeformat.tsf

@@ -133,6 +133,9 @@ type TFormatParser = class
         "%%","(*","//","#!",
         "<?tslx>",
         "?>",
+        "...",
+        ":>",":<",":<>", ":==",":>=",":<=",
+        "::>","::<","::<>", "::==","::>=","::<=",
         //"0x","0O","0b",
         );
         TslSyn2 := array("div=","union2=","intersect=","outersect=","minus=","end.",);

designer/utslsynmemo.tsf

@@ -1013,9 +1013,7 @@ type TTslSynHighLighter = class(TSynHighLighter)
                                 end
                                 tvi := s[idx];
                                 if tvi=" " or tvi="\t" then 
-                                begin 
+                                begin                                     
-                                    
-                                    
                                     SetTToken(tokens,const ccs,idx-1,array("%%"));
                                     return ParserTokenLines(s,idx+1,e,ccs,tokens);
                                 end
@@ -1023,7 +1021,7 @@ type TTslSynHighLighter = class(TSynHighLighter)
                             end 
                         end else 
                         begin 
-                        SetTToken(tokens,"%",idx-1);
+                            SetTToken(tokens,"%",idx-1);
                             idx--;
                         end 
                     end 
@@ -1053,6 +1051,13 @@ type TTslSynHighLighter = class(TSynHighLighter)
                         SetTToken(tokens,"<",idx);   
                     end 
                 end else 
+                if vi="." and (idx<e-2) and s[idx+1]="." and s[idx+2]="." then //////////¼ÓÈë´¦Àí ...
+                begin
+                    if ttk then
+                        SetTToken(tokens,ttk,idx-1);
+                    SetTToken(tokens,"...",idx+2);
+                    idx+=2;
+                end else  
                 if pos(vi,"`~@#$^&*)+-;,.?:[]|\\=><%/") then 
                 begin
                     if ttk then
@@ -1248,8 +1253,8 @@ type TTslSynHighLighter = class(TSynHighLighter)
     end 
     function GetLineTokens(idx);override;
     begin
-        if idx<FSatesCount then 
+        if idx<FSatesCount then return FTokens[idx];
-        return FTokens[idx];
+        return nil;
     end 
     private
     function FindRightChar(c,s,b,e,zy); //²éÕÒ·â±ÕµÄ×Ö·û

designer/utslvcldebuger.tsf

@@ -2717,6 +2717,11 @@ type tdbgvalueshowgrid=class(TDrawGrid)
             end
         end
         PopupMenu := mu;
+        onfontchanged := function()begin
+            ft := font;
+            if not ft then return ;
+            ItemHeight := ft.Height+4;
+        end 
     end
     function DoDrawSubItem(o,e);override;
     begin

designer/utslvcldesigner.tsf

@@ -41,6 +41,7 @@ type TVclDesigner = class(tvcform)
     FStopMenu;
     FProjectsManager;
     FProjectManager;
+    FTslParser;//解析器
     //***************************
     function WrapProjectTo(); //打包当前
     begin
@@ -116,7 +117,7 @@ type TVclDesigner = class(tvcform)
         height := (integer(mx*32/twidth)+1)*32+60+30{+24}+5;
     end 
 
-    function TreeNode2tfmsub(lib,node,itemnames,nd);//tmf文件字符串
+    function TreeNode2tfmsub(lib,node,itemnames,nd,bshow);//tmf文件字符串
     begin
         if not(node) then
         begin
@@ -128,7 +129,7 @@ type TVclDesigner = class(tvcform)
             if not tr then return ;
             it := tr.RootItem;
             node := (it.items)[0];
-            ifnit := true;            
+            ifnit := true;  
         end 
         if not ifarray(itemnames) then itemnames := array();
         if not ifarray(lib) then lib := array();
@@ -145,7 +146,7 @@ type TVclDesigner = class(tvcform)
         begin
             tcname := tc.name;
             tcclassname := tc.dclassname;
-            if not(tcclassname and tcname and ifstring(tcname) and ifstring(tcclassname)) then raise "错误!";
+            if not(tcclassname and tcname and ifstring(tcname) and ifstring(tcclassname)) then return " ";//raise "错误!"$"   "$tcname$"  "$tcclassname$"<<<<";
             oorinh := (tc.isinherited)?"inherited ":"object ";
             ihp := "";
             if tc.isinherited then 
@@ -153,8 +154,9 @@ type TVclDesigner = class(tvcform)
                 if ifstring(tc.inheritedparent) then 
                 begin
                     ihp := "("+tc.inheritedparent+")";
+                    bshow := true;
                 end
-            end 
+            end else bshow := true;
             r+= oorinh + tcname +":"+tcclassname+ihp+"\r\n";
             itemnames[length(itemnames)] := array(tcname,tcclassname);
             cr := tc.GetChangedPublish();
@@ -163,10 +165,18 @@ type TVclDesigner = class(tvcform)
                 if not(v and ifstring(i) and ifstring(v) ) then continue; //严格判断
                 r+=tab;
                 r+= i + "=" + v +"\r\n";
+                bshow := true;
             end 
             for i := 0 to node.ItemCount-1 do 
             begin
-                r += tablelines( TreeNode2tfmsub(lib,(node.items)[i],itemnames),tab);
+                ibshow := false;
+                rri := TreeNode2tfmsub(lib,(node.items)[i],itemnames,nil,ibshow);
+                if ibshow then 
+                begin 
+                    rr :=  tablelines( rri,tab);
+                    r += rr;
+                    bshow := true;
+                end
             end 
             r += "end";
         end 
@@ -469,12 +479,12 @@ type TVclDesigner = class(tvcform)
             begin
                 Foh := o.height;
                 _send_(WM_USER,123,123,1);
+                e.skip := true;
                 return ;
             end
             SC_MINIMIZE:
             begin
-                e.skip := true;
+                //e.skip := true;
-                return ;
             end 
             SC_DEFAULT:
             begin
@@ -487,6 +497,8 @@ type TVclDesigner = class(tvcform)
             end 
             SC_RESTORE:
             begin
+                Foh := o.height;
+                _send_(WM_USER,123,123,1);    
             end 
         end;
         
@@ -503,7 +515,7 @@ type TVclDesigner = class(tvcform)
     begin
         if e.wparam = 123 and e.lparam=123 then 
         begin
-            if o.height>Foh then 
+            if {o.height>Foh}true then 
             begin
                 o.height := Foh; //gtk 逻辑正确但是设置无效
             end             
@@ -911,8 +923,46 @@ type TVclDesigner = class(tvcform)
                             end     
                         end else 
                         begin
-                            FProjectManager.GoToAFunction(dv);
+                            inh := FProjectManager.GoToAFunction(dv);
-                            return ;
+                            if not ifstring(inh) then return ;
+                            ////////////////父类中查找////////////////////////////////////////////
+                            flg := true;
+                            fs := FProjectManager.getall_class_tsf();
+                            while flg and inh do //循环查找父类
+                            begin 
+                                fn := 0;
+                                for i,v in fs do //查找父类文件
+                                begin 
+                                    if v.fname=inh and v.FType<>"tsl" then 
+                                    begin 
+                                        fn := v.gettsfname();
+                                        break;
+                                    end 
+                                end 
+                                if not fn then break;//没找到文件退出
+                                FTslParser.ScriptPath := fn;
+                                ci := FTslParser.GetClassInfo();
+                                for i,vf in ci["funcs"] do //对比函数名
+                                begin
+                                    if dv=vf then 
+                                    begin
+                                        flg := false;
+                                        break;
+                                    end 
+                                end 
+                                if flg then //没找到函数,继续找上一级父类
+                                begin
+                                    inh := ci["inherited",0] ;   
+                                end else  //找到函数,提示跳转
+                                begin 
+                                    if messageboxa("函数:"$dv$"在父类:"$inh$"中,是否打开","打开提示!",1,self)=IDOK then
+                                    begin  
+                                        return FProjectManager.GoToAFunction(dv,v.gettsfname());
+                                    end
+                                end 
+                            end 
+                            //////////////////////////////////////////////////////////////////
+
                         end
                     end 
                 end         
@@ -969,6 +1019,7 @@ type TVclDesigner = class(tvcform)
     {**
         @explan(说明) 组件被点击 %%
     **}
+        uses utslvclevent;
         nd := o._tag;
         tr := nd.owner;
         if not(tr.visible) then 
@@ -977,6 +1028,20 @@ type TVclDesigner = class(tvcform)
             FProjectManager.setnodesel(wnd);
             return ;//
         end 
+        ///////////////////特殊处理page控件///////////////////////////////////////////
+        if (o is class(TPageControl)) and (e is class(TMMouse)) then 
+        begin
+            d := o.hittabat(e.pos);
+            if ifarray(d) then 
+            begin
+                pid := d["idx"];
+                if (pid>=0) then 
+                begin
+                    o.SetPublish("cursel",pid,1);
+                end 
+            end 
+        end 
+        ///////////////////////////////////////////
         if fselctlnode<> nd then 
         begin 
             //wd := o;//nd.Component.Cwnd;
@@ -1045,7 +1110,8 @@ type TVclDesigner = class(tvcform)
             @explan(说明) 选择工具按钮 %%
         **}
         cct := o._tag;
-        FComponentCreater := cct;        
+        FComponentCreater := cct;  
+        //if FProjectManager then  FProjectManager.hiddeneditor();             
     end 
     
     function CloseShowForm(o,e); //主窗口关闭
@@ -1433,8 +1499,8 @@ type TVclDesigner = class(tvcform)
             {$endif}
             compcwnd.Handle;
         end 
-        comp.isinherited := d["inherited"];
         comp.inheritedparent := d["parent"];
+        comp.isinherited := d["inherited"];        
         comp.name := d["name"];
         obarray[d["name"]] := comp;
         FVariableSelecter.additem(comp);
@@ -1511,7 +1577,7 @@ type TVclDesigner = class(tvcform)
         rect := _wapi.GetScreenRect();
         twidth := (rect[2]-50);
         width := twidth;
-        height := 180;
+        height := 190;
         //calcheight(twidth);
         caption := "TVCL界面设计器";    
         FProjectsManager := new TProjectManagerForm(self);
@@ -1563,24 +1629,36 @@ type TVclDesigner = class(tvcform)
         tparent.parent := FObjInspector;
         pparent.parent := FObjInspector;
         //FTree.parent := tparent;
+        /////////////////属性筛选////////////////////////////////
+        fsearch := new tedit(self);
+        fsearch.placeholder := "筛选";
+        fsearch.Align := alTop;
+        fsearch.autosize := true;
+        fsearch.parent := pparent;
+        fsearch.OnChange := function(o,e)begin
+            if FPropGrid then FPropGrid.searchidex := o.text;
+            if FEventGrid then FEventGrid.searchidex := o.text; 
+        end 
+        ////////////////////////////////////////////////
         pedits.parent := pparent ;
         FProp.parent := pedits;
-        FEvent.parent := pedits;
+        FEvent.parent := pedits;        
         
         FPropGrid.align := alclient;
         FEventGrid.align := alclient;
         FPropGrid.parent := FProp;
         FEventGrid.parent := FEvent;        
-        Mobjinspect();
-
         onactivate := thisfunction(OnDesignerActivate);
          
         fdimagelist :=  new TDesigImageList(self); 
         global  editorglobalinfo ;
         if ifarray(editorglobalinfo) and editorglobalinfo then 
         begin 
-            fdimagelist.imgsize :=  editorglobalinfo["imgsize"];   
+            fdimagelist.imgsize :=  editorglobalinfo["imgsize"];  
+            sz :=  editorglobalinfo["fontsize"] ;
+            if sz>5 then FObjInspector.width :=sz*34+20;
         end
+        Mobjinspect();
         //FTree.Imagelist := fdimagelist;
         fwindowinfos := new tfilesinfo(self,thisfunction(ClickTreeNode),fdimagelist,tparent); 
         //******************toolbar ***************
@@ -1646,6 +1724,7 @@ type TVclDesigner = class(tvcform)
                 fdimagelist.imgsize :=  d["imgsize"];                    
             end    
         end ;
+        FTslParser := new unit(utslvclsyntaxparser).ttslscripparser();
         //OnChange
         //fnewmenu
     end 
@@ -1988,42 +2067,41 @@ type TPropEditGrid = class(TPropGrid) //
     function SetComponent(v);override;
     begin
         if v=FComponent then exit;
+        ocls := Columns;
         if v is class(TDComponent) then 
         begin
-            TSLData := v.GetPublishProperties();
+            TSLData := getneedpublished(v);//
         end else 
         begin
             TSLData := array();//array(NIL);
         end 
         inherited;
+        if ocls then 
+        begin
+            w := ocls[1,"width"];
+            if w>0 then 
+            begin
+                i := 1; 
+                    self.ColumnWidth(1) := w;
+            end             
+        end 
     end 
     public
     function Create(AOwner);
     begin
         inherited;
         FobjProptype := p_properys;
-    end 
+    end
+    function getneedpublished(v);virtual;
+    begin
+        return v.GetPublishProperties();
+    end  
 
 end 
-type TEventEditGrid = class(TPropGrid)   //事件编辑器
+type TEventEditGrid = class(TPropEditGrid)   //事件编辑器
 {**
     @explan(说明) 事件编辑 %%
 **}
-    protected
-    function SetComponent(v);override;
-    begin
-        if v=FComponent then exit;
-        if v is class(TDComponent) then 
-        begin
-            TSLData := v.GetPublishEvents();
-            //echo tostn(TSLData);
-        end else 
-        begin
-            TSLData := array(NIL);
-        end 
-        inherited;
-    end 
-
     public
     function Create(AOwner);
     begin
@@ -2031,6 +2109,10 @@ type TEventEditGrid = class(TPropGrid)   //
         FobjProptype := p_evnets;
         OndblClick := thisfunction(GridCellDblClick);
     end 
+    function getneedpublished(v);override;
+    begin
+        return v.GetPublishEvents();
+    end
     function GridCellDblClick(o,e);override;//双击处理
     begin
         i := e.iitem;

designer/utslvcldpropertytypes.tsf

@@ -55,7 +55,7 @@ type TGridPropertyRender = class(TGCellRender) //
         inherited;
         Owner := AOwner;
     end 
-    Owner ;
+    [weakref]Owner ;
 end 
 type TGridCellEditWithButton = class(TGridPropertyRender) //带按钮的单元格编辑
 {**
@@ -387,7 +387,6 @@ type TListVariable = class(TGridList)
             SetColumnWidth(0,Width-11);
         end 
     end 
-
     function create(AOwner);override;
     begin
         inherited;
@@ -397,6 +396,11 @@ type TListVariable = class(TGridList)
         Columns := array(
         ("text":"variable","width":180)
         );
+        OnFontChanged := function()begin
+            ft := font;
+            if not ft then return ;
+            ItemHeight := ft.height+6;
+        end 
     end 
     function SetSelectedByValue(v_);override;
     begin
@@ -458,7 +462,7 @@ type TListStr = class(TListVariable)
     function create(AOwner);override;
     begin
         inherited;
-        Columns := array(("text":"´ò¿ª±à¼­Æ÷","width":160));
+        Columns := array(("text":"±à¼­Æ÷","width":160));
     end 
     function additem(v);override;
     begin
@@ -913,7 +917,7 @@ type TTSLDataGrid=class(TDrawGrid)
     @explan(说明)TSL数组和对象展示 %%
     **}
     private
-    
+    fsearchidex;
     FCols;
     Fdata;
     FObjectData;
@@ -922,7 +926,7 @@ type TTSLDataGrid=class(TDrawGrid)
     FRows;
     FShowTwo;
     FCControls;
-    FColumnWidth;
+    FdfColumnWidth;
     FRowHeader;
     static FGCellRender;
     FCanEditStr;
@@ -992,6 +996,14 @@ type TTSLDataGrid=class(TDrawGrid)
         return FGCellRender[n];
     end
     private
+    function setsearchidex(s);
+    begin
+        if fsearchidex<>s and ifstring(s) then 
+        begin
+            fsearchidex := s;
+            InvalidateRect(nil,false);    
+        end 
+    end 
     function SetRowHeader(v);
     begin
         nv := v?true:false;
@@ -1045,16 +1057,17 @@ type TTSLDataGrid=class(TDrawGrid)
         begin
             fcs[0]:= array("text":"  ","width":min(500,wd));
         end
+        cw := 15* ftwidth;
         if FCL and allFCL and FShowTwo then
         begin
             FCols := FCl;
             for i,v in FCols do
             begin
-                fcs[length(fcs)]:= array("text":ifstring(v)?v:inttostr(v),"width":FMRWD);
+                fcs[length(fcs)]:= array("text":ifstring(v)?v:inttostr(v),"width":cw);
             end
         end else
         begin
-            fcs[length(fcs)]:= array("text":"  ","width":ColumnWidth>20?ColumnWidth:100);
+            fcs[length(fcs)]:= array("text":"  ","width":fdfColumnWidth>20?fdfColumnWidth:cw);
         end
         Columns := fcs;
         ItemCount := length(FRows);
@@ -1146,6 +1159,7 @@ type TTSLDataGrid=class(TDrawGrid)
         end
     end
     public
+    property searchidex read fsearchidex write setsearchidex;
     function create(AOwner);override;
     begin
         inherited;
@@ -1162,7 +1176,7 @@ type TTSLDataGrid=class(TDrawGrid)
         FStringAlign := AL9_CENTERLEFT;
         FDefAlign := AL9_CENTER;
     end
-
+    
     function InitializeWnd();override;
     begin
         inherited;
@@ -1242,6 +1256,10 @@ type TTSLDataGrid=class(TDrawGrid)
         begin
             ds := d;
             //dc.drawtext(ds,src);
+            if j=0 and fsearchidex and pos(lowercase(fsearchidex),lowercase(d)) then 
+            begin
+                dc.font.color := 0xff;    
+            end 
             class(TLabel).CanvasDrawAlignText(dc,src,ds,FStringAlign);
         end else
         if ifobj(d)then
@@ -1267,12 +1285,8 @@ type TTSLDataGrid=class(TDrawGrid)
     begin
         dc := e.canvas;
         rc := e.rcitem;
-        {if SelectedRow = e.id then 
+        c := color;
-        if ifnumber(SelectRowColor) then  dc.brush.color := SelectRowColor;
+        if c then dc.brush.color := c; //
-        else 
-        dc.brush.color := rgb(150,150,150);
-        else }
-        if color then dc.brush.color := color; //
         else dc.brush.color := rgb(255,255,255);
         dc.fillrect(rc);
         inherited;
@@ -1315,9 +1329,8 @@ type TTSLDataGrid=class(TDrawGrid)
         begin
             if d["type"]="object" then
             begin
-                rd := GetCellRender(d["class"]);
+                rd := GetCellRender(d["class"]);                
-                
+                if rd then return rd.CelldbClick(o,e,d); ///////////
-                if r then return r.CelldbClick(o,e,d);
             end
             getitemcontrol(d,p,e.iitem,cl,"grid",cp,indexs);
         end else
@@ -1362,24 +1375,6 @@ type TTSLDataGrid=class(TDrawGrid)
             end
         end
         return r;
-        idx := "FData";
-        for i,v in index do
-        begin
-            if ifnumber(v)then idx += format("[%d]",v);
-            else if ifstring(v)then
-            begin
-                idx += format('["%s"]',v);
-            end
-        end
-        if length(idx)>5 then
-        begin
-            vals := idx+":="+tostn(val)+";"; //FData["c"]["value"]:=0;
-            try
-                eval(&vals);
-            except
-                //echo "===errr";
-            end;
-        end
     end
     function ControlIndexs(dx);
     begin
@@ -1460,7 +1455,7 @@ type TTSLDataGrid=class(TDrawGrid)
     end
     property Twodimensional:bool read FShowTwo write SetTwoD;
     property TSLdata:variable read GetTSLData write SetData;
-    property ColumnWidth:integer read FColumnWidth write FColumnWidth;
+    property dfColumnWidth:integer read FdfColumnWidth write FdfColumnWidth;
     property RowHeader:bool read FRowHeader write SetRowHeader;
     property CanEditStr:bool read FCanEditStr write FCanEditStr;
     property StringAlign:AlignStyle9 read FStringAlign write SetStringAlign;
@@ -3051,6 +3046,7 @@ private
     public
         function create(aOwner);override;begin
             inherited;
+            ParentFont := false;
             caption:="TreeViewEditor";
             left:=300;
             top:=300;
@@ -3256,13 +3252,15 @@ type TMultiSelList = class(TCustomControl)
     function Create(AOwner);
     begin
         inherited;
+        FBtnWidth := 80;
+        border := true;
         FList := new TListBox(self);
+        FList.checkbox := true;
         FList.Multisel := 2;
         //FList.Appenditems(array("a","b","c"));
         FList.setCurrentSelection(array(0,1));
         FList.parent := self;
-        FOkBtn := new TBTN(self);
+        FOkBtn := new TBTN(self);        
-        FBtnWidth := 80;
         FOkBtn.width := FBtnWidth;
         FOkBtn.caption := "确定";
         FOkBtn.parent := self;
@@ -3272,7 +3270,20 @@ type TMultiSelList = class(TCustomControl)
         FCanceBtn.parent := self;
         FCanceBtn.onclick := thisfunction(CancelClick);
         FOkBtn.onclick := thisfunction(okClick);
+        OnFontChanged := thisfunction(DoControlAlign);
     end 
+    {function FontChanged(o);override;
+    begin
+        ft := font;        
+        if not ft then return ;
+        inherited; 
+        FBtnWidth := 5*ft.width;
+        FOkBtn.height := ft.height+5;
+        Fokbtn.width := FBtnWidth;
+        FCanceBtn.height := ft.height+5;
+        FCanceBtn.width := FCanceBtn;
+               
+    end }
     function GetSelectdata();
     begin
         idx := FList.getSelectedIndexes();
@@ -3319,18 +3330,24 @@ type TMultiSelList = class(TCustomControl)
     end 
     function DoControlAlign();override;
     begin
-        if FList and FOkBtn AND FCanceBtn then 
+        ft := font;
+        if ft and FList and FOkBtn AND FCanceBtn then 
         begin
             r := ClientRect;
-            h := FOkBtn.height;
+            h :=ft.height+4; 
+            w :=ft.width*5;           
             c := r;
             c[3]-=h+4;
             FList.SetBoundsRect(c);
             bt := r[3]-h-1;
+            FOkBtn.height := h;
+            FOkBtn.width := w;
             FOkBtn.Top := bt;
-            FOkBtn.Left := r[2]-FBtnWidth-5;     
+            FOkBtn.Left := r[2]-w-5;     
             FCanceBtn.top := bt;
-            FCanceBtn.Left := r[2]-FBtnWidth-FBtnWidth-10;       
+            FCanceBtn.height := h;
+            FCanceBtn.width := w;
+            FCanceBtn.Left := r[2]-w*2-10;       
         end 
     end 
     function CancelClick(o,e);

designer/utslvclsyntaxparser.tsf

@@ -958,6 +958,12 @@ type tsltoken = class(tslparserbase)         //
                 vf := 1;
                 setdata(FTokens,nk,v,"»Ø³µ",pos,hh);
             end else
+            if v="." and (pos< len-2) and str[pos+1]="." and str[pos+2]="." then 
+            begin
+                if length(vs)then setdata(FTokens,nk,vs,"Óï¾ä",pos,hh);
+                setdata(FTokens,nk,"...","Óï¾ä",pos,3);
+                pos+=2;
+            end else
             if v in array(",",";",".","]","[",":","=","!")then
             begin
                 if length(vs)then setdata(FTokens,nk,vs,"Óï¾ä",pos,hh);

funcext/tvclib/tcomponent.tsf

@@ -248,7 +248,7 @@ private
         if op=opRemove or op=opInsert then return 0;
         if fonnotification then 
         begin 
-            e := new tuieventbase(op,0,0,0);
+            e := new unit(utslvclevent).tmnotif(op);
             e.sender := a;
             CallMessgeFunction(fonnotification,self(true),e);
             return e.skip;
@@ -258,7 +258,7 @@ private
     begin
         if foninqurequit then 
         begin 
-            e := new tuieventbase(0,0,0,0);
+            e := new unit(utslvclevent).tminqurequit();//tuieventbase(0,0,0,0);
             CallMessgeFunction(foninqurequit,self(true),e);
             return e.skip;    
         end 
@@ -335,12 +335,6 @@ public //
         FEventsProperties := array();
         FVariableProperties := array();
         FComponentCreated := true;
-        return;
-        If AOwner is class(tcomponent)then
-        begin
-            FOwner := AOwner;
-            AOwner.InsertComponent(Self);
-        end
     end
     function set_loadstate(v); //设置loading状态
     begin
@@ -519,30 +513,6 @@ public //
     FChangedinheritedProperties;
     FChangedProperties;
     FVariableProperties;
-    {function GetPublishInfo();//属性获取
-    begin
-        r := publishs();
-        rr := array();
-        ri := 0;
-        for i,v in r do 
-        begin 
-            if ifstring(v) then rr[ri++] := lowercase(v);
-        end 
-        return rr;
-    end }
-    {function OrderPublish(r,od); //排序发布的东西
-    begin
-        if od then
-        begin
-            r1 := array();
-            for i,v in od do
-            begin
-                vi := r[v];
-                if vi then r1[v]:= vi;
-            end
-            r := r1;
-        end
-    end}
     public //设计器属性设置相关
     function GetPublishproperties();virtual; //获得属性信息
     begin
@@ -551,7 +521,6 @@ public //
         **}
         ps := GetPropInfo();
         r := array();
-        //pps := GetPublishInfo();
         for i,v in ps do
         begin
             typ := v["type"];
@@ -561,7 +530,6 @@ public //
             if otype then
             begin
                 n := v["name"];
-                //if pps and not(n in pps)then continue;
                 if typ in array("variable","popupmenu","syscursor","tmainmenu")then
                 begin
                     r[n]:= otype.FormatEdit(FVariableProperties[n],v["write"]?true:false);
@@ -676,7 +644,6 @@ public //
                 if ifobj(otype)then
                 begin
                     iv := otype.UnformatEdit(v); //反转换
-                    //if FChangedProperties[n]=vi then continue; //没有改变
                     if FChangedProperties[n]=iv then continue; //没有改变
                     SetChangedPublish(n,iv,pp); //保存
                     if n="visible" or n="wspopup" or n="enabled" then 
@@ -724,7 +691,6 @@ public //
     @param(ComponentStyle)() 样式结合 %%
     @param(ComponentCreated)(bool) 样式结合 %%
     **}
-    //property DesignInfo read FDesignInfo write FDesignInfo; 
     property ComponentCreated read FComponentCreated;
     property Components read FComponents;
     property ComponentState read FComponentState write SetComponentState;

funcext/tvclib/tcontrol.tsf

@@ -441,42 +441,66 @@ type tcontrol = class(tcomponent)
         {**
         @explan(说明)根据消息参数构造消息对象;
         **}
-        if message in array(WM_MOUSEMOVE,WM_LBUTTONDOWN,
+        case message of
+            WM_CLOSE :
+            begin
+                r := new tmclose(message,wparam,lparam,hwnd);
+            end 
+            WM_MOUSEMOVE :
+            begin
+                r := new tmm_move(message,wparam,lparam,hwnd);
+            end
+            WM_CONTEXTMENU :
+            begin
+                r := new tmcontextpop(message,wparam,lparam,hwnd);
+            end  
+            WM_LBUTTONDOWN,
             WM_RBUTTONDOWN,WM_LBUTTONUP,
             WM_RBUTTONUP,WM_LBUTTONDBLCLK,
-            WM_RBUTTONDBLCLK,WM_MBUTTONDOWN,WM_MBUTTONUP,WM_MBUTTONDBLCLK)then
+            WM_RBUTTONDBLCLK,WM_MBUTTONDOWN,WM_MBUTTONUP,WM_MBUTTONDBLCLK :
-        begin
+            begin
-            r := new TMMouse(message,wparam,lparam,hwnd);
+                r := new TMMouse(message,wparam,lparam,hwnd);       
-        end else
+            end      
-        if message=WM_MENUSELECT then
+            WM_MENUSELECT :
-        begin
+            begin
-            r := new TMMENUSELECT(message,wparam,lparam,hwnd);
+                r := new TMMENUSELECT(message,wparam,lparam,hwnd);
-        end else
+            end
-        if message=WM_MEASUREITEM then
+            WM_MEASUREITEM :
-        begin
+            begin
-            r := new TMMEASUREITEM(message,wparam,lparam,hwnd);
+                r := new TMMEASUREITEM(message,wparam,lparam,hwnd);
-        end else
+            end 
-        if message in array(WM_KEYDOWN,WM_KEYUP,WM_CHAR,WM_SYSCHAR,WM_SYSKEYDOWN,WM_SYSKEYUP)THEN
+            WM_ACTIVATE :
-        begin
+            begin
-            r := new TMKEY(message,wparam,lparam,hwnd);
+                r := new tmactivate(message,wparam,lparam,hwnd);
-        end else
+            end 
-        if message=WM_DRAWITEM then
+            WM_KEYDOWN,WM_KEYUP,
-        begin
+            WM_SYSCHAR,WM_SYSKEYDOWN,WM_SYSKEYUP :
-            r := new TMDRAWITEM(message,wparam,lparam,hwnd);
+            begin
-        end else
+                r := new TMKEY(message,wparam,lparam,hwnd);
-        if message=WM_NOTIFY then
+            end
-        begin
+            WM_CHAR:
-            r := new TMNOTIFY(message,wparam,lparam,hwnd);
+            begin
-        end else
+                r := new tmk_press(message,wparam,lparam,hwnd);
-        if message=WM_MOUSEWHEEL then
+            end 
-        begin
+            WM_DRAWITEM :
-            r := new TMMOUSEWHEEL(message,wparam,lparam,hwnd);
+            begin
-        end else
+                r := new TMDRAWITEM(message,wparam,lparam,hwnd);
-        if message=WM_STYLECHANGED or message=WM_STYLECHANGING then
+            end 
-        begin
+            WM_NOTIFY :
-            r := new TMSTYLECHANG(message,wparam,lparam,hwnd);
+            begin
-        end else
+                r := new TMNOTIFY(message,wparam,lparam,hwnd);
-        r := new tuieventbase(message,wparam,lparam,hwnd);
+            end 
+            WM_MOUSEWHEEL :
+            begin
+                r := new TMMOUSEWHEEL(message,wparam,lparam,hwnd);
+            end 
+            WM_STYLECHANGED ,WM_STYLECHANGING :
+            begin
+                r := new TMSTYLECHANG(message,wparam,lparam,hwnd);
+            end 
+            else
+                r := new tuieventbase(message,wparam,lparam,hwnd);        
+        end ;
         return r;
         //return new tuieventbase(message,wparam,lparam,hwnd);
     end
@@ -1014,7 +1038,7 @@ type tcontrol = class(tcomponent)
     function WMMove(o,e):LM_MOVE;virtual;
     begin
         if not NoRecycled() then return ;
-        CallMessgeFunction(OnMove,o,e);
+        CallMessgeFunction(fOnMove,o,e);
         if (o is class(TWinControl)) and o.WsPopUp then return ;
         if (Align=alNone)  then 
         begin  
@@ -1029,7 +1053,7 @@ type tcontrol = class(tcomponent)
     function WMSize(o,e):LM_SIZE;virtual;
     begin
         if not NoRecycled() then return ;
-        CallMessgeFunction(OnSize,o,e);
+        CallMessgeFunction(fOnSize,o,e);
         DoWMSIZE(o,e);
         p := Parent ;
         if p and p.childsizing.layout>0 then return p.AdjustSize();
@@ -1580,7 +1604,7 @@ type tcontrol = class(tcomponent)
     	@param(Cursor)(tcursor 通过 member of TSystemCursor 设置) 系统鼠标 %%
     **}
     property Font:font read GetControlFont  write SetControlFont;//write SetFont; 
-    property OnMouseWheel read FOnMouseWheel write FOnMouseWheel;
+    property OnMouseWheel:eventhandler read FOnMouseWheel write FOnMouseWheel;
     {**
     	@param(Caption)(string) 控件标题 %%
     	@param(Enabled)(bool) 控件是否有效 %%

funcext/tvclib/tcustomcontrol.tsf

@@ -18,6 +18,7 @@ type tcustomcontrol=class(TWinControl)
         cvs.rcpaint := PAINTSTRUCT().rcpaint();
         try        
             Paint();
+            inherited;
         finally
             cvs.Handle := 0;
         end;            

funcext/tvclib/tslvcl.tsf

@@ -33,10 +33,10 @@ function ExitMessageLoop();                      //
 function NotifyComponent(Sender,Act,ToComponent); //notfiy
 //////////////////////操作/////////////////////
 Function tslcstructure(data,dsize,pack,ptr);
-
 //function CompareRect(orect,nrect);
 function calldatafunction();
 function CallMessgeFunction(f,o,e);
+function CallMessageFunction(f,o,e); //执行消息回调
 //////////////////////执行tsl脚本代码////////////////////
 //function TSL_Check(func,funclen,oResult);
 function CheckTslCode(code,err);              //检查tsl语法
@@ -1276,6 +1276,7 @@ type TpanelForm=class(tpanel) //
     protected
     function SetWsPopUp(v);override;
     begin
+        if self(true).classinfo()["classname"]<>"tdcreatepanel" then return inherited;
         if csDesigning in ComponentState then
         begin
         end else
@@ -1285,6 +1286,7 @@ type TpanelForm=class(tpanel) //
     end
     function GetWsPopUp();override;
     begin
+        if self(true).classinfo()["classname"]<>"tdcreatepanel" then return inherited;
         if csDesigning in ComponentState then
         begin
             return true;
@@ -1317,7 +1319,7 @@ type TpanelForm=class(tpanel) //
     end 
     function SetDesigning(f,fc);override;
     begin
-        if f then wspopup := true;
+        if f and (self(true).classinfo()["classname"]="tdcreatepanel") then wspopup := true;
         inherited;
     end
 end
@@ -1489,8 +1491,7 @@ type tmemo = class(TSynMemoNorm)   //
     function DoTextChanged(p);override;//文本改变
     begin	
         inherited;
-        if Fonchange then 
+        CallMessgeFunction(Fonchange,self(true));
-            calldatafunction(Fonchange,self(true),new tuieventbase(0,0,0,0));
     end 
     function GetPreferredSize(w,h);override;
     begin
@@ -3591,8 +3592,7 @@ type TListView = class(TDrawGrid)
     end
     function CallSelChanged();
     begin
-        if OnSelChanged then 
+        CallMessgeFunction(FSelectedChanged,self(true));
-        return calldatafunction(OnSelChanged,self(true),new tuieventbase(0,0,0,0));
     end
     function SetCanSelected(v);
     begin
@@ -5203,7 +5203,7 @@ type TQuotations=class(tcomponent)
         **}
         if not ifarray(d)then exit;
         FData := d;
-        calldatafunction(FOncallBack,self(true));
+        CallMessgeFunction(FOncallBack,self(true));
     end
     public
     function create(AOwner);override;
@@ -6530,6 +6530,10 @@ function GetTextWidthAndHeightWidthFont(s,f,mul);//
 begin
     return unit(utslvclgdi).GetTextWidthAndHeightWidthFont(s,f,mul);
 end 
+function CallMessageFunction(f,o,e); //执行消息回调
+begin
+    return unit(utslvclauxiliary).CallMessgeFunction(f,o,e);    
+end
 function CallMessgeFunction(f,o,e); //执行消息回调
 begin
     return unit(utslvclauxiliary).CallMessgeFunction(f,o,e);    

funcext/tvclib/tuieventbase.tsf

@@ -64,6 +64,11 @@ type tuieventbase=class(TSLUICONST)
         Lparam := l;
         Hwnd := h;
     end
+    function expandinfo();virtual; //作为函数参数展开
+    begin
+        //返回二维数组,字段 name ,var,alias,type
+        return array();
+    end 
     function hilparam();
     begin
         {**

funcext/tvclib/twincontrol.tsf

@@ -62,6 +62,7 @@ type TWinControl = class(tcontrol)
     FWsDlgModalFrame;
     private //模态相关
     //*******showmodal******************
+    fmodalcenter;//模态居中
     FModaling;
     FModalCode;
     FMinWidth;
@@ -129,6 +130,7 @@ type TWinControl = class(tcontrol)
         FMSG := new TTagMSG();
         msg := FMSG._getptr_;
         //显示自己 
+        center_self();
         _wapi.ShowWindow(hWnd,SW_SHOW);
         _wapi.BringWindowToTop(hWnd);
         //disable掉父窗口 
@@ -918,7 +920,7 @@ type TWinControl = class(tcontrol)
     function WMACTIVATE(o,e):WM_ACTIVATE;virtual;
     begin
         factivated := e.wparam;
-        CallMessgeFunction(OnActivate,o,e);
+        CallMessgeFunction(fOnActivate,o,e);
         if e.skip then return ;
         defaulthandler(e);
         if factivated and ContainsControl(factivecontrol) then 
@@ -1557,6 +1559,27 @@ type TWinControl = class(tcontrol)
     end
     procedure PaintWindow(DC:HDC);virtual;
     begin
+        ///////////////////设计器中选中绘制/////////////////////////////////////////////
+        if (csDesigning in ComponentState) and FDesignSelect  then //选中
+        begin
+            c := getwndclientrect();
+            x := (c[0]+c[2])/2;
+            y := (c[1]+c[3])/2;
+            ps := array(
+                (x,c[1]),
+                (c[0],y),
+                (c[2],y),
+                (x,c[3])
+            );
+            cvs := Canvas;
+            cvs.Brush.color := sys_complementar_color(Color);
+            sz := 4;
+            for i,v in ps do 
+            begin 
+                cvs.draw_rect().rect(array(v[0]-sz,v[1]-sz,v[0]+sz,v[1]+sz)).draw(); 
+            end 
+        end
+        ////////////////////////////////////////////////////
     end
     function SetTempCursor(Value);override;
     begin
@@ -1946,6 +1969,7 @@ type TWinControl = class(tcontrol)
     end
     function create(aowner);override; //type_twinctrol
     begin
+        fmodalcenter := true;
         inherited;
         fchildsizing := new t_children_sizer(self(true));
         //fbordercolor := rgb(190,190,190);
@@ -2073,17 +2097,20 @@ type TWinControl = class(tcontrol)
             dy := 20;
             x := 0;
             y := 0;            
-            c := 0;
+            c := sys_complementar_color(color);
+            bbc := cv.brush.color;
+            cv.brush.color := c;
             while y<rc[3] do 
             begin 
                 y+=dx;
                 x := 0;
                 while x<rc[2] do 
                 begin
-                    x+=dx;  
+                    x+=dx; 
-                    cv.SetPixel(array(x,y),c);      
+                    cv.FillRect(array(x-1,y-1,x+1,y+1));   
                 end  
             end 
+            cv.brush.color := bbc;
             ctls := controls;
             rcs := array();
             sel := -1;
@@ -2112,7 +2139,7 @@ type TWinControl = class(tcontrol)
                 pct := cv.pen.style;
                 pcw := cv.pen.width;
                 cv.pen.Style := PS_DOT;
-                cv.pen.color := 0x3f3f3f;
+                cv.pen.color := c;//0x3f3f3f;
                 for i := 0 to len do 
                 begin
                     if i=sel then continue;
@@ -2294,6 +2321,14 @@ type TWinControl = class(tcontrol)
         end
     end
     private //绘制相关成员
+    function sys_complementar_color(c);
+    begin
+        if (c .& 0xff000000) then 
+        begin 
+            return complementary_color( _wapi.GetSysColor(c .& 0x00ffffff));
+        end   
+        return complementary_color(c);  
+    end
     FPaintRects;
     FUpDateCount;
     public
@@ -2553,7 +2588,7 @@ type TWinControl = class(tcontrol)
                     _Send_(WM_NCLBUTTONDOWN,HTCAPTION,0,0);
                     e.skip := true;
                 end
-                CallMessgeFunction(OnDesignClick,self(true),e);
+                CallMessgeFunction(FOnDesinedsel,self(true),e);
                 //保留原有的点击消息
                 {if DesigningClick() then 
                 begin
@@ -2562,11 +2597,11 @@ type TWinControl = class(tcontrol)
             end else 
             if msg = WM_LBUTTONDBLCLK then 
             begin
-                CallMessgeFunction(OnDesignDBLClick,self(true),e);					
+                CallMessgeFunction(FOnDesigDBLClick,self(true),e);					
             end else 
             if msg = WM_RBUTTONDOWN then 
             begin 
-                CallMessgeFunction(OnDesignRClick,self(true),e);
+                CallMessgeFunction(FOnDesinedRclick,self(true),e);
             end else 
             if msg = WM_USER then 
             begin
@@ -2902,11 +2937,11 @@ type TWinControl = class(tcontrol)
     property OnActivate:eventhandler read FOnActivate write FOnActivate;
     property OnClose:eventhandler read FOnClose write FOnClose;
     property OnKeyDown:eventhandler read FOnKeyDown write FOnKeyDown;
-    property OnsysKeyDown:eventhandler read FOnsysKeyDown write FOnsysKeyDown;
+    property OnsysKeyDown read FOnsysKeyDown write FOnsysKeyDown;
     property OnKeyUp:eventhandler read FOnKeyUp write FOnKeyUp;
-    property OnsysKeyUp:eventhandler read FOnsysKeyUp write FOnsysKeyUp;
+    property OnsysKeyUp read FOnsysKeyUp write FOnsysKeyUp;
     property OnKeyPress:eventhandler read FOnKeyPress write FOnKeyPress;
-    property OnSysKeyPress:eventhandler read FOnSysKeyPress write FOnSysKeyPress;
+    property OnSysKeyPress read FOnSysKeyPress write FOnSysKeyPress;
     property OnDesignClick read FOnDesinedsel write FOnDesinedsel;
     property OnDesignDBLClick read FOnDesigDBLClick write FOnDesigDBLClick;
     property OnDesignRClick read FOnDesinedRclick write FOnDesinedRclick;
@@ -2923,7 +2958,34 @@ type TWinControl = class(tcontrol)
     property ActiveControl read getactivecontrol write setactivecontrol; 
     property Active read factivated;//是否获活动窗口
     property childsizing:tchildsizing read fchildsizing write setchildsizing;
+    property modalcenter read fmodalcenter write fmodalcenter; //模态时候居中
     private //模态相关
+    function center_self();
+    begin
+        ////////////////////窗口居中处理/////////////////////////////////
+        ////////////////////wnd待居中的窗口/////////////////////////////////
+        ////////////////////pwnd父窗口/////////////////////////////////
+        if not fmodalcenter then return ;
+        wnd := self(true);
+        pd := wnd.parent;
+        if pd and pd.Visible then 
+        begin
+            while not(pd.wspopup) do 
+            begin
+                npd :=  pd.parent;
+                if npd then pd := npd;
+                else break;
+            end  
+            r := pd.ClientRect;
+            xy := pd.clienttoscreen(r[0],r[1]); 
+        end else  
+        begin
+            xy := array(0,0);
+            r := wnd._wapi.GetScreenRect();
+        end  
+        wnd.Left := max(0,xy[0]+(r[2]-r[0]-wnd.width)/2) ;
+        wnd.top := max(0,xy[1]+(r[3]-r[1]-wnd.Height)/2);
+    end
     property Modaling read FModaling;
     {**
     @param(BorderStyle)(bsNone|bsSingle) 边框样式 %%
@@ -2933,7 +2995,7 @@ type TWinControl = class(tcontrol)
     @param(OnClose)(function[TWincontrol,tuieventbase]) 窗口关闭消息回调  %% 
     @param(OnKeyDown)(function[TWincontrol,TMKEY]) 按键按下回调  %% 
     @param(OnKeyUp)(function[TWincontrol,TMKEY]) 按键松开  %% 
-    @param(OnKeyPress)(function[TWincontrol,TMKEY]) ×Ö·ûÏûÏ¢  %% 
+    @param(OnKeyPress)(function[TWincontrol,tmk_press]) 字符消息  %% 
     **}
     private  //ShortCut
     function dispatchshortcut(c,st); //快捷键分发

funcext/tvclib/ugtkinterface.tsf

@@ -1062,6 +1062,16 @@ type tsgtkapi = class(tgtkapis)
     end 
     Function DrawTextExA(hdc :pointer;txt:string;len:integer;rec:array of integer;fmt:integer;lpdtp:pointer):integer;
     begin
+        //DT_LEFT := 0;      
+        DT_RIGHT := 0x2;      
+        //DT_TOP := 0;
+        DT_BOTTOM:= 0x8;
+        DT_CENTER := 0x1;
+        DT_VCENTER:= 0x4;
+        DT_SINGLELINE:= 0x20;
+        //DT_TABSTOP:= 0x80; 
+        fmt := (fmt>0 or fmt<0)?fmt:0;
+        dfs :=  (fmt .& DT_SINGLELINE) = DT_SINGLELINE;
         slen := length(  txt);
         if slen<1 then return ;
         ft := gtk_object_get_data(hdc,"font");
@@ -1082,23 +1092,19 @@ type tsgtkapi = class(tgtkapis)
             if vi="\r" then continue;
             if vi="\n" then 
             begin
-                rs++;
+                if not dfs then 
-                mxl := max(mxl,rl);
+                begin 
-                rl := 0;
+                    rs++;
+                    mxl := max(mxl,rl);
+                    rl := 0;
+                end 
                 continue;
             end 
             rl++;            
         end 
+        if dfs then slen := rl;
         ht := ht*rs;
-        mxl  := max(mxl,rl);
+        mxl  := max(mxl,rl); 
-        //DT_LEFT := 0;      
-        DT_RIGHT := 0x2;      
-        //DT_TOP := 0;
-        DT_BOTTOM:= 0x8;
-        DT_CENTER := 0x1;
-        DT_VCENTER:= 0x4;
-        //DT_SINGLELINE:= 0x20;
-        //DT_TABSTOP:= 0x80;  
         rw := rec[2]-rec[0];
         nlen := min(len,  min(integer(rw/wd),mxl));  
         sx := rec[0];
@@ -1140,7 +1146,11 @@ type tsgtkapi = class(tgtkapis)
         y := 0;//gtk_object_get_data(hdc,"viewport.y");
         reci := array(rec[0]+x,rec[1]+y,rec[2]+x,rec[3]+y);
         cairo_clip_rec(hdc,reci);
-        r :=  TextOutexA(hdc,sx,sy-dht,txt,slen); 
+        if dfs then 
+        begin 
+            r :=  TextOutexA(hdc,sx,sy-dht,replacetext(replacetext(txt,"\r",""),"\n",""),slen); 
+        end else 
+            r :=  TextOutexA(hdc,sx,sy-dht,txt,slen); 
         cairo_restore(hdc);
         return r;
     end 

funcext/tvclib/utslmemo.tsf

@@ -456,7 +456,9 @@ type TCustomMemoCmd=class()   //
     static const ecPrevBlock=0x2BE;static const ecNextJumpOut=0x2BF;static const ecPrevJumpOut=0x2C0;
     static const ecUserFirst=0x3E9;static const ecFind=0x3EA;static const ecReplace=0x3EB;
     static const ecSearchAgain=0x3EC;static const ecFindAll=0x3ED;static const ecString=0x3EE;
-    static const ecSearchUpAgain=0x3EF;    
+    static const ecSearchUpAgain=0x3EF; 
+    //////////////////////选择模式/////////////////////////////////
+    static const smNormal = 0;static const smLine = 1;static const smColumn = 2;     
 end
 
 type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //编辑器基类
@@ -518,10 +520,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
     static const crUnindent = 7;
     static const crSilentDelete = 8;
     static const crSilentDeleteAfterCursor = 9;
-    static const crNothing = 10;
+    static const crNothing = 10;   
-    static const smNormal = 0;
-    static const smLine = 1;
-    static const smColumn = 2;  
     //****************
     protected
     
@@ -693,9 +692,42 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
                 begin
                     cvs.Brush.Color := fselectbkcolor;//rgb(192,192,192);
                     src := r;
-                    if FSelectionMode=smLine then
+                    if FSelectionMode=smLine then //行选择
                     begin
+                    
                     end else
+                    if FSelectionMode=smColumn then //块选择
+                    begin
+                        if bb[0]=ee[0] then
+                        begin 
+                            src[0]+= fCharWidth *(bb[1]-1);
+                            src[2]:= src[0]+fCharWidth *(ee[1]-bb[1]);
+                        end 
+                        else 
+                        begin
+                            t1 := bb;
+                            t2 := ee;
+                            bb := array(min(t1[0],t2[0]),min(t1[1],t2[1]));
+                            ee := array(max(t1[0],t2[0]),max(t1[1],t2[1]));                        
+                            s := FLines.GetStringByIndex(i);
+                            ls := length(s);
+                            dx := 0;
+                            case bytetype(s,bb[1]) of
+                                2: 
+                                begin
+                                    src[0]+= fCharWidth *(bb[1]);
+                                    dx := -1;
+                                end 
+                                else src[0]+= fCharWidth *(bb[1]-1);
+                            end ;
+                            case bytetype(s,ee[1]-1) of
+                                1:src[2]:= src[0]+max(0,fCharWidth *(min(ee[1],ls+1)-bb[1]+1+dx));
+                                else src[2]:= src[0]+max(0,fCharWidth *(min(ee[1],ls+1)-bb[1]+dx));
+                            end ;
+                            
+                        end 
+                        
+                    end else 
                     begin
                         if bb[0]=ee[0]then //同一行
                         begin
@@ -1027,7 +1059,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
         if ftmemlockv.locked then return ;
         if e.skip then return;
         c := e.wparam;
-        if ReadOnly then return;
+        if ReadOnly or (FSelectionMode=smColumn) then return;
         if c=13 then return CharInput("\r\n");
         if c<32 and not(c in array(9))then return;
         cc := e.char;
@@ -1139,7 +1171,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
     end
     function CharInput(c);virtual;//插入字符
     begin
-        if not ReadOnly then return InsertChars(c);
+        if not(ReadOnly or (FSelectionMode=smColumn)) then return InsertChars(c);
     end
     function ExecuteCommand(cmd,data);override;//执行命令
     begin
@@ -1801,7 +1833,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
     end
     function SetSelectionMode(v);
     begin
-        if(v <> FSelectionMode)and(v in array(smNormal,smLine))then FSelectionMode := v;
+        if(v <> FSelectionMode)and(v in array(smNormal,smLine,smColumn))then FSelectionMode := v;
     end
     function MoveCaretHorz(stp,sel);
     begin
@@ -2236,7 +2268,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
     function GetBlockEnd();
     begin
         if GetSelAvail()then
-        begin
+        begin      
             if fBlockEnd[0]<fBlockBegin[0]or(fBlockEnd[0]=fBlockBegin[0]and fBlockEnd[1]<fBlockBegin[1])then return fBlockBegin;
             else return fBlockEnd;
         end
@@ -2297,6 +2329,52 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
                 if i<len then r += "\r\n";
             end
         end else
+        if sm=smColumn then 
+        begin
+            if bb[0]=ee[0]then
+            begin
+                s := fLines[bb[0]-1].FStr;
+                if not s then return "";
+                bg := min(bb[1],ee[1]);
+                ed := max(bb[1],ee[1]);
+                if bg<ed then return s[bg:(ed-1)]; //2023078 出错
+                return "";
+            end else
+            begin
+                //第一行 
+                r += "";
+                //中间
+                for i := bb[0]-1 to ee[0]-1 do
+                begin
+                    s := fLines[i].FStr;
+                    ls := length(s);
+                    t1 := bb;
+                    t2 := ee;
+                    bb := array(min(t1[0],t2[0]),min(t1[1],t2[1]));
+                    ee := array(max(t1[0],t2[0]),max(t1[1],t2[1]));
+                    if bb[1]<=ls   then 
+                    begin 
+                        dx := 0;
+                        case bytetype(s,bb[1]) of
+                            2: 
+                            begin
+                                bx := bb[1]+1;
+                                dx := -1;
+                            end 
+                            else bx := bb[1];
+                        end ;
+                        case bytetype(s,ee[1]-1) of
+                            1: ex := min(ee[1],ls);
+                            else ex:= min(ee[1]-1,ls);
+                        end ;
+                        if bx<=ex then r += s[bx:ex];
+                    end 
+                    if i<ee[0]-1 then r += "\r\n";
+                end
+                //最后一行
+
+            end 
+        end else 
         begin
             if bb[0]=ee[0]then
             begin
@@ -2958,7 +3036,7 @@ type TSynHighLighter = class(TComponent) //
         r := FCacheTokens[ridx];
         if r then return r;
         s := Flines.GetSTringByIndex(ridx);
-        if not ifstring(s) then return;
+        if not ifstring(s) then return nil;
         idx := 1;
         len := length(s);
         tks := array();
@@ -3199,6 +3277,7 @@ type tcustomsynhighlighter = class(TSynHighLighter)
     function GetLineTokens(idx);override;
     begin
         if idx<FSatesCount then return FTokens[idx];
+        return nil;
     end
     function SetTToken(tokens,ttk,idx,ext);override; //设置token
     begin
@@ -3766,7 +3845,7 @@ type TSynCustomMemo = class(TCustomMemo)
     end 
     function CharInput(c);override; //字符输入
     begin
-        if ReadOnly then return ;
+        if ReadOnly or (FSelectionMode=smColumn) then return ;
         if c="\r\n" then 
         begin 
             if FinishCompletion() then //确定键
@@ -4061,28 +4140,28 @@ type TSynMemoNorm = class(TsynCustomMemo) //
             end
             ord("V"):
             begin
-                if ReadOnly then return ;
+                if ReadOnly or (FSelectionMode=smColumn) then return ;
                 ExecuteCommand(ecPaste);
             end
             ord("X"):
             begin
             //if (ssAlt in e.shiftstate) then return ExecuteCommand(ecRedo);
-                if ReadOnly then return ;
+                if ReadOnly or (FSelectionMode=smColumn) then return ;
                 ExecuteCommand(ecCut);
             end
             ord("Y"),ord("L"):
             begin
-                if ReadOnly then return ;
+                if ReadOnly or (FSelectionMode=smColumn) then return ;
                 return ExecuteCommand(ecDeleteLine);
             end
             ord("Z"):
             begin
-                 if ReadOnly then return ;
+                 if ReadOnly or (FSelectionMode=smColumn) then return ;
                 return ExecuteCommand(ecUndo);
             end 
             ord("U"):
             begin
-                 if ReadOnly then return ;
+                 if ReadOnly or (FSelectionMode=smColumn) then return ;
                 return ExecuteCommand(ecRedo);
             end
             VK_LEFT:
@@ -4115,7 +4194,7 @@ type TSynMemoNorm = class(TsynCustomMemo) //
             
                 VK_TAB:
                 begin
-                    if ReadOnly then return ;
+                    if ReadOnly or (FSelectionMode=smColumn) then return ;
                     FSheetTabFlage := true;
                     return ExecuteCommand(ecShifttab,array(TabChar,"\t"," "));
                 end 
@@ -4182,13 +4261,13 @@ type TSynMemoNorm = class(TsynCustomMemo) //
         end
         VK_DELETE: 
         begin
-            if ReadOnly then return ;
+            if ReadOnly or (FSelectionMode=smColumn) then return ;
             ExecuteCommand(ecDeleteChar);	
             return CancelCompletion();
         end 
         VK_BACK :
         begin
-            if ReadOnly then return ;
+            if ReadOnly or (FSelectionMode=smColumn) then return ;
             ExecuteCommand(ecDeleteLastChar,1);
             return CancelCompletion();
         end 

funcext/tvclib/utslvclaction.tsf

@@ -82,8 +82,7 @@ type TBasicAction=class(TComponent)
         if csDesigning in ComponentState then return ;
         if FOnExecute then
         begin
-            e := new tuieventbase(0,0,0,0);
+            if iffuncptr(FOnExecute) then call(FOnExecute,self(true));
-            if iffuncptr(FOnExecute) then call(FOnExecute,self(true),e);
             return true;
         end
         return false;

funcext/tvclib/utslvclauxiliary.tsf

@@ -615,7 +615,7 @@ type tarray1dlk=class //
     function dochanged(info);
     begin
         if onchangelock then return ;
-        if fonchanged then         CallMessgeFunction(fonchanged,self(true),info);    
+        if fonchanged then CallMessgeFunction(fonchanged,self(true),info);    
     end 
     function SwapNoCheck(i,j);
     begin
@@ -910,7 +910,7 @@ type tstrindexarray = class() //
     begin
         {**
         @explan(˵Ã÷) »ñµÃtsl array %%
-        @param(n)(bool) false 返回小写下标，true 返回原始下标 %%
+        @param(n)(bool) true 返回小写下标，false 返回原始下标 %%
         **}
         r := array();
         for i,v in FData do
@@ -3450,8 +3450,9 @@ end;
 //////////////////////////////////////
 function iffuncptr(fn);
 begin
+    return datatype(fn) in array(7,37);
     //return datatype(fn)=7;
-    return fn and ifobj(fn);
+    //return fn and ifobj(fn);
 end 
 function includestate(u,s);
 begin
@@ -4039,12 +4040,136 @@ begin
     if m in array(1,3,5,7,8,10,12) then return 31;
     return 30;  
 end 
+function CallMessgeFunction2(f,o,e);
+begin
+{**
+    @ignore(忽略)
+**}
+    if iffuncptr(f) then return call(f,o,e);
+end
+function get_evt_expand(e,n); //展开形式
+begin
+    if (n=0 or n>2) and   (e is class(tuieventbase)) then 
+    begin
+        ps :=  e.expandinfo();
+        //echo e.Classinfo()["classname"],"\r\n";
+        if ps and ifarray(ps) then 
+        begin
+            r :=  ps[0:(n-3)];
+            len := length(r);
+            n := len+2;
+            return r;
+        end 
+    end 
+    n := min(n,2);
+    return array();
+end
 function CallMessgeFunction(f,o,e);
 begin
-    {**
+{**
     @ignore(ºöÂÔ)
-    **}
+**}
-    if iffuncptr(f) then return call(f,o,e);
+    if not iffuncptr(f) then return ;
+    //////////////事件信息处理//////////////
+    ff := f.functioninfo();
+    ffp := ff["parameter"];
+    plen := length(ffp);
+    ex := get_evt_expand(e,plen);
+    //////////////////////////////////
+    case plen of 
+        1:
+        begin
+            r := call(f,o);    
+        end 
+        3:
+        begin
+            if ifstring(ex[0,"name"]) then x0 := invoke(e,ex[0,"name"]); else x0 := nil;
+            r := call(f,o,e,x0);
+            if  ex[0,"var"] then invoke(e,ex[0,"name"],1,x0);
+        end
+        4:
+        begin
+            if ifstring(ex[0,"name"]) then x0 := invoke(e,ex[0,"name"]); else x0 := nil;
+            if ifstring(ex[1,"name"]) then x1 := invoke(e,ex[1,"name"]); else x1 := nil;
+            r := call(f,o,e,x0,x1);
+            if  ex[0,"var"] then invoke(e,ex[0,"name"],1,x0);
+            if  ex[1,"var"] then invoke(e,ex[1,"name"],1,x1);
+        end
+        5:
+        begin
+            if ifstring(ex[0,"name"]) then x0 := invoke(e,ex[0,"name"]); else x0 := nil;
+            if ifstring(ex[1,"name"]) then x1 := invoke(e,ex[1,"name"]); else x1 := nil;
+            if ifstring(ex[2,"name"]) then x2 := invoke(e,ex[2,"name"]); else x2 := nil;
+            r := call(f,o,e,x0,x1,x2);
+            if  ex[0,"var"] then invoke(e,ex[0,"name"],1,x0);
+            if  ex[1,"var"] then invoke(e,ex[1,"name"],1,x1);
+            if  ex[2,"var"] then invoke(e,ex[2,"name"],1,x2);
+        end
+        6:
+        begin
+            if ifstring(ex[0,"name"]) then x0 := invoke(e,ex[0,"name"]); else x0 := nil;
+            if ifstring(ex[1,"name"]) then x1 := invoke(e,ex[1,"name"]); else x1 := nil;
+            if ifstring(ex[2,"name"]) then x2 := invoke(e,ex[2,"name"]); else x2 := nil;
+            if ifstring(ex[3,"name"]) then x3 := invoke(e,ex[3,"name"]); else x3 := nil;
+            r := call(f,o,e,x0,x1,x2,x3);
+            if  ex[0,"var"] then invoke(e,ex[0,"name"],1,x0);
+            if  ex[1,"var"] then invoke(e,ex[1,"name"],1,x1);
+            if  ex[2,"var"] then invoke(e,ex[2,"name"],1,x2);
+            if  ex[3,"var"] then invoke(e,ex[3,"name"],1,x3);
+        end
+        7:
+        begin
+            if ifstring(ex[0,"name"]) then x0 := invoke(e,ex[0,"name"]); else x0 := nil;
+            if ifstring(ex[1,"name"]) then x1 := invoke(e,ex[1,"name"]); else x1 := nil;
+            if ifstring(ex[2,"name"]) then x2 := invoke(e,ex[2,"name"]); else x2 := nil;
+            if ifstring(ex[3,"name"]) then x3 := invoke(e,ex[3,"name"]); else x3 := nil;
+            if ifstring(ex[4,"name"]) then x4 := invoke(e,ex[4,"name"]); else x4 := nil;
+            r := call(f,o,e,x0,x1,x2,x3,x4);
+            if  ex[0,"var"] then invoke(e,ex[0,"name"],1,x0);
+            if  ex[1,"var"] then invoke(e,ex[1,"name"],1,x1);
+            if  ex[2,"var"] then invoke(e,ex[2,"name"],1,x2);
+            if  ex[3,"var"] then invoke(e,ex[3,"name"],1,x3);
+            if  ex[4,"var"] then invoke(e,ex[4,"name"],1,x4);
+        end
+        8:
+        begin
+            if ifstring(ex[0,"name"]) then x0 := invoke(e,ex[0,"name"]); else x0 := nil;
+            if ifstring(ex[1,"name"]) then x1 := invoke(e,ex[1,"name"]); else x1 := nil;
+            if ifstring(ex[2,"name"]) then x2 := invoke(e,ex[2,"name"]); else x2 := nil;
+            if ifstring(ex[3,"name"]) then x3 := invoke(e,ex[3,"name"]); else x3 := nil;
+            if ifstring(ex[4,"name"]) then x4 := invoke(e,ex[4,"name"]); else x4 := nil;
+            if ifstring(ex[5,"name"]) then x5 := invoke(e,ex[5,"name"]); else x5 := nil;
+            r := call(f,o,e,x0,x1,x2,x3,x4,x5);
+            if  ex[0,"var"] then invoke(e,ex[0,"name"],1,x0);
+            if  ex[1,"var"] then invoke(e,ex[1,"name"],1,x1);
+            if  ex[2,"var"] then invoke(e,ex[2,"name"],1,x2);
+            if  ex[3,"var"] then invoke(e,ex[3,"name"],1,x3);
+            if  ex[4,"var"] then invoke(e,ex[4,"name"],1,x4);
+            if  ex[5,"var"] then invoke(e,ex[5,"name"],1,x5);
+        end
+        9:
+        begin
+            if ifstring(ex[0,"name"]) then x0 := invoke(e,ex[0,"name"]); else x0 := nil;
+            if ifstring(ex[1,"name"]) then x1 := invoke(e,ex[1,"name"]); else x1 := nil;
+            if ifstring(ex[2,"name"]) then x2 := invoke(e,ex[2,"name"]); else x2 := nil;
+            if ifstring(ex[3,"name"]) then x3 := invoke(e,ex[3,"name"]); else x3 := nil;
+            if ifstring(ex[4,"name"]) then x4 := invoke(e,ex[4,"name"]); else x4 := nil;
+            if ifstring(ex[5,"name"]) then x5 := invoke(e,ex[5,"name"]); else x5 := nil;
+            if ifstring(ex[6,"name"]) then x6 := invoke(e,ex[6,"name"]); else x6 := nil;
+            r := call(f,o,e,x0,x1,x2,x3,x4,x5,x6);
+            if  ex[0,"var"] then invoke(e,ex[0,"name"],1,x0);
+            if  ex[1,"var"] then invoke(e,ex[1,"name"],1,x1);
+            if  ex[2,"var"] then invoke(e,ex[2,"name"],1,x2);
+            if  ex[3,"var"] then invoke(e,ex[3,"name"],1,x3);
+            if  ex[4,"var"] then invoke(e,ex[4,"name"],1,x4);
+            if  ex[5,"var"] then invoke(e,ex[5,"name"],1,x5);
+            if  ex[6,"var"] then invoke(e,ex[6,"name"],1,x6);
+        end else 
+        begin 
+            r := call(f,o,e); 
+        end       
+    end ;
+    return r;
 end
 function CheckArrayIsNumbers(Value,n);
 begin

funcext/tvclib/utslvclevent.tsf

@@ -74,6 +74,13 @@ type tmmeasuresize = class(tuieventbase)
         width := -1;
         height := -1;
     end 
+    function expandinfo();override;
+    begin
+        r := array();
+        r[0] := array("name":"width","alias":"wd","type":"integer","var":true);
+        r[1] := array("name":"height","alias":"ht","type":"integer","var":true);
+        return r;
+    end 
     width;
     height;
 end 
@@ -106,8 +113,17 @@ type TMKEY=class(tuieventbase)
     function create(m,w,l,h);override;
     begin
         inherited;
-        FChar := chr(w);
+        if w>0 then 
+            FChar := chr(w);
+        else FChar := chr(0);
     end
+    function expandinfo();override;
+    begin
+        r := array();
+        r[0] := array("name":"charcode","alias":"key","type":"word");
+        r[1] := array("name":"shiftstate","alias":"shift","type":"tshiftstateenum");
+        return r;
+    end 
     property char read FChar;
     property CharCode read wparam;
     property shiftstate read getshiftsate;
@@ -117,6 +133,22 @@ type TMKEY=class(tuieventbase)
     @param(shiftstate)(arry of TShiftStateEnum member ) ascii码 %%
     **}
 end
+type tmk_press=class(TMKEY)
+    {**
+    @param(说明) 按键输入
+    **}
+    public
+    function create(m,w,l,h);override;
+    begin
+        inherited;
+    end
+    function expandinfo();override;
+    begin
+        r := array();
+        r[0] := array("name":"char","alias":"key","type":"string");
+        return r;
+    end 
+end 
 
 Type TtageDrawItem=class(tslcstructureobj)
     private
@@ -265,7 +297,7 @@ type TSIFTSTATE = class(TSLUICONST)
 		end; 
 	
 	end 
-type TMMOUSEWHEEL=class(tuieventbase)
+type tmmousewheel=class(tuieventbase)
     {**
     @explan(说明)鼠标滚动消息类 %%
     **}
@@ -288,12 +320,26 @@ type TMMOUSEWHEEL=class(tuieventbase)
     property delta read hiwparamsigned;
     property ypos read hilparamsigned;
     property xpos read lolparamsigned;
+    property pos read getpos;
+    function expandinfo();override;
+    begin
+        r := array();
+        i := 0;
+        r[i++] := array("name":"shiftstate","alias":"shift","type":"tshiftstateenum");
+        r[i++] := array("name":"delta","alias":"delta","type":"integer");
+        r[i++] := array("name":"pos","alias":"mousepos","type":"array of integer");
+        return r;
+    end
     {**
     @param(ypos)(integer)鼠标的y坐标 %%
     @param(xpos)(integer)鼠标的x坐标 %%
     @param(delta)(integer)运动距离 %%
     **}
     private
+    function getpos();
+    begin
+        return array(xpos,ypos);
+    end 
     FKeyState;
 end
 type TMMouse=class(tuieventbase)
@@ -370,9 +416,110 @@ type TMMouse=class(tuieventbase)
         shiftstate();
         return(ssDouble in FKeyState);
     end
+    function expandinfo();override;
+    begin
+        r := array();
+        r[0] := array("name":"button","alias":"button","type":"tmousebutton");
+        r[1] := array("name":"shiftstate","alias":"shift","type":"tshiftstateenum");
+        r[2] := array("name":"xpos","alias":"x","type":"integer");
+        r[3] := array("name":"ypos","alias":"y","type":"integer");
+        return r;
+    end 
     private
     FKeyState;
 end
+type tmm_move=class(TMMouse)
+    {**
+    @explan(说明) 鼠标移动消息类 %%
+    **}
+    public
+    function create(m,w,l,h);override;
+    begin
+        inherited;
+    end
+    function expandinfo();override;
+    begin
+        r := array();
+        r[0] := array("name":"shiftstate","alias":"shift","type":"tshiftstateenum");
+        r[1] := array("name":"xpos","alias":"x","type":"integer");
+        r[2] := array("name":"ypos","alias":"y","type":"integer");
+        return r;
+    end 
+end
+type tmcontextpop = class(tuieventbase)
+    function create(m,w,l,h);
+    begin
+        inherited;
+    end 
+    property mousepos read getpos; //鼠标位置
+    function expandinfo();override;
+    begin
+        r := array();
+        r[0] := array("name":"mousepos","alias":"mousepos","type":"array of integer");
+        return r;
+    end
+    private 
+    function getpos();
+    begin
+        return array(lolparamsigned(),hilparamsigned());
+    end 
+
+end 
+type tmnotif = class(tuieventbase) //通知消息
+    function create(op);
+    begin
+        inherited create(op,0,0,0);
+    end 
+    function expandinfo();override;
+    begin
+        r := array();
+        r[0] := array("name":"msg","alias":"msg");
+        r[1] := array("name":"skip","alias":"stopnotify","type":"bool","var":true);
+        return r;
+    end
+end
+type tmclose = class(tuieventbase) //窗口关闭
+    function create(m,w,l,h);
+    begin
+        inherited;
+    end 
+    function expandinfo();override;
+    begin
+        r := array();
+        r[0] := array("name":"skip","alias":"stopclose","type":"bool","var":true);
+        return r;
+    end
+end
+type tminqurequit = class(tuieventbase)  //退出询问
+    function create();
+    begin
+        inherited create(0,0,0,0);
+    end 
+    function expandinfo();override;
+    begin
+        r := array();
+        r[0] := array("name":"skip","alias":"stopquit","type":"bool","var":true);
+        return r;
+    end
+end
+type tmactivate = class(tuieventbase)
+    function create(m,w,l,h);
+    begin
+        inherited;
+    end 
+    property deactivate read getdeactivate;
+    function expandinfo();override;
+    begin
+        r := array();
+        r[0] := array("name":"deactivate","alias":"deactivate","type":"bool");
+        return r;
+    end
+    private 
+    function getdeactivate();
+    begin
+        return Wparam=0;
+    end 
+end
 type TMSTYLECHANG=class(tuieventbase)
     {**
     @explan(说明)窗口样式改变消息 %%

funcext/tvclib/utslvclgrid.tsf

@@ -69,6 +69,12 @@ type TcustomGridCtl = class(tcustomscrollcontrol)  //
 //    end
     function GetPreferredSize(w,h);override;
     begin
+        if csDesigning in ComponentState then 
+        begin
+            w := 250;
+            h := 150;
+            return ;
+        end
         if ongetpreferredsize then return inherited;
         w := Width;
         h := Height;    
@@ -822,7 +828,7 @@ type TcustomGridCtl = class(tcustomscrollcontrol)  //
     begin
         if fonhitcellsizer then 
         begin 
-            e := new tuieventbase(0,r,i,0);
+            e := new triddragsize(0,r,i,0);
             CallMessgeFunction(fonhitcellsizer,self(true),e);
             return e.skip;
         end         
@@ -1175,11 +1181,47 @@ type tgriddrawcellevent = class(tuieventbase)
         rec := rc;   
         canvas := cvs; 
     end 
+    function expandinfo();override;
+    begin
+        r := array();
+        idx := 0;
+        r[idx++] := array("name":"canvas","alias":"cvs","type":"tcanvas");
+        r[idx++] := array("name":"row","alias":"rowidx","type":"integer");
+        r[idx++] := array("name":"col","alias":"colidx","type":"integer");
+        r[idx++] := array("name":"rec","alias":"arec");
+        return r;
+    end 
     row;
     col;
     rec;
     canvas;
-end 
+end
+type triddragsize=class(tuieventbase)
+    function create(a,b,c,d);
+    begin
+        inherited;
+    end
+    function expandinfo();override;
+    begin
+        r := array();
+        i := 0;
+        r[i++] := array("name":"idx","alias":"idx","type":"integer");
+        r[i++] := array("name":"r_or_c","alias":"r_or_c","type":"integer");
+        r[i++] := array("name":"skip","alias":"stopact","type":"bool","var":true);
+        return r;
+    end 
+    property idx read getidx;
+    property r_or_c read getrc;
+    private 
+    function getidx();
+    begin
+        return lparam;
+    end 
+    function getrc();
+    begin
+        return wparam;
+    end     
+end  
 implementation
 type TPAINTCOUNT=class()//»æÖƱê¼Ç
     function create(v);

funcext/tvclib/utslvclmemstruct.tsf

@@ -1501,6 +1501,29 @@ type TMONITORINFO=class(tslcstructureobj)
     property rcwork index "rcwork" read _getvalue_ write _setvalue_;
     property dwflags index "dwflags" read _getvalue_ write _setvalue_;
 end
+type tagTRACKMOUSEEVENT=class(tslcstructureobj)
+    private
+    static SSTRUCT;
+    class function getstruct()
+    begin
+        if not SSTRUCT then SSTRUCT := MemoryAlignmentCalculate(array(
+                ("cbsize","int",0),
+                ("dwflags","int",0),
+                ("hwndtrack","pointer",),
+                ("dwhovertime","int",200)));
+        return SSTRUCT;
+    end
+    public
+    function create(ptr)
+    begin
+        inherited create(getstruct(),ptr);
+        cbsize := _size_();
+    end
+    property cbsize index "cbsize" read _getvalue_ write _setvalue_;
+    property dwFlags index "dwflags" read _getvalue_ write _setvalue_;
+    property hwndtrack index "hwndtrack" read _getvalue_ write _setvalue_;
+    property dwhovertime index "dwhovertime" read _getvalue_ write _setvalue_;
+end
 implementation
 (*
 

funcext/tvclib/utslvclpage.tsf

@@ -1,4 +1,5 @@
 unit utslvclpage;
+/////////20250710 tab控件添加inert_tab方法//////////////////////////////////
 interface
 uses utslvclauxiliary,utslvclbase,utslvclgdi;
 type tcustomtabsheet = class(TCustomControl) //控件页面
@@ -71,15 +72,13 @@ type tcustomtabcontrol = class(TCustomControl)
         begin
             if FCurrentid<>-1 and fOnSelChanging then 
             begin 
-                e := new tuieventbase(0,FCurrentid,id,0); //m,w,l,h
+                e := new tmtabselchanging(0,FCurrentid,id,0); //m,w,l,h
                 doonSelChanging(self(true),e);
                 if e.skip then return ;
             end    
             FPrevid := FCurrentid;
             FCurrentid := id; 
             InsureIdxVisible(id);          
-            //InvalidateRect(nil,false);
-            //DoControlAlign();  
             DoControlAlign();          
             if FOnSelChanged then 
             begin
@@ -92,43 +91,6 @@ type tcustomtabcontrol = class(TCustomControl)
             FCurrentid := -1;   
         end 
     end 
-    function RemovePageTab(id);//移除sheet
-    begin
-        if not(id>=0) then return ;
-        FTabItems.splice(id,1);
-        if id = FCurrentid then 
-        begin
-            if id = 0 then 
-            begin
-                if FTabItems.length()=0 then 
-                begin
-                    FCurrentid := -1;   
-                    FPrevid := -1;     
-                end 
-            end 
-            FCurrentid := -1; 
-            FPrevid := -1;  
-            cid := min(max(0,id-1),FTabItems.length()-1);
-            if cid >=0 then 
-            begin
-                return setselidx(cid); 
-            end else 
-            begin
-                if FOnSelChanged then 
-                begin
-                    doonSelChange(self(true),new tuieventbase(0,-1,-1,0));
-                end 
-            end     
-        end else 
-        if id<FCurrentid then 
-        begin
-            FCurrentid--;    
-        end 
-        FPrevid := -1; 
-        DoControlAlign();
-        //CalcTabs();
-        //InvalidateRect(nil,false);                    
-    end
     function CreateTableItem(cp);
     begin
         r := new tcustomtabitem();
@@ -148,7 +110,7 @@ type tcustomtabcontrol = class(TCustomControl)
             FTabHeight := fh+8;     
         end         
         FTabItemswidth := array();
-        e := new tuieventbase(0,0,0,0);
+        e := new tmtabmeasure(0,-1);
         for i := 0 to FTabItems.length()-1 do 
         begin
             pg := FTabItems[i];
@@ -400,7 +362,6 @@ type tcustomtabcontrol = class(TCustomControl)
         begin            
             FirstViewIndex-- ;
             DoControlAlign();//CalcTabs();
-            //InvalidateRect(nil,false);
         end         
     end 
     function scrollnext(); //滚动到上一个
@@ -419,8 +380,6 @@ type tcustomtabcontrol = class(TCustomControl)
                 end             
             end ;            
             FirstViewIndex++ ;
-            //CalcTabs();
-            //InvalidateRect(nil,false);
             DoControlAlign();
         end             
     end
@@ -619,7 +578,6 @@ type tcustomtabcontrol = class(TCustomControl)
         begin
             it.Caption := Value;
             DoControlAlign();
-            //InvalidateRect(nil,false);
         end 
     end 
     function SetTabIndex(AIndex,AIndexnew);
@@ -646,6 +604,59 @@ type tcustomtabcontrol = class(TCustomControl)
             //InvalidateRect(nil,false);            
         end 
     end 
+    function remove_tab_byidx(id);virtual;//移除tab
+    begin
+    {**
+        @explan(说明) 移除标签 %%      
+        @param(idx)(integer) 序号 %%
+    **}
+        if not(id>=0 and id<FTabItems.length()) then return ;
+        FTabItems.splice(id,1);
+        if id = FCurrentid then 
+        begin
+            if id = 0 then 
+            begin
+                if FTabItems.length()=0 then 
+                begin
+                    FCurrentid := -1;   
+                    FPrevid := -1;     
+                end 
+            end 
+            FCurrentid := -1; 
+            FPrevid := -1;  
+            cid := min(max(0,id-1),FTabItems.length()-1);
+            if cid >=0 then 
+            begin
+                return setselidx(cid); 
+            end else 
+            begin
+                if FOnSelChanged then 
+                begin
+                    doonSelChange(self(true),new tuieventbase(0,-1,-1,0));
+                end 
+            end     
+        end else 
+        if id<FCurrentid then 
+        begin
+            FCurrentid--;    
+        end 
+        FPrevid := -1; 
+        DoControlAlign();                  
+    end
+    function insert_tab(c,idx);virtual; //插入tab
+    begin
+    {**
+        @explan(说明) 插入标签 %%      
+        @param(c)(string) 标签 %%
+        @param(idx)(integer) 位置,默认为尾部 %%
+    **}
+        if not ifstring(c) then return 0;
+        cp := CreateTableItem(c);
+        if idx>=0 or idx<0 then FTabItems.splice(integer(idx),0,cp);
+        else FTabItems.Push(cp);
+        DoControlAlign(); 
+        return 1;
+    end 
     function Recycling();override;
     begin	
         FOnSelChanged := nil;
@@ -656,7 +667,7 @@ type tcustomtabcontrol = class(TCustomControl)
     		{**
     			@param(cursel)(integer) 当前选中序号 %%
     			@param(TabCount)(integer) page数量 %%
-    			@param(OnSelChange)(function[tcustompagecontrol,tuieventbase]) 标签已经切换 %%
+    			@param(OnSelChanged)(function[tcustompagecontrol,tuieventbase]) 标签已经切换 %%
     			@param(OnSelChanging)(function[tcustompagecontrol,tuieventbase]) 标签正在切换 %%
     			@param(Onrclcik)(function[tcustompagecontrol,tuieventbase]) 右键点击 %%
     		**}
@@ -790,6 +801,11 @@ type tcustompagecontrol = class(tcustomtabcontrol)
             if not (page is class(TWinControl)) then CalcTabs();
             InvalidateRect(nil,false);
         end 
+    end 
+    protected
+    function remove_tab_byidx(id);override;
+    begin
+        return inherited;
     end   
     public
     function GetPreferredSize(w,h);override;
@@ -837,7 +853,7 @@ type tcustompagecontrol = class(tcustomtabcontrol)
     begin
         if not isacceptsheettype(AControl){ not(AControl is class(tcustomtabsheet))} then return;
         id := GetPageID(AControl);
-        RemovePageTab(id);
+        remove_tab_byidx(id);
         //fcoolbands.deleteitem(AControl,true);       
     end
     Function SetCurSel(id);override; //设置当前序号
@@ -946,6 +962,10 @@ type tcustompagecontrol = class(tcustomtabcontrol)
     tabs;
     faccepttype;
     private 
+    function insert_tab(c,idx);override; //插入tab
+    begin
+    
+    end 
     function isacceptsheettype(c);
     begin
         for i,v in faccepttype do 
@@ -953,6 +973,64 @@ type tcustompagecontrol = class(tcustomtabcontrol)
             if c is v then return true;
         end 
     end   
+end
+type tmtabselchanging =  class(tuieventbase) //改变
+    function create(m,w,l,h);
+    begin
+        inherited;
+    end 
+    function expandinfo();override;
+    begin
+        r := array();
+        r[0] := array("name":"lparam","alias":"nselidx","type":"integer");
+        r[1] := array("name":"skip","alias":"stopchange","type":"bool","var":true);
+        return r;
+    end 
+end 
+type tmtabmeasure = class(tuieventbase)
+    function create(i,w);
+    begin
+        inherited create(nil,w,i,0);
+    end 
+    function expandinfo();override;
+    begin
+        r := array();
+        r[0] := array("name":"idx","alias":"idx","type":"integer");
+        r[1] := array("name":"width","alias":"wid","type":"integer","var":true);
+        return r;
+    end 
+    property idx read wparam ; //序号
+    property width read lparam write lparam;//宽度
+end 
+type teventdrawtab = class(tuieventbase)
+{**
+    @explan(说明)绘制消息对象 %%
+    @param(idx)(integer) 序号 %%
+    @param(sel)(integer) 是否选中 %%
+    @param(rec)(array(左上右下)) 区域 %%
+    @param(canvas)(TCanvas) 画布 %%
+**}
+    function create(id,s,rc,cvs);
+    begin
+        inherited create(0,0,0,0);
+        idx := id;
+        sel := s;
+        rec := rc;   
+        canvas := cvs; 
+    end
+    function expandinfo();override;
+    begin
+        r := array();
+        i := 0;
+        r[i++] := array("name":"canvas","alias":"cvs","type":"tcanvas");
+        r[i++] := array("name":"idx","alias":"idx","type":"integer");
+        r[i++] := array("name":"rec","alias":"arec","type":"array of integer");
+        return r;
+    end  
+    idx;
+    sel;
+    rec;
+    canvas;
 end 
 implementation
 type tcustomtabitem = class() //
@@ -990,27 +1068,6 @@ type tcustomtabitem = class() //
     property PageSheet read FPageSheet Write FPageSheet;
     _tag;
 end 
-type teventdrawtab = class(tuieventbase)
-{**
-    @explan(说明)单元格绘制消息对象 %%
-    @param(idx)(integer) 序号 %%
-    @param(sel)(integer) 是否选中 %%
-    @param(rec)(array(左上右下)) 区域 %%
-    @param(canvas)(TCanvas) 画布 %%
-**}
-    function create(id,s,rc,cvs);
-    begin
-        inherited create(0,0,0,0);
-        idx := id;
-        sel := s;
-        rec := rc;   
-        canvas := cvs; 
-    end 
-    idx;
-    sel;
-    rec;
-    canvas;
-end 
 initialization
 
 end.

funcext/tvclib/utslvclstdctl.tsf

@@ -502,7 +502,7 @@ type tcustombtn = class(TCustomControl) //
             3:    df := DT_RIGHT
             4:    df := DT_LEFT .| DT_VCENTER;   
             6:    df := DT_RIGHT .| DT_VCENTER;
-            7:    d := DT_BOTTOM .| DT_LEFT;
+            7:    df := DT_BOTTOM .| DT_LEFT;
             8:    df := DT_BOTTOM .|DT_CENTER;
             9:    df := DT_BOTTOM .| DT_RIGHT;
             else 
@@ -530,12 +530,46 @@ type tcustombtn = class(TCustomControl) //
     end 
     function GetPreferredSize(w,h);override;
     begin
-        class(tcontrol).GetPreferredSize(w,h);
+        if iffuncptr(onGetPreferredSize) then return class(tcontrol).GetPreferredSize(w,h); //               
-        if ongetpreferredsize then return ;
         bs := BoundsRect;
         cs := ClientRect;
-        dh := (bs[3]-bs[1])-(cs[3]-cs[1])+2;
+        dh := (bs[3]-bs[1])-(cs[3]-cs[1])+2; 
-        h+=dh;
+        dw := (bs[2]-bs[0])-(cs[2]-cs[0]);        
+        c := caption;lc := length(c);
+        ft := font;
+        fw := ft.Width;
+        fh := ft.Height;
+        if FtextPosition=0 then 
+        begin 
+            w := fw*(lc+2);
+            h := fh+4;          
+        end else 
+        begin
+            rs := 1;
+            mlen := 0;
+            mmlen := 0;
+            for i := 1 to lc do 
+            begin
+                ci := c[i];
+                case ci of 
+                    "\r":
+                    begin
+                        continue;    
+                    end 
+                    "\n":
+                    begin
+                        rs+=1;
+                        mmlen := max(mmlen,mlen);
+                        mlen := -1;
+                    end 
+                end ;
+                mlen++;
+            end 
+            w := fw*(max(mmlen,mlen)+2);
+            h := fh*rs+4;      
+        end         
+        w += dw;
+        h += dh;
     end 
     function FontChanged(o);override; //字体改变
     begin
@@ -624,12 +658,11 @@ type tcustombtn = class(TCustomControl) //
     end 
     function setTextPosition(n);
     begin
-        if not ifnumber(n) or n<0 or n>9 then
+        if not(n>=0 and n<=9) then return ;
-            n:=0;
+        n:=integer(n);
-        else
-            n:=integer(n);
         if FtextPosition=n then return ;
         FtextPosition:=n;
+        AdjustSize();
         InvalidateRect(nil,false);
     end 
     function judgestate(o,e);
@@ -684,7 +717,10 @@ type tcustomcheckbtn=class(tcustombtn) //checkbtn
     function GetPreferredSize(w,h);override;
     begin
         inherited;
-        w+=20+1;
+        //w+=20+1;
+        c := caption;
+        if c then w+=21;
+        else w := 21;
     end 
     published    
     property checked:bool read FcheckState write setChecked;
@@ -2555,6 +2591,7 @@ type TcustomLabel = class(TGraphicControl)
         if v <> FTextAlign then
         begin
             FTextAlign := v;
+            AdjustSize();
             InvalidateRect(nil,true);
         end
     end    
@@ -2578,6 +2615,47 @@ type TcustomLabel = class(TGraphicControl)
             set_Preferre_size();       
         inherited;        
     end
+    function GetPreferredSize(w,h);override;
+    begin
+        if iffuncptr(onGetPreferredSize) then return class(tcontrol).GetPreferredSize(w,h); //                             
+        ft := font;
+        if not ft then return ;
+        fw := ft.Width;
+        fh := ft.Height;
+        c := caption;lc := length(c);
+        if FTextAlign=0 then 
+        begin 
+            w := fw*(lc)+2;
+            h := fh+3;          
+        end else 
+        begin
+            rs := 1;
+            mlen := 0;
+            mmlen := 0;
+            for i := 1 to lc do 
+            begin
+                ci := c[i];
+                case ci of 
+                    "\r":
+                    begin
+                        continue;    
+                    end 
+                    "\n":
+                    begin
+                        rs+=1;
+                        mmlen := max(mmlen,mlen);
+                        mlen := -1;
+                    end 
+                end ;
+                mlen++;
+            end 
+            w := fw*(max(mmlen,mlen))+2;
+            h := fh*rs+3;      
+        end 
+        bd := Border;        
+        w += bd;
+        h += bd;
+    end 
     function FontChanged(o);override;
     begin
         inherited;
@@ -2768,7 +2846,7 @@ type tcustomedit=class(TCustomControl)
     begin
         ft := Font;
         if not ft then return ;
-        if ongetpreferredsize then 
+        if iffuncptr(onGetPreferredSize) then 
         begin
             return class(tcontrol).GetPreferredSize(w,h);
         end 
@@ -2802,16 +2880,13 @@ type tcustomedit=class(TCustomControl)
         inherited;
     end
     function doonmaxtext();
-    begin
+    begin 
-        if FOnMaxText then 
+        CallMessgeFunction(FOnMaxText,self(true));
-            CallMessgeFunction(FOnMaxText,self(true),new tuieventbase(0,0,0,0));
     end
     function DoChanged();
     begin
-        if FOnChange then 
+        CallMessgeFunction(FOnChange,self(true));
-        CallMessgeFunction(FOnChange,self(true),new tuieventbase(0,0,0,0));
+        CallMessgeFunction(FOnUpdate,self(true));
-        if FOnUpdate then 
-        CallMessgeFunction(FOnUpdate,self(true),new tuieventbase(0,0,0,0));
     end
     function FontChanged(sender);override;
     begin
@@ -3479,6 +3554,16 @@ type TCustomListBoxbase=class(TCustomScrollControl)
     begin
         return FItemCount;
     end
+    function GetPreferredSize(w,h);override;
+    begin
+        if csDesigning in ComponentState then 
+        begin
+            w := 250;
+            h := 150;
+            return ;
+        end
+        return inherited;
+    end
     published
     property ItemCount read GetItemCount write SetItemCount;
     property ItemHeight read GetYScrollDelta;
@@ -3530,6 +3615,15 @@ type tlistdrawevent = class(tuieventbase)
         rec := r;
         Canvas := c;        
     end 
+    function expandinfo();override;
+    begin
+        r := array();
+        i := 0;
+        r[i++] := array("name":"canvas","alias":"cvs","type":"tcanvas");
+        r[i++] := array("name":"idx","alias":"idx","type":"integer");
+        r[i++] := array("name":"rec","alias":"ARect","type":"array of integer");
+        return r;
+    end  
     rec;
     idx;
     sel;
@@ -3707,7 +3801,7 @@ type TcustomListBox=class(TCustomListBoxbase)
     end
     function PaintIdexText(idx,rc,cvs);virtual;
     begin
-        if fownerdraw and Fondrawlist then 
+        if fownerdraw and iffuncptr( Fondrawlist) then 
         begin
             e := new tlistdrawevent(idx,rc[4],rc,cvs);
             CallMessgeFunction(Fondrawlist,self(true),e);
@@ -4263,7 +4357,7 @@ type TcustomListBox=class(TCustomListBoxbase)
     end
     function calllistselchengd();
     begin
-        if FselectionChange then CallMessgeFunction(FselectionChange,self(true),new tuieventbase(0,0,0,0));
+        CallMessgeFunction(FselectionChange,self(true));
     end 
     private 
     fselbkcolor;
@@ -4316,7 +4410,7 @@ type TCustomComboBoxbase=class(TCustomControl)
     function GetPreferredSize(w,h);override;
     begin
         class(tcontrol).GetPreferredSize(w,h);
-        if onGetPreferredSize then return ;
+        if iffuncptr(onGetPreferredSize) then return ;
         bs := BoundsRect;
         cs := ClientRect;
         dh := (bs[3]-bs[1])-(cs[3]-cs[1])+2;
@@ -4598,6 +4692,7 @@ type TcustomComboBox=class(TCustomComboBoxbase)
     end
     function DoControlAlign();override;
     begin
+        if not FEdit then return ;
         rc := ClientRect;
         rc[2]-= 20;
         FEdit.SetBoundsRect(rc);
@@ -5153,7 +5248,7 @@ type TcustomToolBar=class(TCustomControl)
     begin    
         ft := Font;
         if not ft then return ;
-        if ongetpreferredsize then return class(tcontrol).GetPreferredSize(w,h);
+        if iffuncptr(onGetPreferredSize) then return class(tcontrol).GetPreferredSize(w,h);
         ftw := ft.Width;
         fth := ft.Height;
         brec := BoundsRect;
@@ -6019,7 +6114,7 @@ type TcustomStatusBar=class(TCustomControl)
     function GetPreferredSize(w,h);override;
     begin
         class(tcontrol).GetPreferredSize(w,h);
-        if ongetpreferredsize then return ;
+        if iffuncptr(onGetPreferredSize) then return ;
         bs := BoundsRect;
         cs := ClientRect;
         dh := (bs[3]-bs[1])-(cs[3]-cs[1])+2;
@@ -6077,6 +6172,7 @@ type TcustomStatusBar=class(TCustomControl)
         {**
         @explan(说明) 设置多个项目 %%
         **}
+        if Fitems=its then return ;
         Fitems := array();
         for i,v in its do
         begin
@@ -6446,7 +6542,7 @@ type TCustomSpinEdit = class(TCustomControl)
     function GetPreferredSize(w,h);override;
     begin
         class(tcontrol).GetPreferredSize(w,h);
-        if ongetpreferredsize then return ;
+        if iffuncptr(onGetPreferredSize) then return ;
         ft := Font;
         if not ft then return ;
         h := ft.Height+4;
@@ -7026,7 +7122,7 @@ type tcustomipaddr = class(TCustomControl)
     end  
     function DoIpChanged();
     begin
-        return CallMessgeFunction(onAddrChange,self(true),new tuieventbase(0,0,0,0));
+        return CallMessgeFunction(FaddrChange,self(true));
     end 
     function cleanAddr();
     begin
@@ -7130,7 +7226,7 @@ type tcustomipaddr = class(TCustomControl)
     begin
         ft := Font;
         if not ft then return ;
-        if ongetpreferredsize then 
+        if iffuncptr(onGetPreferredSize) then 
         begin 
             return class(tcontrol).GetPreferredSize(w,h);
         end
@@ -7676,9 +7772,8 @@ type tcustomtimepicker = class(tthreeEntry)
                     ti := strtointdef(t,0);  
                     if ti<0 then p.text := "24";
                     else if ti>24 then p.text := "0";
-                end  
+                end
-                if Fonselectchange then 
+                CallMessgeFunction(Fonselectchange,self(true));                 
-                    calldatafunction(Fonselectchange,self(true),new tuieventbase(0,0,0,0));                 
             end                         
         end 
     end 
@@ -7846,9 +7941,8 @@ type tcustomdatetimepicker = class(tthreeEntry)
                         ct := getmonthdates(y,m);
                         if d>ct then es[2].text := inttostr(ct);
                     end                     
-                end  
+                end 
-                if Fonselectchange then 
+                CallMessgeFunction(Fonselectchange,self(true)) ;       
-                    calldatafunction(Fonselectchange,self(true),new tuieventbase(0,0,0,0));           
             end  
             "dtadate":
             begin
@@ -7860,18 +7954,15 @@ type tcustomdatetimepicker = class(tthreeEntry)
                     es[0].text := inttostr(y);    
                     es[1].text := inttostr(m);    
                     es[2].text := inttostr(d); 
-                    if Fonselectchange then   
+                    CallMessgeFunction(Fonselectchange,self(true));             
-                        calldatafunction(Fonselectchange,self(true),new tuieventbase(0,0,0,0));               
                 end else 
                 begin
                     y := strtointdef(es[0].text,2021);        
                     m := strtointdef(es[1].text,1);        
                     d := strtointdef(es[2].text,1);  
                     return array(y,m,d);      
-                end 
+                end             
-            
+            end                        
-            end                
-        
         end 
     end 
     function ShowDropDown(f);virtual;
@@ -7985,8 +8076,7 @@ type tcustommonthcalendar = class(TCustomControl)
             r := FCalender.ExecuteCommand("meselbypos",e.pos);  
             if std=3 or  r="today" then 
             begin
-                if FonSelect then 
+                CallMessgeFunction(FonSelect,self(true));
-                    CallMessgeFunction(FonSelect,self(true),new tuieventbase(0,0,0,0));
             end           
         end 
     end 
@@ -8034,8 +8124,7 @@ type tcustommonthcalendar = class(TCustomControl)
 		  end 
     function DoDatechanged();
     begin
-        if FonSelectChange then 
+        CallMessgeFunction(FonSelectChange,self(true));
-            CallMessgeFunction(FonSelectChange,self(true),new tuieventbase(0,0,0,0));
     end 
     function recycling();override;
     begin

funcext/tvclib/utslvcltree.tsf

@@ -114,8 +114,8 @@ type ttreelistwnd = class(TCustomScrollControl)
         FItemHeight := font.height+2;
         FxClientMax := fColWidth;
         FItemMinWidth := FxClientMax;     
-        height := 400;
+        height := 150;
-        width := 300;        
+        width := 250;        
         border := true;
         autoscroll := 3;
         ThumbTrack := true;
@@ -453,6 +453,16 @@ type ttreelistwnd = class(TCustomScrollControl)
         end
         return r;
     end
+    function GetPreferredSize(w,h);override;
+    begin
+        if csDesigning in ComponentState then 
+        begin
+            w := 250;
+            h := 150;
+            return ;
+        end
+        return inherited;
+    end
     published   //属性
     property Items read GetItems;       
     property ItemCount read GetItemCount;
@@ -574,23 +584,65 @@ type ttreelistwnd = class(TCustomScrollControl)
     end
     
 end
-type TTreeSelCHngedEvent=class(tuieventbase)
+type tm_nodeseling=class(tuieventbase)
     {**
-    @explan(说明) 导航选择改变消息%%
+    @explan(说明) 节点选择正在改变%%
     **}
-    function create(m,w,l,h);override;
+    function create(m,ito,itn,h);override;
     begin
-        inherited;
+        ItemOld := ito;
+        ItemNew := itn;
+        item := itn;        
+    end
+    function expandinfo();override;
+    begin
+        r := array();
+        i := 0;
+        r[i++] := array("name":"itemold","alias":"node","type":"tcustomtreectlnode");
+        r[i++] := array("name":"itemnew","alias":"nselnode","type":"tcustomtreectlnode");
+        r[i++] := array("name":"skip","alias":"stopchang","type":"bool","var":true);
+        return r; 
+    end 
+    ItemOld;
+    ItemNew;
+    Item;    
+end
+type tm_nodeseled=class(tm_nodeseling)
+    {**
+    @explan(说明) 节点选择成功改变%%
+    **}
+    function create(m,ito,itn,h);override;
+    begin
+        ItemOld := ito;
+        ItemNew := itn;
+        item := itn;        
+    end
+    function expandinfo();override;
+    begin
+        r := inherited;
+        r := r[0:length(r)-2];
+        return r;
     end
     ItemOld;
     ItemNew;
-    Item;
+    Item;    
+end 
+type tm_nodechang = class(tuieventbase)
     {**
-        @param(ItemOld)(TcustomTreeCtlNode) 旧的节点  %%
+        @explan(说明) 节点改变消息%%
-        @param(ItemNew)(TcustomTreeCtlNode) 新节点  %%
-        @param(Item)(TcustomTreeCtlNode) 当前节点  %%
     **}
-end
+    function create(m,w,l,h);
+    begin
+        Item := w; 
+    end 
+    function expandinfo();override;
+    begin
+        r := array();
+        r[0] := array("name":"Item","alias":"node","type":"tcustomtreectlnode");
+        return r; 
+    end 
+    Item;
+end 
 type TcustomTreeCtlNode = class(tsluibase) //树结点
     {**
     @explan(说明) 树结点 %%
@@ -1617,10 +1669,7 @@ type TcustomTreeCtl = class(ttreelistwnd)
                 begin
                     if FonEmptyNodeExapanding then 
                     begin 
-                        e := new TTreeSelCHngedEvent(0,0,0,0);
+                        e := new tm_nodechang(0,pm,0,0);
-                        e.item := pm;
-                        e.ItemNew := pm;
-                        e.ItemOld := pm;
                         CallMessgeFunction(FonEmptyNodeExapanding,self(true),e);
                     end 
                 end 
@@ -1832,6 +1881,16 @@ type TcustomTreeCtl = class(ttreelistwnd)
         dc.pen.color := rgb(171,173,179);
         dc.draw("polyline",ls);
     end
+    function GetPreferredSize(w,h);override;
+    begin
+        if csDesigning in ComponentState then 
+        begin
+            w := 100;
+            h := 125;
+            return ;
+        end
+        return inherited;
+    end
     published //属性
     property CurrentNode read FCurrentNode write setcurrentnode; //20221118 加上写
     property selectionColor:color read FselectionColor write SetselectionColor;
@@ -1970,12 +2029,14 @@ type TcustomTreeCtl = class(ttreelistwnd)
             t1 := FCurrentNode;
             //if t1 then InvalidateItem(t1,false);
             //InvalidateItem(it,false);
-            ne := new TTreeSelCHngedEvent(0,0,0,0);
+            //ne := new TTreeSelCHngedEvent(0,0,0,0);
-            ne.ItemOld := t1;
+            //ne.ItemOld := t1;
-            ne.ItemNew := it;
+            //ne.ItemNew := it;
-            ne.Item := it;
+            //ne.Item := it;
+            ne := new tm_nodeseling(nil,t1,it);
             CallMessgeFunction(FOnSelChanging,self(true),ne);
             if ne.Skip then return true;
+            ne := new tm_nodeseled(nil,t1,it);
             FCurrentNode := it;
             CallMessgeFunction(FOnSelChanged,self(true),ne);
         end

funcext/tvclib/utvclgraphics.tsf

@@ -207,7 +207,7 @@ app :=  initializeapplication();
 app.createform(class(tfm),fm);
 fm.show();
 app.run();
-type tfm = class(tvcform)
+type tfm = class(tvcform,tg_const)
     function create(aowner);
     begin
         inherited;
@@ -234,10 +234,10 @@ type tfm = class(tvcform)
         line.lineinfo.color := 0xff0000;
         line.markinfo.bkcolor := 0x00ff00;
         line.markinfo.color := 0x0000ff;
-        line.mark_mode := "on";
+        line.mark_mode := tgc_on;
         line.markinfo.size := 30;
-        line.markinfo.style  := line.tgc_mks_pentagram;
+        line.markinfo.style  := tgc_mks_pentagram;
-        line.polyline_style := line.tgc_LS_staircase;
+        line.polyline_style := tgc_LS_staircase;
         d := array();
         idx := 0;
         for i:= -pi() to pi() step 0.2 do 
@@ -256,7 +256,7 @@ app :=  initializeapplication();
 app.createform(class(tfm),fm);
 fm.show();
 app.run();
-type tfm = class(tvcform)
+type tfm = class(tvcform,tg_const)
     function create(aowner);
     begin
         inherited;
@@ -280,7 +280,7 @@ type tfm = class(tvcform)
         axs.axises(1).lineinfo.color := 0x00ff00;   
         sf := new tg_my_surf();
         sf.lineinfo.color := 0x0000ff;
-        sf.lineinfo.style := sf.tgc_BS_SOLID;
+        sf.lineinfo.style := tgc_BS_SOLID;
         sf.graph_data := get_surf_data();
         sf.parent := axs; 
         return ;    
@@ -388,7 +388,7 @@ app :=  initializeapplication();
 app.createform(class(tfm),fm);
 fm.show();
 app.run();
-type tfm = class(tvcform)
+type tfm = class(tvcform,tg_const)
     function create(aowner);
     begin
         inherited;
@@ -402,7 +402,7 @@ type tfm = class(tvcform)
         //////////设置坐标轴属性////////////////////////
         axs := new tg_axes();
         axs.box := true;
-        axs.figure := fg.figure;
+        axs.figure := fg;
         axs.title.text := "hello pie ";
         axs.axises(1).tics_color := 0x0000ff;
         axs.axises(1).fontinfo.size := 8;
@@ -421,7 +421,7 @@ type tfm = class(tvcform)
         for i,v in args do 
         begin
             line := new tg_Polyline();
-            line.polyline_style := line.tgc_LS_filled;
+            line.polyline_style := tgc_LS_filled;
             line.closed := true;
             c := (i=2)?1.1:1;
             line.graph_data := 1+get_pie_lines(v[0],v[1],i=prominentidx,prominentrate);
@@ -459,7 +459,7 @@ app :=  initializeapplication();
 app.createform(class(tfm),fm);
 fm.show();
 app.run();
-type tfm = class(tvcform)    
+type tfm = class(tvcform,tg_const)    
     function create(aowner);
     begin
         inherited;
@@ -504,7 +504,7 @@ type tfm = class(tvcform)
         gtx.text := array("按住鼠标左键","移动我");
         gtx.data := array(0.3,0.2);
         //处理鼠标按下
-        gtx.addEventListener("mouse_down",function(e)begin
+        gtx.addEventListener(evt_mouse_down,function(e)begin
             fdragtext := e.target;
             ftextinitpos := fdragtext.data;
             x := e.cvsx;y := e.cvsy;
@@ -512,7 +512,7 @@ type tfm = class(tvcform)
             fmousedownpos := array(x1,y1);
         end);
         //移动标签
-        fg.addEventListener("mouse_move",function(e)begin
+        fg.addEventListener(evt_mouse_move,function(e)begin
             if fdragtext then 
             begin 
                 e.stoppropagation();
@@ -524,7 +524,7 @@ type tfm = class(tvcform)
             end 
         end ,true);
         //处理鼠标松开
-        fg.addEventListener("mouse_up",function(e)begin
+        fg.addEventListener(evt_mouse_up,function(e)begin
             if fdragtext then  
             begin
                 e.stoppropagation();
@@ -548,12 +548,12 @@ type tfm = class(tvcform)
             fhitidx := r;
             return r>=0;
         end
-        line.addEventListener("mouse_out",function(e)begin
+        line.addEventListener(evt_mouse_out,function(e)begin
             if e.eventPhase<>2 then return ;
             fmovetip.Visible := false;
             e.stoppropagation();
         end,true); 
-        line.addEventListener("mouse_move",function(e)
+        line.addEventListener(evt_mouse_move,function(e)
                     begin 
                         if e.eventPhase<>2 then return ;
                         e.stoppropagation(); 
@@ -638,18 +638,24 @@ end }
 type tg_WinControl = class(tcustomcontrol,tg_figure_container) //绘图窗口
     function create(AOwner);
     begin
+        if not(s_flush_interval>9) then 
+        begin
+            s_flush_interval := 150;
+            ftgwindows := array();
+        end 
         class(tcustomcontrol).create(AOwner);
         width := 300;
         height := 300;
         class(tg_figure_container).create();
         fg_timer := new unit(utslvclstdctl).tcustomtimer(self);
-        fg_timer.Interval := 300;
+        fg_timer.Interval := s_flush_interval;
         fg_timer.Ontimer := thisfunction(figure_need_fresh);
         ffigureprepared := false;
         ffigure.rec_getter := function()begin
             return clientrect;
         end 
         ffigure.fresh_caller := thisfunction(flushfigure);
+        ftgwindows[length(ftgwindows)] := makeweakref(self(true));
     end 
     function flushfigure();
     begin
@@ -692,10 +698,35 @@ type tg_WinControl = class(tcustomcontrol,tg_figure_container) //
         if ffigure then 
         begin 
             d := e_2_array(e,evt_mouse_down);
-            if ffigure.executecommand(evt_mouse_down,d)=1 then e.skip := true;   
+            if ffigure.executecommand(evt_mouse_down,d)=1 then e.skip := true;  
+            SetFocus(); 
         end
         //echo "\r\n",functionname(),tostn(array(xy,bt,sh));
     end 
+    function KeyDown(o,e);override;
+    begin
+        if ffigure then 
+        begin 
+            d := ek_2_array(e,evt_key_down);
+            if ffigure.executecommand(evt_key_down,d)=1 then e.skip := true;   
+        end
+    end 
+    function keyup(o,e);override;
+    begin
+        if ffigure then 
+        begin 
+            d := ek_2_array(e,evt_key_up);
+            if ffigure.executecommand(evt_key_up,d)=1 then e.skip := true;   
+        end
+    end 
+    function keypress(o,e);override;
+    begin
+        if ffigure then 
+        begin 
+            d := ek_2_array(e,evt_key_press);
+            if ffigure.executecommand(evt_key_press,d)=1 then e.skip := true;   
+        end
+    end 
     function MouseMove(o,e);override;
     begin
         if ffigure then 
@@ -729,16 +760,58 @@ type tg_WinControl = class(tcustomcontrol,tg_figure_container) //
     function Recycling();override;
     begin
         ffigure:=nil;
+        for i := 0 to length(ftgwindows)-1 do 
+        begin
+            if ftgwindows[i] =self then 
+            begin
+                deleteindex(ftgwindows,i);
+                break;
+            end 
+        end 
         inherited;
     end 
+    class function set_sys_flush_interal(itv); //设置所有窗口的刷新间隔
+    begin
+        if itv>9 and itv<>s_flush_interval then 
+        begin 
+            s_flush_interval := itv;
+            for i,v in ftgwindows do 
+            begin
+                v.flash_interval := itv;    
+            end 
+        end 
+    end 
+    property flush_interval read get_interval write set_interval;  //当前窗口的刷新间隔
     private 
+    function get_interval();
+    begin
+        return fg_timer.Interval;
+    end 
+    function set_interval(itv);
+    begin
+        return fg_timer.Interval := itv;
+    end 
     function figure_need_fresh(o,e); //定时刷新
     begin          
         o.stop();
         if not ffigureprepared then return ; //没有准备好  
         if f_validate_doing then return;      
-        InvalidateRect(nil,false);   
+        InvalidateRect(nil,false);                          
-                       
+    end 
+    function ek_2_array(e,tp);
+    begin
+        d := array();
+        st := e.shiftstate();
+        sft := 0x0 in st;
+        sctl := 0x2 in st;
+        d := array(
+                "type":tp,
+                "shift":sft,
+                "ctrl":sctl,
+                "key":e.char,
+                "keycode":e.CharCode,
+                );
+        return d;
     end 
     function e_2_array(e,tp);
     begin
@@ -757,6 +830,8 @@ type tg_WinControl = class(tcustomcontrol,tg_figure_container) //
         return d;
     end 
     private
+    static s_flush_interval;
+    static ftgwindows;
     fmovecnt; 
     fg_timer;
     f_validate_doing;
@@ -790,6 +865,18 @@ type tg_figure = class(tg_evet_conainter)   //
     function executecommand(cmd,p);
     begin
         case cmd of
+            evt_key_down:
+            begin
+                return cmd_key_event(evt_key_down,p);    
+            end 
+            evt_key_up:
+            begin
+                return cmd_key_event(evt_key_up,p); 
+            end
+            evt_key_press:
+            begin
+                return cmd_key_event(evt_key_press,p); 
+            end 
             "figure_need_fresh":
             begin
                 fresh();      
@@ -950,7 +1037,24 @@ type tg_figure = class(tg_evet_conainter)   //
             r[len-i] := v;
         end 
         return r;
-    end     
+    end 
+    function cmd_key_event(evtname,p) ;
+    begin
+        if not fMouseOnOBJ then return ;
+        d := p;
+        d["istrusted"] := true;
+        d["bubbles"] := true;
+        onds := array();
+        nnd := fMouseOnOBJ;
+        while  nnd do 
+        begin
+            onds[length(onds)] := nnd;
+            nnd := nnd.parent;
+        end  
+        evt := new tg_evt_key(evtname,d);
+        dispatchEvent(evt,onds);
+        return evt.stoppropagationed or evt.defaultPrevented; //是否停止
+    end    
     function cmd_mouse_event(evtname,p);
     begin
         d := p;        
@@ -987,7 +1091,8 @@ type tg_figure = class(tg_evet_conainter)   //
                         end 
                         fMouseOnOBJ := ninnode;
                         evt := new tg_evt_mouse(evt_mouse_in,d); //处理mouse in 
-                        dispatchEvent(evt,nds);  
+                        dispatchEvent(evt,nds);
+                        return true;  
                     end    
                 end else 
                 begin
@@ -1176,6 +1281,7 @@ type tg_axes = class(tg_base) //
         cvs.axesrec := r;
         cvs.axesvector := get_top_outer_points();
         //paint(cvs);
+        cvs.executecommand("painter",self(true));
         paint_grid(cvs); 
         inherited;
         cvs.axesunclip(); 
@@ -2351,7 +2457,11 @@ type tg_canvas = class(TcustomCanvas) //
         ffigurergn.rect := fg.rect();
         faxesrgntemp := new TRGNPOLY();//new TRGNRECT(); 
         //ffigurergn.
-    end  
+    end
+    function executecommand(cmd,p);override;
+    begin
+        if cmd ="painter" then fpainter := p;
+    end   
     function axesclip(); //裁剪坐标系范围
     begin 
         if faxesrgn then 
@@ -2386,6 +2496,23 @@ type tg_canvas = class(TcustomCanvas) //
     property figure:tg_figure read ffigure;      //绘制区域 
     property axesvector read faxesvector write set_clip_vector; //坐标系区域
     property axesrec read FaxesRec write set_clip_rect; //坐标系矩形区域
+    property painter read fpainter;
+    ////////////绘制相关//////////////////////////////////////////////
+    function tg_movto(x,y,z);//移动
+    begin
+        if not fpainter then return ;
+        if fpainter.zoom_to_xyz(x,y,z,x0,y0) then return moveto(x0,y0);    
+    end
+    function tg_lineto(x,y,z);//画线
+    begin
+        if not fpainter then return ;
+        if fpainter.zoom_to_xyz(x,y,z,x0,y0) then return lineto(x0,y0);
+    end 
+    function tg_trans(a,x,y,z);//旋转
+    begin
+        if not fpainter then return ;
+        if fpainter.zoom_to_xyz(x,y,z,x0,y0) then return trans(a,x0,y0);
+    end  
     private 
     FaxesRec;
     faxesvector;
@@ -2395,6 +2522,7 @@ type tg_canvas = class(TcustomCanvas) //
     faxesrgntemp;
     ffigurerect;
     [weakref]ffigure;
+    [weakref]fpainter;
     private 
     function set_clip_rect(rec);
     begin 
@@ -3076,12 +3204,12 @@ type tg_text = class(tg_base)
         if not zoom_to_xyz(fdata[0],fdata[1],fdata[2],x,y) then return ;
         if clip_state=tgc_on or ((p:=parent) and p.clip_state=tgc_on) then 
         begin
-            bx := axes.zoom_box; 
+            {bx := axes.zoom_box; 
             vj := fdata; 
             if vj[0]<bx[0,0] or vj[1]<bx[1,0] or vj[2]<bx[2,0] or vj[0]>bx[0,1] or vj[1]>bx[1,1] or vj[2]>bx[2,1] then 
             begin 
                 return ;
-            end           
+            end  }         
             cvs.axesclip();
         end 
         else cvs.axesunclip();
@@ -4393,7 +4521,8 @@ type tg_base = class(TNode,tg_evet_conainter) //
             
     end 
     function paint_pre(cvs);virtual;
-    begin        
+    begin 
+        cvs.executecommand("painter",self(true));       
         paint(cvs);
         lgns := array();
         for i := 0 to NodeCount-1 do 
@@ -4697,6 +4826,9 @@ type tg_const = class()
     //static const tgc_out_lower_right = "out_lower_right";
     //static const tgc_out_lower_left = "out_lower_left";
     //////////////
+    static evt_key_down = "key_down";
+    static evt_key_up = "key_up";
+    static evt_key_press = "key_press";    
     static evt_mouse_down = "mouse_down";
     static evt_mouse_wheel = "mouse_wheel";
     static evt_mouse_move = "mouse_move";
@@ -4804,8 +4936,8 @@ type tg_evt_mouse = class(tg_evt_custom) //
             fdouble := pms["double"];
             fbutton := pms["button"];
             fshift := pms["shift"];
-            fctl := pms["ctrl"];
+            fctrl := pms["ctrl"];
-            fctl := pms["fdelta"];
+            fdelta := pms["fdelta"];
         end 
     end
     property cvsx read fcvsx;
@@ -4825,6 +4957,28 @@ type tg_evt_mouse = class(tg_evt_custom) //
     fctrl;
     fbutton;
 end 
+type tg_evt_key = class(tg_evt_custom) //key消息
+    function create(etyp,pms);
+    begin
+        inherited;
+        if ifarray(pms) then 
+        begin        
+            fshift := pms["shift"];
+            fctrl := pms["ctrl"];
+            fkey := pms["key"];
+            fkeycode := pms["keycode"];
+        end 
+    end
+    property key read fkey;
+    property shift read fshift;        
+    property ctrl read fctrl;
+    property keycode read fkeycode;
+    private 
+    fshift;
+    fctrl;
+    fkey;
+    fkeycode;
+end
 
 implementation
 ///////////事件存储对象///////////////////////

funcext/tvclib/uvclthreadworker.tsf

@@ -172,7 +172,7 @@ type t_worker_host = class(t_worker_base)
     {**
     			@param(OnMessage)(function[TThreadWorker,data]) 消息回调 %%
     			@param(OnStart)(function[TThreadWorker]) 子线程启动 %%
-    			@param(OnError)(function[TThreadWorker,d]) 子线程启动 %%
+    			@param(OnError)(function[TThreadWorker,d]) 子线程运行错误%%
     		**}
     function terminate();override;
     begin
@@ -576,6 +576,7 @@ begin
 end 
 function iffuncptr(fn);
 begin
+    return datatype(fn) in array(7,37);
     //return datatype(fn)=7;
     return ifobj(fn);
 end 

funcext/tvclib/uvcpropertytypespersistence.tsf

@@ -6,65 +6,39 @@ uses utslvclauxiliary;//,utslvclgdi;
 **}
 ////////////tmf文件相关//////////////////////////////////////////////
 	/////////////tmf字符串解析///////////////////////
-function RegComponentPropertyType(vc);
+function RegComponentPropertyType(vc); 
 function GetComponentPropertyType(n);
 type TTmfParserbase = class
     {**
     @explan(说明) 解析基类,提供基础类型,提供类型常量 
     				目前使用的常量有 TT_NUM,TT_BIN,TT_STR,TT_SYM%%
     **}
-    Static Fsok;
+    static const TT_NUM = 1; //数字
-    static TT_NUM;//数字
+    static const TT_LLB = 2; //大括号 
-    static TT_LLB;//大括号 
+    static const TT_RLB = 3; //大括号 
-    static TT_RLB;//大括号 
+    static const TT_LSB = 4; //(
-    static TT_LSB; //(
+    static const TT_RSB = 5; //)
-    static TT_RSB; //)
+    static const TT_STR = 6; //字符串 
-    static TT_STR;//字符串 
+    static const TT_SYM = 7; //符号  
-    static TT_SYM;//符号  
+    static const TT_POI = 8; //点 . 
-    static TT_POI;//点 . 
+    static const TT_SIG = 9; // : + - :< > = 
-    static TT_SIG;// : + - :< > = 
+    static const TT_BNK = 10; //空白 \r \n \t 
-    static TT_BNK;//空白 \r \n \t 	
+    static const TT_ITEM = 11;
-    static TT_ITEM;
+    static const TT_LMB = 12;
-    static TT_RMB;
+    static const TT_RMB = 13;
-    static TT_LMB;
+    static const TT_SET = 14;
-    static TT_SET;
+    static const TT_HASH = 15;
-    static TT_COLL;
+    static const TT_COLL = 0x10;
-    static TT_LIST;
+    static const TT_BIN = 0x11;
-    static TT_BIN;
+    static const TT_BOOL = 0x12;
-    static TT_BOOL;
+    static const TT_LIST = 0x13;
-    static TT_IDENT;
+    static const TT_IDENT = 0x14;
-    static TT_HEX;
+    static const TT_HEX = 0x15;
-    static TT_COMP;
+    static const TT_COMP = 0x16;
     public
     class function sinit();virtual;
     begin
-        if not Fsok then
+    end    
-        begin 
-            TT_NUM := 1; //数字
-            TT_LLB := 2; //大括号 
-            TT_RLB := 3; //大括号 
-            TT_LSB := 4; //(
-            TT_RSB := 5; //)
-            TT_STR := 6; //字符串 
-            TT_SYM := 7; //符号  
-            TT_POI := 8; //点 . 
-            TT_SIG := 9; // : + - :< > = 
-            TT_BNK := 10; //空白 \r \n \t 
-            TT_ITEM := 11;
-            TT_LMB := 12;
-            TT_RMB := 13;
-            TT_SET := 14;
-            TT_HASH := 15;
-            TT_COLL := 0x10;
-            TT_BIN := 0x11;
-            TT_BOOL := 0x12;
-            TT_LIST := 0x13;
-            TT_IDENT := 0x14;
-            TT_HEX := 0x15;
-            TT_COMP := 0x16;
-            Fsok := true;
-        end
-    end
     class function PError(msg,lev);
     begin
         //messagebox(msg,"解析错误",1);
@@ -73,7 +47,7 @@ type TTmfParserbase = class
     begin
         sinit();
     end
-
+    
 end 
 type TTmfParserToken = class(TTmfParserbase)
     {**
@@ -89,8 +63,6 @@ type TTmfParserToken = class(TTmfParserbase)
     FTokens;
     FSplitter; //分隔符
     FSyms; //符号
-    FNumberChar;
-    FHexChar;
     Function SetScript(S);//设置文本
     begin
         IF FScript <> S then
@@ -360,9 +332,6 @@ type TTmfParserToken = class(TTmfParserbase)
         //Ffloat := FNumbers union array(".");
         FSplitter := array(' ','\t',"\r","\n",";",",");
         FSyms := array("=",":","(",")","<",">","[","]");
-        FNumberChar := inttostr(0 -> 9);
-        FHexChar := FNumberChar union array("a","b","c","d","e","f",
-            "A","B","C","D","E","F");
     end
     property Script read FScript write SetScript;
     {**
@@ -511,26 +480,67 @@ type TTmfParser = class(TTmfParserbase)
     end
     function gettree2(); //获得继承关系树
     begin
+        tx := mtic;
         d := gettreeasobject();  
         if d then 
         begin  
             d.setinhertedpaths(fssourdirs);//设置路径
-            d.initinherited(); 
+            d.initinherited();   //解析继承的数据文件信息
+            d.addinode(d.finheritednode); //合并继承的信息
+            getnodelist(d,lst,dlist); //获取冲突的对象
+            for i,v in dlist do  //删除冲突的成员
+            begin
+                try
+                v["p"].fobjects.deleteindex(v["n"]);
+                except
+                end;
+            end 
             return object2tree2(d);
         end         
     end 
-    function inheritedcoy(n,t,ht);
+    function getnodelist(d,lst,dlist);  //获取排除对象列表,以及冲突的对象
     begin
-        d := gettreeasobject();  
+        if not ifarray(lst) then lst := array();
-        if d then 
+        if not ifarray(dlist) then dlist := array();
-        begin  
+        fos := d.fobjects;
-            d.setinhertedpaths(fssourdirs);//设置路径
+        for i,v in fos.IndexNames() do 
-            d.initinherited(); 
+        begin
-            return d.inheritedstr(n,t,ht,0);
+            vd := fos[v];
-        end 
+            if lst[v] then //父类中的优先级大于最新添加的,因为新加入的不能和原有的重名,如果积累中添加了,子类也应该被删掉
-        return "";
+            begin
+                if lst[v,"i"] and not(vd.ifinherited) then //删除当前这个
+                begin
+                    dlist[length(dlist)] := array("p":d,"n":v);
+                end else 
+                if vd.ifinherited and not(lst[v,"i"]) then //删除上一个
+                begin 
+                    dlist[length(dlist)] := lst[v,array("p","n")];
+                    lst[v] := array("p":d,"nd":vd,"n":v,"i":vd.ifinherited,"ct":vd.inheritedcount);
+                end else
+                if not(vd.ifinherited) and not(lst[v,"i"]) then  //删除当前
+                begin
+                    dlist[length(dlist)] := array("p":d,"n":v);
+                end else 
+                if vd.ifinherited<lst[v,"ct"] then //删除当前
+                begin
+                    dlist[length(dlist)] := array("p":d,"n":v);
+                end else //删除上一个
+                begin
+                    dlist[length(dlist)] := lst[v,array("p","n")];
+                    lst[v] := array("p":d,"nd":vd,"n":v,"i":vd.ifinherited,"ct":vd.inheritedcount);
+                end 
+            end else 
+            begin
+                lst[v] := array("p":d,"nd":vd,"n":v,"i":vd.ifinherited,"ct":vd.inheritedcount);
+            end 
+            getnodelist(vd,lst,dlist);    
+        end                
+    end  
+    function inheritedcopy(n,t,ht); //构造继承的tfm文本
+    begin
+        return inheritedstr(n,t,ht);
     end 
-    function object2tree2(t); //获得继承关系
+    function object2tree2(t); //获得继承关系数组
     begin
         r := array();
         r["inherited"] := t.ifinherited;
@@ -551,23 +561,21 @@ type TTmfParser = class(TTmfParserbase)
             objs[v] :=  object2tree2(fos[v]);   
         end 
         r["property"] := ps;
-        r["object"] := objs;
+        r["object"] := objs;        
-        
         return r;
     end 
-    function gettreeasobject();
+    function gettreeasobject();//当前tfm对象
     begin
         if ftreeobj then return ftreeobj;
         gettree();
         if FTree then 
         begin
-            //ttfmnode
             ftreeobj := createndeobjects(FTree);
             return ftreeobj;
         end 
         return nil;
     end 
-    function createndeobjects(d);
+    function createndeobjects(d);//构造tfm对象树
     begin
         if ifarray(d) then 
         begin
@@ -661,7 +669,7 @@ type TTmfParser = class(TTmfParserbase)
             end
         end
     end
-    function createobj();
+    function createobj(); //解析对象
     begin
         {**
         @explan(说明) 获取对象 %%
@@ -672,13 +680,12 @@ type TTmfParser = class(TTmfParserbase)
             if (tv="object" or tv="inherited") and(tt <> TT_STR) then 
             begin
                 r :=  getobject();
-                if tv="inherited" then 
+                r["inherited"] := (tv="inherited")?true:false;
-                    r["inherited"] := true;
                 return r;
             end 
         end
     end
-    function getobject();
+    function getobject();//解析对象内容
     begin
         {**
         @explan(说明) 获得对象 %%
@@ -710,43 +717,46 @@ type TTmfParser = class(TTmfParserbase)
     begin
         ctoken(tv,tt);
         lx := tt;
-        {if tv="item" and(tt <> TT_STR)then
+        if tt<>TT_STR then 
         begin
-            lx := TT_ITEM;
+            case tv of
-            val := getabitem();
+                "[":
-        end else}
+                begin
-        if tv="[" and(tt <> TT_STR)then
+                    lx := TT_SET;
+                    val := getset();
+                end
+                "<":
+                begin
+                    val := getabitem(tv,fff); // getab();
+                    if fff then lx := TT_COLL;
+                    else lx := TT_ITEM; //TT_COLL;
+                end
+                "(":
+                begin
+                    val := getsb();
+                    lx := TT_LIST;
+                end 
+                "{":
+                begin
+                    val := getlb();
+                    lx := TT_BIN;
+                end
+                "true":
+                begin
+                    val := true;
+                    lx := TT_NUM;
+                end 
+                "false":
+                begin
+                    val := false;
+                    lx := TT_NUM;
+                end  
+                else val := tv;
+            end ;
+        end else 
         begin
-            lx := TT_SET;
+            val := tv;
-            val := getset();
+        end 
-        end else
-        if tv="<" and(tt <> TT_STR)then
-        begin
-            val := getabitem(tv,fff); // getab();
-            if fff then lx := TT_COLL;
-            else lx := TT_ITEM; //TT_COLL;
-        end else
-        if tv="(" and(tt <> TT_STR)then
-        begin
-            val := getsb();
-            lx := TT_LIST;
-        end else
-        if tv="{" and(tt <> TT_STR)then
-        begin
-            val := getlb();
-            lx := TT_BIN;
-        end else
-        if tv="true" and(tt <> TT_STR)then
-        begin
-            val := true;
-            lx := TT_NUM;
-        end else
-        if tv="false" and(tt <> TT_STR)then
-        begin
-            val := false;
-            lx := TT_NUM;
-        end else
-        val := tv;
     end
     function getmembers();
     begin
@@ -821,7 +831,6 @@ type TTmfParser = class(TTmfParserbase)
         begin
             ctoken(tv,tt);
             if tv="]" and tt <> TT_STR then return r;
-            //if tv="item" and tt <> TT_STR then r[rl++]:= array("value":getabitem(tv),"type":TT_ITEM);
             else if tv="<" and tt <> TT_STR then
             begin
                 v := getabitem(tv,fff);
@@ -835,7 +844,6 @@ type TTmfParser = class(TTmfParserbase)
     function getabitem(tp,ifitem);
     begin
         if not ifstring(tp)then endtp := "end";
-        //else if tp="item" then endtp := "end";
         else if tp="<" then endtp := ">";
         else PError("dict错误",1);
         r := array();
@@ -844,7 +852,7 @@ type TTmfParser = class(TTmfParserbase)
         while whileok() do
         begin
             ctoken(tv,tt);
-            if tv=endtp {"end"}and tt <> TT_STR then return r;
+            if tv=endtp and tt <> TT_STR then return r;
             p := tv;
             ptt := tt;
             ctoken(tv,tt);
@@ -854,13 +862,7 @@ type TTmfParser = class(TTmfParserbase)
                 if ifnil(val)or ifnil(lx)then PError("item无值",1);
                 r[rl++]:= array("name":p,"value":val,"type":lx);
             end else
-            {if p="item" and ptt <> TT_STR and(length(r)<1)then
+                PError("item没有=",1);
-            begin
-                ifitem := true;
-                btoken(2);
-                return getab();
-            end else}
-            PError("item没有=",1);
         end
     end
     function getab();
@@ -877,10 +879,6 @@ type TTmfParser = class(TTmfParserbase)
             begin
                 return r;
             end else
-            {if tv="item" and tt <> TT_STR then
-            begin
-                r[rl++]:= getabitem();
-            end else}
             begin
                 return PError("<>内容错误",1);
             end
@@ -905,8 +903,7 @@ type TTmfParser = class(TTmfParserbase)
             begin
                 return r;
             end else
-            {if tv="item" and tt <> TT_STR then r[rl++]:= array("value":getabitem(tv),"type":TT_ITEM);
+            if tv="<" and tt <> TT_STR then
-            else }if tv="<" and tt <> TT_STR then
             begin
                 v := getabitem(tv,fff);
                 lx := fff?TT_COLL:TT_ITEM;
@@ -2275,11 +2272,67 @@ type ttfmnode = class()
     end 
     function create(t,n);
     begin
+        inheritedcount := 0;
         fnodename := n;
         fnodetype := t;
         fpropertys := new tstrindexarray();
         fobjects := new tstrindexarray();
         finheritedpaths := array();
+    end
+    function addinode(nd);
+    begin
+        //if not nd then return ;
+        if  nd and nd.finheritednode  then  nd.addinode(nd.finheritednode);                        
+        for i,v in fobjects.IndexNames() do 
+        begin
+            ov := fobjects[v];
+            if ov.ifinherited then //继承的控件
+            begin
+                if ifobj(nd) then 
+                begin                     
+                    fd :=  nd.getnodebyname(v); //ov.fnodename
+                    if fd then 
+                    begin
+                        ov.inheritedcount++;
+                        ov.finheritednode :=fd;
+                    end else //不在继承源头,删除
+                    begin
+                        fobjects.deleteindex(v);
+                    end 
+                end else //不在继承源头,删除
+                begin
+                    fobjects.deleteindex(v);              
+                end 
+            end else 
+            begin
+            end 
+        end 
+        if  nd then
+        begin
+            for i,v in nd.getnodenames() do //添加父窗口控件
+            begin
+                ov := fobjects[v]; 
+                nnd := nd.getnodebyname(v);  
+                if not ov then 
+                begin                
+                    fobjects[v] := nnd.copyinh(); //复制属性                
+                end  else ov.addinode(nnd); //添加属性
+            end 
+        end 
+                          
+    end     
+    function copyinh();//继承拷贝
+    begin
+        r :=  new ttfmnode(fnodetype,fnodename);
+        for i,v in fobjects.IndexNames() do 
+        begin
+            vv := fobjects[v];
+            vi := vv.copyinh();  
+            r.addobject(vi); 
+        end 
+        r.finheritednode := self;
+        r.ifinherited := true;
+        return r;
     end 
     function get_inherited(data);
     begin
@@ -2290,9 +2343,10 @@ type ttfmnode = class()
         begin                        
             nd.setinhertedpaths(finheritedpaths);
             nd.initinherited();
+            finheritednode := nd;
+            //addinheritednode(nd); 此处屏蔽
         end 
-        finheritednode := nd;
+            
-        addinheritednode(nd);    
     end 
     function initinherited();
     begin
@@ -2330,6 +2384,9 @@ type ttfmnode = class()
     end 
     function addinheritednode(nd); //处理继承的节点
     begin
+        ///////////////查找空白/////////////////////////////////////         
+        ///////////////////////////////////////////////////////////////
+
         for i,v in fobjects.IndexNames() do 
         begin
             ov := fobjects[v];
@@ -2350,8 +2407,15 @@ type ttfmnode = class()
                     fobjects.deleteindex(v);                
                 end 
             end 
-            ov.addinheritednode(nd);
+            if fd then 
-        end         
+                ov.addinheritednode(fd);
+        end  
+        
+               
+    end 
+    function getnodenames();
+    begin
+        return fobjects.IndexNames();
     end 
     function getnodebyname(sb);//获得节点
     begin
@@ -2434,29 +2498,8 @@ type ttfmnode = class()
             r[i] := fpropertys[v];
         end 
         return r;
-    end 
+    end     
-    function inheritedstr(n,t,ht,h);
+    inheritedcount;
-    begin   
-        if ifnil(n) then n := fnodename;
-        if ifnil(t) then t := fnodetype; 
-        ws := "";
-        if not(h>=0) then h := 0;
-        for i:= 0 to h-1 do 
-        begin
-            ws+="   ";        
-        end 
-        r := ws+"inherited "+n+":"+t; 
-        if ht then r+="("+ht+")";
-        r+="\r\n";
-        for i,v in  fobjects.IndexNames() do 
-        begin
-            vo := fobjects[v];
-            r+=vo.inheritedstr(nil,nil,nil,h+1);
-        end 
-        r+="\r\n";
-        r+=ws+"end\r\n";   
-        return r;       
-    end 
     ifinherited;
     finheritedname;
     finheritednode;
@@ -2464,10 +2507,17 @@ type ttfmnode = class()
     fnodename;
     fobjects;
     private 
-    fpropertys;
+    fpropertys;    
-    
     finheritedpaths;
 end 
+function inheritedstr(n,t,ht);
+begin   
+    r := "inherited "+n+":"+t; 
+    if ht then r+="("+ht+")";
+    r+="\r\n";
+    r+="end\r\n";   
+    return r;       
+end
 function tablelines(str,n);
 begin
     lines := str2array(str,"\r\n");