更新tsl64

designer/gettslvcldesignerstart.tsf

@@ -4,8 +4,18 @@
 uses tslvcl,utslvclDesigner;
 deletefuncacheini();
 isdebug := false;
+willopen := "";
 for i:= 0 to sysparamcount() do  
 begin 
+    if wait_filename then 
+    begin         
+        willopen := sysparamstr(i);
+        wait_filename := 0;
+    end else 
+    if ("-tpj"=sysparamstr(i)) then
+    begin
+        wait_filename := true;
+    end else  
     if ("-DEBUGSERVER" = sysparamstr(i)) then 
     begin
         isdebug := true;
@@ -20,6 +30,7 @@ end
 app := InitializeApplication();
 app.createform(class(TVclDesignerStart),Desginer);
 Desginer.Show();
+if willopen then Desginer.OpenFileFromTpjFile(willopen);
 r :=  app.run();
 return r;
 type TVclDesignerStart = class(TVclDesigner) //实现唯一的窗口

designer/teditorform.tsf

@@ -366,11 +366,13 @@ type teditorform = class(TVCform) //
             begin
                 it.caption := v;
                 ite := new TMenu(self);
-                ite.caption := c_m_editor;
+                ite.caption := c_m_editor;                
-                ite.Checked := true;
                 ite.Parent := it;
                 itb := new TMenu(self);
                 itb.caption := c_m_exer;
+                global g_debug_chooser;
+                g_debug_chooser := c_m_exer;
+                itb.Checked := true;
                 itb.Parent := it;
                 itb._tag := ite;
                 ite._tag := itb;
@@ -1390,7 +1392,13 @@ type tsearchdir = class(TCustomControl)
     function Create(AOwner);override;
     begin
         inherited;
+        fcopyer := new TClipBoard(self);
         caption := "函数搜索目录:左侧为别名,右侧为-libpath目录....";
+        fcpmenu := new TPopupmenu(self);
+        mui := new TMenu(self);
+        mui.caption := "¸´ÖÆĿ¼";
+        mui.Parent := fcpmenu;
+        mui.OnClick := thisfunction(copy_current_dirs);
         WsDlgModalFrame := true;
         WSSizebox := true;
         visible := false;
@@ -1413,6 +1421,10 @@ type tsearchdir = class(TCustomControl)
             ls.Border := true;
             FLists[i] := ls;
         end 
+        FLists[0].PopupMenu := fcpmenu;
+        FLists[0].OnPopupMenu := function(o,e)begin
+            if o.ItemIndex<0 then return e.skip;
+        end 
         btrecs := array(
             array(124,3,144,25),
             array(124,206,144,230),
@@ -1446,6 +1458,10 @@ type tsearchdir = class(TCustomControl)
                 o.endmodal(0);
             end ;
     end 
+    function copy_current_dirs(o,e);
+    begin
+        fcopyer.text := array2str(FLists[1].items,";");
+    end 
     function editkeyup(o,e);
     begin
         if e.CharCode = 13 then 
@@ -1608,6 +1624,8 @@ type tsearchdir = class(TCustomControl)
     FEdit;
     FLists;
     FBtns;
+    fcpmenu;
+    fcopyer;
 end 
 private
 function GetIcon();

designer/utslcodeeditor.tsf

@@ -1722,25 +1722,25 @@ type TPageEditer=class(TPage) //
     end 
     [weakref]FPageItemOnRClick;
 end
-type TTslChmHelp=class
+type TTslChmHelp=class()
     function SearchWord(s);
     begin
         if not s then return;
-        pm := format('%s::/%s.htm',FTSLinterpPath+FChmName,s); //>mainwin
+        if fapi then return fapi.open_chm((FTSLinterpPath+FChmName),s);
-        HtmlHelpA(GetDesktopWindow(),pm,0,nil);
-        return;
     end
     function ShowTslLangChm();
     begin
-        return HtmlHelpA(GetDesktopWindow(),FTSLinterpPath+FChmName,0,nil);
+        if fapi then return fapi.open_chm((FTSLinterpPath+FChmName));
     end
-    function Create();
+    function Create(p);
     begin
-        FChmName := "help\\LANGUAGEGUIDE.CHM";
+        fapi := p;
+        FChmName := "help"$ioFileseparator()$"LANGUAGEGUIDE.CHM";
         FTSLinterpPath := TS_ModulePath();
     end
     property ChmName read FChmName write FChmName;
     private
+    [weakref]fapi;
     FTSLinterpPath;
     FHanle;
     FChmName;
@@ -1971,7 +1971,7 @@ type TEditer=class(TCustomcontrol) //
         FSynClasses["bat"]:= array(class(TBatSynHigLighter),class(TSynCompletion),";bat;cmd;");
         FSynClasses["tfm"]:= array(class(ttfmhighlighter),class(TSynCompletion),";tfm;");
         FSynClasses["None"]:= array(nil,nil,"");
-        FTslChmHelp := new TTslChmHelp();
+        FTslChmHelp := new TTslChmHelp(_wapi);
         FCodeFormatInfo := array("wordct":80,"charct":200,"syn":true,"sel":false,"arraytype":0);
         FPageEditer.OnDblClick := function(o,e)
         begin
@@ -4265,7 +4265,12 @@ type TEditer=class(TCustomcontrol) //
             ft := str2array(ft,";");
         end
         if not ft then ft := array("*");
-        FindFiles(dir,ft,d["c_dir"],r);
+        for i,v in str2array(dir,";") do  //¶àĿ¼²éÕÒ
+        begin 
+            tv := trim(v);
+            if tv then 
+                FindFiles(tv,ft,d["c_dir"],r);
+        end 
         return r;
     end
     function FindFiles(dir,ft,sub,ret);
@@ -6085,17 +6090,4 @@ begin
     end 
     return trim(s);
 end 
-{$ifdef linux}
-function HtmlHelpA()
-begin
-    return 0;
-end
-function GetDesktopWindow()
-begin
-    return 0;
-end
-{$else}
-function HtmlHelpA(hwndCaller:pointer;pszFile:string;uCommand:integer;dwData:pointer):pointer;stdcall;external "HHCTRL.OCX" name "HtmlHelpA";
-function GetDesktopWindow():pointer;stdcall;external "User32.dll" name "GetDesktopWindow";
-{$endif}
 end.

designer/utslsynmemo.tsf

@@ -2206,13 +2206,17 @@ type TTsfFileParser = class() //
     function ParserFiles(dir,FFileNames,mf);
     begin 
         dirs := FileList("",dir+fiofs+"*");
-        for i,v in dirs do 
+        for i,v in dirs do    //解析文件
         begin 
             fn := v["FileName"] ;
             if not(pos("D",v["Attr"])) and (1=ParseRegExpr("\\.tsf$",fn,"i",m,mp,ml)) then  //tsf文件处理
             begin
                 parserafile(dir,v);
             end 
+        end 
+        for i,v in dirs do  //解析目录
+        begin 
+            fn := v["FileName"] ;
             if pos("D",v["Attr"]) and not( fn in array(".","..")) then //子目录查找
             begin 
                 ParserFiles(dir+fiofs+fn,FFileNames,mf);

designer/utslvcldebuger.tsf

@@ -1425,12 +1425,13 @@ type TTslDebuga=class(TCustomControl)
         cnn := "";
         for ii := 1 to length(cn) do
         begin
-            if cn[ii]in array(".",":")then
+            cni := cn[ii];
+            if  (cni = ".") or (cni = ":")then
             begin
                 cn := cnn;
                 break;
             end
-            cnn += cn[ii];
+            cnn += cni;
         end
         f := FDebugtsfs[lowercase(cn)];
         if not f then

designer/utslvcldesigner.tsf

@@ -318,21 +318,23 @@ type TVclDesigner = class(tvcform)
     public //设计器工程
     ffilemenu;
     fviewmenu;
-    function OpenFileFromTpjFile(); //´ÓÎļþ´ò¿ª¹¤³Ì 
+    function OpenFileFromTpjFile(f); //´ÓÎļþ´ò¿ª¹¤³Ì 
     begin
         FProjectFileOpener.caption := "打开";
-        if FProjectFileOpener.OpenDlg() then 
+
+        if not(ifstring(f)) and  FProjectFileOpener.OpenDlg() then 
         begin 
-            f := FProjectFileOpener.FileName;
+            f := FProjectFileOpener.FileName;            
-            FProjectsManager.OpenFileFromTpjFile(f);
+        end 
-            fio := ioFileseparator();
+        if not fileexists("",f) then return ;
-            for i := length(f) downto 2 do 
+        FProjectsManager.OpenFileFromTpjFile(f);
+        fio := ioFileseparator();
+        for i := length(f) downto 2 do 
+        begin
+            if f[i]=fio then 
             begin
-                if f[i]=fio then 
+                FProjectFileOpener.initialDir := f[1:(i-1)];
-                begin
+                break;
-                    FProjectFileOpener.initialDir := f[1:(i-1)];
-                    break;
-                end 
             end 
         end 
     end
@@ -590,12 +592,12 @@ type TVclDesigner = class(tvcform)
     begin
         if not FChmHelper then 
         begin 
-            FChmHelper := new unit(UtslCodeEditor).TTslChmHelp();
+            FChmHelper := new unit(UtslCodeEditor).TTslChmHelp(_wapi);
         end 
         case o.caption of 
             "使用手册":
             begin
-                FChmHelper.ChmName := "help\\designerUserGuid.CHM"; 
+                FChmHelper.ChmName := "help"$ioFileseparator()$"designerUserGuid.CHM"; 
               // p := "C:\\Program Files\\Tinysoft\\Analyse.NETplug\\help\\designerUserGuid.pdf" ;//pluginpath()+"..\\help\\designerUserGuid.pdf";
                //_wapi.WinExec(format('cmd.exe /C call "start %s"',p),0); //http://bzjj.sinaapp.com/tslvclhelp/index.html
                //_wapi.WinExec(format('start "%s"',p),0);
@@ -605,11 +607,11 @@ type TVclDesigner = class(tvcform)
             end 
             "常用控件":
             begin
-                FChmHelper.ChmName := "help\\vclNormalControls.CHM"; 
+                FChmHelper.ChmName := "help"$ioFileseparator()$"vclNormalControls.CHM"; 
             end 
             "控件详情":
             begin
-                FChmHelper.ChmName := "help\\tslvclhelp.chm";                  
+                FChmHelper.ChmName := "help"$ioFileseparator()$"tslvclhelp.chm";                  
             end         
         end 
         FChmHelper.ShowTslLangChm(); 

funcext/tvclib/cstructurelib.tsf

@@ -2282,6 +2282,7 @@ end
 function calcalimsizeA(d,cl) //计算对其长度
 begin
     ret := array();
+    if not ifarray(d) then return ret;
     for i,v in d do
     begin
         vt := v[1];

funcext/tvclib/tslvcl.tsf

@@ -1242,6 +1242,7 @@ type TPopMenuBtn=class(TBtn)
     end
     function CreateMenu(o,info);
     begin
+        if not ifarray(info) then return ;
         for i,v in info do
         begin
             if ifarray(v)then

funcext/tvclib/twincontrol.tsf

@@ -449,7 +449,7 @@ type TWinControl = class(tcontrol)
         if not(Enabled)then p.Style .|= WS_DISABLED;
         if Visible then p.Style .|= WS_VISIBLE;
         if Parent is class(TWinControl)then //if Parent.HandleAllocated() then 
-        p.WndParent := Parent.Handle;
+            p.WndParent := Parent.Handle;
         else p.WndParent := ParentWindow;
         p.X := Left;
         p.Y := Top;
@@ -1928,6 +1928,7 @@ type TWinControl = class(tcontrol)
         @explan(说明)构建窗口句柄 %%
         **}
         //if not(Parent and Parent.HandleAllocated or (self(true) is class(tapplicationwindow))) then exit;
+        if not(parent) and not(csDesigning in ComponentState) and not(WsPopUp  and (WsCaption or FWsSysMenu or FWsSizeBox)) then return ;
         CreateParams(p);
         //_wapi.GetSystemMetrics(SM_CXSCREEN) DIV 2;
         //此处处理构造句柄
@@ -2121,6 +2122,7 @@ type TWinControl = class(tcontrol)
         end;
         CreateHandle();
         end;  }
+        
         if(not HandleAllocated())and(not(csDestroying in ComponentState))then
         begin
             if self.Parent=Self then

funcext/tvclib/ugtkinterface.tsf

@@ -81,6 +81,13 @@ type tsgtkapi = class(tgtkapis)
     function GetMonitorInfoA();
     begin
     end 
+    function open_chm(fn,pg);
+    begin
+        if ifstring(pg) and pg  then 
+            pm := format('kchmviewer %s -showPage %s.htm &',fn,pg);
+        else pm := format('kchmviewer %s &',fn);
+        tsl_gtk_exec_system(pm);
+    end 
     function CreateToolhelp32Snapshot()begin return -1; end;
     function EnumProcesses_();begin end 
     function ShowWindow(hwd :pointer;f:integer);
@@ -5226,7 +5233,7 @@ type tgtkapis = class() //gtk
     end
     procedure gtk_window_set_transient_for(w:pointer;p:pointer);
     begin
-        global g_applicaton_wnd_handle;        
+        global g_applicaton_wnd_handle;  
         _f_ := static procedure(w:pointer;p:pointer);cdecl;external getfuncptrbyname(0,functionname());
         if (p = g_applicaton_wnd_handle) and gdk_backend_is_wayland() then //处理底层窗口问题
         begin
@@ -5859,10 +5866,15 @@ type tgtkapis = class() //gtk
     function GTK_WINDOW(w);//gtkwindow
     begin
         wt := static gtk_window_get_type();
-        return g_type_check_instance_cast(w,wt);
+        return g_type_check_instance_cast(w,wt);        
-        
         return w;
     end 
+    function GTK_IS_WINDOW(w);//gtkwindow
+    begin
+        wt := static gtk_window_get_type();
+        return g_type_check_instance_is_a(w,wt);        
+        return w;
+    end
     function GDK_WINDOW(w); //gdkwindow
     begin
         wt := static gdk_window_get_type();
@@ -9276,7 +9288,7 @@ type tgtk_ctl_window_PoPup = class(tgtk_ctl_scroll_window)
         _wapi.gtk_layout_put(ctllayout,evtdrawbox,0,0);
          clientLayout := _Wapi.gtk_layout_new(0,0); 
         _wapi.gtk_container_add(evtdrawbox,clientLayout);
-       _wapi.gtk_widget_set_size_request(evtdrawbox,max(1,nwidth),max(1,nheight-pcd));
+        _wapi.gtk_widget_set_size_request(evtdrawbox,max(1,nwidth),max(1,nheight-pcd));
         _wapi.g_object_set_data(evtdrawbox,"gtk_client_parent",h);
         FClientWideget := evtdrawbox;   
         //_wapi.gtk_widget_set_can_focus(eb,true);
@@ -9291,8 +9303,9 @@ type tgtk_ctl_window_PoPup = class(tgtk_ctl_scroll_window)
             _wapi.g_object_set_data(h,"gtk_layout_parent",hwndparent);
             if _wapi.gtk_widget_is_toplevel(hwndparent) then trf := hWndParent;
             else 
-                trf := _wapi.gtk_widget_get_toplevel(hwndparent);  
+                trf := _wapi.gtk_widget_get_toplevel(hwndparent); 
-            _wapi.gtk_window_set_transient_for(h,trf);  
+            if _wapi.GTK_IS_WINDOW(trf) then 
+                _wapi.gtk_window_set_transient_for(h,trf); 
         end   
         //设置default 后不使用 resize 函数       
         ///////////需要绑定show信号，所以此处提前widget_show 前

funcext/tvclib/utslmemo.tsf

@@ -3527,7 +3527,8 @@ type tcustomsynhighlighter = class(TSynHighLighter)
     function setstring(d); //设置字符串信息
     begin
         fstrstires := array(); 
-        fstrstires_zy := array();       
+        fstrstires_zy := array();   
+        if not ifarray(d) then return ;    
         for i,v in d do 
         begin
             if not ifarray(v) then continue;
@@ -3556,6 +3557,7 @@ type tcustomsynhighlighter = class(TSynHighLighter)
         fblockstiresa := array();
         fblockstiresb := array();
         fblockstiresc := array();
+        if not ifarray(d) then return ;
         for i,v in d do 
         begin
             if not  ifarray(d) then continue ;
@@ -3576,6 +3578,7 @@ type tcustomsynhighlighter = class(TSynHighLighter)
     function setrowannote(d);//设置行注释
     begin
         frowstires := array();
+        if not ifarray(d) then return ;
         for i,v in d do 
         begin
             if v and ifstring(v) then 
@@ -3590,6 +3593,7 @@ type tcustomsynhighlighter = class(TSynHighLighter)
     begin
         st := new TTire();
         fsysfuntires := array(st);
+        if not ifarray(d) then return ;
         for i,v in d do 
         begin
             if ifstring(v) and v then 
@@ -3626,6 +3630,7 @@ type tcustomsynhighlighter = class(TSynHighLighter)
         fswordpairs := array();
         fswordpairshash := array();
         fswordpairshashdata := array();
+        if not ifarray(d) then return ;
         for i,v in d do 
         begin
             if not ifarray(v)  then continue;
@@ -3651,6 +3656,7 @@ type tcustomsynhighlighter = class(TSynHighLighter)
     function cyclefind(cys,s,l,idx,oidx,ostr,tidx);
     begin
         r := 0;
+        if not ifarray(cys) then return r;
         for i,v in cys do  //字符串 
         begin
             if v.find(s,l,idx,oidx,ostr) then 

funcext/tvclib/utslvcl_com.tsf

@@ -1234,9 +1234,9 @@ type iunkown =class(tcom_const)
         begin 
             fvtable := createvtb(nil);
             fvtablecontainer._setvalue_("vtable",fvtable._getptr_());
-            fvtable._setvalue_("QueryInterface",makeinstance(thisfunction(QueryInterface)));
+            fvtable._setvalue_("QueryInterface",makeinstance_com(thisfunction(QueryInterface)));
-            fvtable._setvalue_("Release",makeinstance(thisfunction(Release)));
+            fvtable._setvalue_("Release",makeinstance_com(thisfunction(Release)));
-            fvtable._setvalue_("AddRef",makeinstance(thisfunction(addref)));    
+            fvtable._setvalue_("AddRef",makeinstance_com(thisfunction(addref)));    
         end 
     end     
     function QueryInterface(s:pointer;riid:pointer;var ppv:pointer):integer;stdcall;virtual;
@@ -1334,10 +1334,10 @@ type idispatch=class(iunkown)
         if not ptr then 
         begin  
                    
-            fvtable._setvalue_("GetTypeInfoCount",makeinstance(thisfunction(GetTypeInfoCount)));           
+            fvtable._setvalue_("GetTypeInfoCount",makeinstance_com(thisfunction(GetTypeInfoCount)));           
-            fvtable._setvalue_("GetTypeInfo",makeinstance(thisfunction(GetTypeInfo))); 
+            fvtable._setvalue_("GetTypeInfo",makeinstance_com(thisfunction(GetTypeInfo))); 
-            fvtable._setvalue_("GetIDsOfNames",makeinstance(thisfunction(GetIDsOfNames)));            
+            fvtable._setvalue_("GetIDsOfNames",makeinstance_com(thisfunction(GetIDsOfNames)));            
-            fvtable._setvalue_("Invoke",makeinstance(thisfunction(Invoke_)));   
+            fvtable._setvalue_("Invoke",makeinstance_com(thisfunction(Invoke_)));   
             //echo tostn(fvtable._getdata_);                             
         end 
         fglobalL := TS_GetGlobalL();
@@ -1483,25 +1483,25 @@ type ITypeInfo=class(iunkown)
         if nptr then 
         begin  
             //echo tostn(fvtable._getdata_());        
-            fvtable._setvalue_("GetTypeAttr",makeinstance(thisfunction(GetTypeAttr)));           
+            fvtable._setvalue_("GetTypeAttr",makeinstance_com(thisfunction(GetTypeAttr)));           
-            fvtable._setvalue_("GetTypeComp",makeinstance(thisfunction(GetTypeComp)));           
+            fvtable._setvalue_("GetTypeComp",makeinstance_com(thisfunction(GetTypeComp)));           
-            fvtable._setvalue_("GetFuncDesc",makeinstance(thisfunction(GetFuncDesc)));           
+            fvtable._setvalue_("GetFuncDesc",makeinstance_com(thisfunction(GetFuncDesc)));           
-            fvtable._setvalue_("GetVarDesc",makeinstance(thisfunction(GetVarDesc)));           
+            fvtable._setvalue_("GetVarDesc",makeinstance_com(thisfunction(GetVarDesc)));           
-            fvtable._setvalue_("GetNames",makeinstance(thisfunction(GetNames)));           
+            fvtable._setvalue_("GetNames",makeinstance_com(thisfunction(GetNames)));           
-            fvtable._setvalue_("GetRefTypeOfImplType",makeinstance(thisfunction(GetRefTypeOfImplType)));           
+            fvtable._setvalue_("GetRefTypeOfImplType",makeinstance_com(thisfunction(GetRefTypeOfImplType)));           
-            fvtable._setvalue_("GetImplTypeFlags",makeinstance(thisfunction(GetImplTypeFlags)));           
+            fvtable._setvalue_("GetImplTypeFlags",makeinstance_com(thisfunction(GetImplTypeFlags)));           
-            fvtable._setvalue_("GetIDsOfNames",makeinstance(thisfunction(GetIDsOfNames)));           
+            fvtable._setvalue_("GetIDsOfNames",makeinstance_com(thisfunction(GetIDsOfNames)));           
-            fvtable._setvalue_("Invoke",makeinstance(thisfunction(Invoke_)));           
+            fvtable._setvalue_("Invoke",makeinstance_com(thisfunction(Invoke_)));           
-            fvtable._setvalue_("GetDocumentation",makeinstance(thisfunction(GetDocumentation)));           
+            fvtable._setvalue_("GetDocumentation",makeinstance_com(thisfunction(GetDocumentation)));           
-            fvtable._setvalue_("GetDllEntry",makeinstance(thisfunction(GetDllEntry)));           
+            fvtable._setvalue_("GetDllEntry",makeinstance_com(thisfunction(GetDllEntry)));           
-            fvtable._setvalue_("GetRefTypeInfo",makeinstance(thisfunction(GetRefTypeInfo)));           
+            fvtable._setvalue_("GetRefTypeInfo",makeinstance_com(thisfunction(GetRefTypeInfo)));           
-            fvtable._setvalue_("AddressOfMember",makeinstance(thisfunction(AddressOfMember)));           
+            fvtable._setvalue_("AddressOfMember",makeinstance_com(thisfunction(AddressOfMember)));           
-            fvtable._setvalue_("CreateInstance",makeinstance(thisfunction(CreateInstance)));           
+            fvtable._setvalue_("CreateInstance",makeinstance_com(thisfunction(CreateInstance)));           
-            fvtable._setvalue_("GetMops",makeinstance(thisfunction(GetMops)));           
+            fvtable._setvalue_("GetMops",makeinstance_com(thisfunction(GetMops)));           
-            fvtable._setvalue_("GetContainingTypeLib",makeinstance(thisfunction(GetContainingTypeLib)));           
+            fvtable._setvalue_("GetContainingTypeLib",makeinstance_com(thisfunction(GetContainingTypeLib)));           
-            fvtable._setvalue_("ReleaseTypeAttr",makeinstance(thisfunction(ReleaseTypeAttr)));           
+            fvtable._setvalue_("ReleaseTypeAttr",makeinstance_com(thisfunction(ReleaseTypeAttr)));           
-            fvtable._setvalue_("ReleaseFuncDesc",makeinstance(thisfunction(ReleaseFuncDesc)));           
+            fvtable._setvalue_("ReleaseFuncDesc",makeinstance_com(thisfunction(ReleaseFuncDesc)));           
-            fvtable._setvalue_("ReleaseVarDesc",makeinstance(thisfunction(ReleaseVarDesc))); 
+            fvtable._setvalue_("ReleaseVarDesc",makeinstance_com(thisfunction(ReleaseVarDesc))); 
             //echo tostn(fvtable._getdata_());  
         end 
     end  
@@ -1695,8 +1695,8 @@ type ITypecomp=class(iunkown)
         if nptr then 
         begin  
             //echo tostn(fvtable._getdata_());        
-            fvtable._setvalue_("Bind",makeinstance(thisfunction(Bind)));           
+            fvtable._setvalue_("Bind",makeinstance_com(thisfunction(Bind)));           
-            fvtable._setvalue_("BindType",makeinstance(thisfunction(BindType)));           
+            fvtable._setvalue_("BindType",makeinstance_com(thisfunction(BindType)));           
         end 
     end  
     function QueryInterface(s:pointer;riid:pointer;var ppv:pointer):integer;stdcall;override;
@@ -1795,8 +1795,8 @@ type IClassFactory=class(iunkown)
         fdispatchs := array();
         if not ptr then 
         begin
-            fvtable._setvalue_("CreateInstance",makeinstance(thisfunction(CreateInstance)));
+            fvtable._setvalue_("CreateInstance",makeinstance_com(thisfunction(CreateInstance)));
-            fvtable._setvalue_("LockServer",makeinstance(thisfunction(LockServer)));            
+            fvtable._setvalue_("LockServer",makeinstance_com(thisfunction(LockServer)));            
         end 
     end
     function QueryInterface(s:pointer;riid:pointer;var ppv:pointer):integer;stdcall;override;
@@ -2081,7 +2081,7 @@ begin
 end 
 function wideptr_to_ansi(s);
 begin
-    _f_ := static function(s:pointer):string;cdecl;external makeinstance(thisfunction(wideptr_to_ansi_i));
+    _f_ := static function(s:pointer):string;cdecl;external makeinstance_com(thisfunction(wideptr_to_ansi_i));
     k :=  call(_f_,s);
     return k;
 end 
@@ -2096,6 +2096,20 @@ begin
     wsowner := widestring(s);
     return get_tsl_mem_ptr(wsowner);
 end 
+function makeinstance_com(f); //¹¹ÔìÖ¸Õë
+begin
+    global g_func_handles;
+    if not ifarray(g_func_handles) then g_func_handles := array();
+    idx := inttostr( int64(f));
+    r :=  makeinstance(makeweakref(f));
+    g_func_handles[idx] := r;
+    return r;
+end 
+function destroy_instance() //Ïú»ÙÖ¸Õë
+begin
+    global g_func_handles;
+    for i,v in  g_func_handles do deleteinstance(v);   
+end 
 function CoCreateInstance(rclsid:pointer;pUnk:pointer;dwClsContext:integer;riid:integer;var lpdwRegister:integer):integer; stdcall; external "ole32.dll" name "CoCreateInstance";
 function CoRegisterClassObject(rclsid:pointer;pUnk:pointer;dwClsContext:integer;flags:integer;var lpdwRegister:integer):integer; stdcall; external "ole32.dll" name "CoRegisterClassObject";
 function CoRevokeClassObject(lpdwRegister:integer):integer; stdcall; external "ole32.dll" name "CoRevokeClassObject";
@@ -2115,4 +2129,5 @@ function  CoTaskMemAlloc(cb:pointer):pointer;stdcall;external "Ole32.dll" name "
 function  CoTaskMemRealloc(pv:pointer;cb:pointer):pointer;stdcall;external "Ole32.dll" name "CoTaskMemRealloc";
 procedure CoTaskMemFree(cb:pointer);stdcall;external "Ole32.dll" name "CoTaskMemFree";
 initialization
+destroy_instance();
 end.

funcext/tvclib/utslvclauxiliary.tsf

@@ -1560,7 +1560,8 @@ type TNode = class() //
         @explan(说明) 获得在父节点中的序号 %%
         @return(integer) 序号 %%
         **}
-        if Parent then Parent.indexof(self);
+        if Parent then return Parent.indexof(self);
+        return -1;
     end
     function AppendNode(it);virtual;
     begin

funcext/tvclib/utslvclstdctl.tsf

@@ -5167,8 +5167,15 @@ type TcustomToolBar=class(TCustomControl)
                 end                      
             end 
             if fmainmenu then 
-            begin 
+            begin
+                eab := not bi.Enabled;
+                if eab then 
+                begin 
+                    bc := c.font.color;
+                    c.font.color := 0xc0c0c0;
+                end                  
                 c.drawtext(bi.Caption,ci,DT_VCENTER.|DT_CENTER .|DT_SINGLELINE);
+                if eab then c.font.color := bc;
                 continue;
             end 
             igslist := ImageList;

funcext/tvclib/utslvcltree.tsf

@@ -775,7 +775,7 @@ type TcustomTreeCtlNode = class(tsluibase) //
             end
             //echo "\r\nimg";
         end
-        FCaptionRect := array(BasePos,y,x+1000,y+h);
+        FCaptionRect := array(BasePos,y,BasePos+w,y+h); //修正宽度处理20240820
         cvs.FillRect(FCaptionRect);
         cvs.drawtext(FCaption,FCaptionRect,DT_VCENTER .| DT_SINGLELINE .| DT_NOPREFIX);
         if ow.HasLine then
@@ -1543,7 +1543,7 @@ type TcustomTreeCtl = class(ttreelistwnd)
             "gethierarchybyhandle":
             begin
                 if FPaintArray then return FPaintArray[pm];
-                return 0;
+                return nil;
             end 
             "addlocked":
             begin
@@ -1613,6 +1613,7 @@ type TcustomTreeCtl = class(ttreelistwnd)
     function GoToNode(it);
     begin
         if not((it is class(TcustomTreeCtlNode))and (it.Owner=self)) then return ;
+        if not it.Visible then return ;
         if NodeInList(it)then
         begin
             //return SetTopLine(GetItemIndex(it));	 //¹ö¶¯

funcext/tvclib/utvclgraphics.tsf

@@ -529,13 +529,16 @@ end
 function point_in_rgn(p,rgn_); //判断点是否在区域中
 function graph_paint_lines(cvs,linestyle,xys,closed,ifo);  //根据给定点绘制线
 function graph_paint_points(mk,cvs,xys);   //根据点信息绘制点
+function graph_paint_boolen_value(n,v);   
+function graph_paint_rec_to_points(rec);   
+
 type tg_WinControl = class(tcustomcontrol,tg_const) //绘图窗口
     function create(AOwner);
     begin
         inherited;
         ffigure := new tg_figure();
         fg_timer := new unit(utslvclstdctl).tcustomtimer(self);
-        fg_timer.Interval := 200;
+        fg_timer.Interval := 300;
         fg_timer.Ontimer := thisfunction(figure_need_fresh);
         ffigureprepared := false;
         ffigure.rec_getter := function()begin
@@ -546,15 +549,17 @@ type tg_WinControl = class(tcustomcontrol,tg_const) //
     function flushfigure();
     begin
         if not ffigureprepared then return ;
-        if Fneed_invaliate then return ;
+        if f_validate_doing then return ;
         if not HandleAllocated() then return ;
-        Fneed_invaliate := true; 
+        f_validate_doing := true; 
         fg_timer.start(); 
     end 
     function paint();override; //绘制
     begin
+        fg_timer.stop();
         cvs := canvas;
-        ffigure.paint(cvs);
+        ffigureprepared := false;
+        ffigure.paint_pre(cvs);
         ffigureprepared := true;   
     end 
     function DestroyHandle();override;
@@ -619,8 +624,9 @@ type tg_WinControl = class(tcustomcontrol,tg_const) //
     function figure_need_fresh(o,e); //定时刷新
     begin          
         o.stop();
+        if not ffigureprepared then return ; //没有准备好
         InvalidateRect(nil,false);   
-        Fneed_invaliate := false;                
+        f_validate_doing := false;                
     end 
     function e_2_array(e,tp);
     begin
@@ -642,7 +648,7 @@ type tg_WinControl = class(tcustomcontrol,tg_const) //
     fmovecnt; 
     ffigure;
     fg_timer;
-    Fneed_invaliate;
+    f_validate_doing;
     ffigureprepared;  
 end 
 type tg_figure = class(tg_evet_conainter)   //绘图容器
@@ -651,13 +657,15 @@ type tg_figure = class(tg_evet_conainter)   //
         inherited;
         faxeses := new tnumindexarray();
     end 
-    function paint(cvs); //»æÖÆ
+    function paint_pre(cvs); //绘制
     begin
+        Fpainting := true;
         cvs := new tg_canvas(cvs.Handle);
         for i,v in faxeses.data do 
         begin
             v.paint_pre(cvs);
-        end   
+        end  
+        Fpainting := false; 
     end     
     function executecommand(cmd,p);
     begin
@@ -736,6 +744,7 @@ type tg_figure = class(tg_evet_conainter)   //
     end     
     function fresh(); ///////////////////////////
     begin
+        if Fpainting then return ; 
         if ffresh_caller then call(ffresh_caller);    
     end 
     function rect(); //////////////////////////////////
@@ -970,9 +979,24 @@ type tg_axes = class(tg_base) //
         _y := (y-p_top)/p_height;  
         return true;
     end 
-    function zoom_to_xyz(x,y,z,_x,_y,_z); //ÊÓͼµ½xyz
+    function zoom_to_xyz(x,y,zi,_x,_y,_z); //视图到xyz
     begin
         if not(fFigure ) then return false; 
+        /////////////处理z轴的默认值/////nil,-inf 为最小值;inf为最大值;nan为中间值//////////////////////////////
+        z := zi;
+        if ifnil(zi) then  
+        begin
+            z := fzoom_box[2,0];
+        end 
+        else 
+        if isinfinite(zi) then 
+        begin
+            if zi>0 then 
+                z := fzoom_box[2,1];
+            else z := fzoom_box[2,0];
+        end else 
+        if isnan(zi) then z := (fzoom_box[2,0]+fzoom_box[2,1])/2;
+        /////////////////////////////////////////////////////////////////
         if faxes_reverse[0]=tgc_on then x0 := fcoordinate_sizes[0]/2-(x-fzoom_bounds[0,0])/fzoom_coordinate_rates[0];    
         else 
             x0 := (x-fzoom_bounds[0,0])/fzoom_coordinate_rates[0] -fcoordinate_sizes[0]/2;
@@ -1020,17 +1044,32 @@ type tg_axes = class(tg_base) //
         end  
         return true;         
     end 
-    function paint_pre(cvs);
+    function paint_pre(cvs);override;
     begin
         if visible<>tgc_on then return ;
         axes_changed();
-        modify_coordinate_position();  
+        modify_coordinate_position();          
         r := array(p_left-1,p_top-1,p_left+p_width+1,p_top+p_height+1);
         cvs.axesrec := r;
-        paint(cvs);
+        cvs.axesvector := get_top_outer_points();
+        //paint(cvs);
+        paint_grid(cvs); 
+        inherited;
+        cvs.axesunclip(); 
+        for i,v in faxes_objects do //绘制坐标
+        begin 
+            v.paint_pre(cvs);
+        end 
+        modify_label_postion();
+        ftitle.paint_pre(cvs);
+        if fbox = tgc_on then 
+        begin 
+            set_lineinfo_to_canvas(cvs);
+            paint_box(cvs);
+        end     
         cvs.axesunclip();
     end 
-    function paint(cvs);override;
+    {function paint(cvs);override;
     begin  
         paint_grid(cvs);           
         inherited;  
@@ -1046,7 +1085,7 @@ type tg_axes = class(tg_base) //
             set_lineinfo_to_canvas(cvs);
             paint_box(cvs);
         end         
-    end 
+    end }
     function axes_changed();//改变
     begin
         if not fFigure then return ;
@@ -1308,6 +1347,7 @@ type tg_axes = class(tg_base) //
         return self(true);
     end 
     private //variable
+    Fpainting;
     fgrid;
     faxes_objects;
     fzoom_box;
@@ -1480,6 +1520,7 @@ type tg_axes = class(tg_base) //
     function get_axis_index(p);
     begin
         r := array();
+        if not ifarray(p) then return r;
         for i,v in p do 
         begin 
             zoom_to_xyz(v[0],v[1],v[2],_x0,_y0,_z0);
@@ -2077,15 +2118,114 @@ type tg_axes = class(tg_base) //
         for i , v in fface_v_indexs do 
         begin 
             zi := 0;
-            for j,vj in v do 
+            if ifarray(v) then 
             begin 
-                zi += fbox_vertexs[vj][2];
+                for j,vj in v do 
+                begin 
+                    zi += fbox_vertexs[vj][2];
+                end 
             end 
             r[i] := zi;
         end 
         r := sselect thisrowindex  from r order by thisrow desc end;
         return fface_v_indexs[r[0:2]];
-    end         
+    end  
+    function get_top_outer_points();
+    begin
+        //////////////获取顶部三个面的点////////////////////////
+        r :=get_top_face();
+        pts := array();
+        for i,v in r do
+        begin
+            pts union2= v;
+        end
+        pts2 := array();
+        for i,v in r do
+        begin
+            if not pts2 then pts2 := v;
+            else pts2 intersect= v;
+        end
+        r := (pts minus pts2);
+        ///////////计算中心和各个点的角度////////////////////
+        rt := array();
+        xxyy := zeros(3);
+        for i,v in r do 
+        begin
+            vi := fbox_vertexs[v]+fbounds_center;  
+            rt[i] := vi;  
+            rt[i,3] := v;  
+            xxyy+=vi;      
+        end 
+        xxyy /= length(rt);
+        for i := 0 to length(rt)-1 do 
+        begin 
+            rt[i,4] := get_x_arg(rt[i,0:1]-xxyy[0:1]);
+        end 
+        r := select [0],[1] from rt order by [4] end;
+        return r;
+    end      
+    function get_x_arg(dxy);
+    begin
+        a_180 := pi();
+        a_90 := a_180/2;
+        a_30 := a_180/6;
+        a_60 := a_180/3;
+        a_45 := a_180/4;
+        a_150 := a_180/6*5;       
+        xarg := d2angle(array(5,0),dxy); //和x夹角        
+        yarg := d2angle(array(0,5),dxy); //和y夹角
+        if isnan(xarg) then 
+        begin 
+            if dxy[0]>0 then xarg := 0;
+            else xarg := a_180;
+        end 
+        if isnan(yarg) then 
+        begin 
+            if dxy[1]>0 then yarg := 0;
+            else yarg := a_180;
+        end
+        if xarg<a_30 or  xarg>a_150 then 
+        begin 
+            ifh := true;
+        end 
+        if like_0( xarg)  then 
+        begin
+            ifh := true;
+        end else 
+        if a_like_b(xarg,a_180) then 
+        begin 
+            xarg := -xarg;
+            ifh := true;
+        end else 
+        if a_like_b(yarg,a_90) then 
+        begin
+            xarg := 0;  
+            ifh := true;   
+        end else 
+        if yarg = 0 then 
+        begin
+            xarg := a_90;
+        end else 
+        if yarg=a_180 then 
+        begin 
+            xarg:=-a_90;
+        end else 
+        if xarg<a_90 and yarg>a_90 then //第1
+        begin
+            xarg := -xarg;
+        end else 
+        if xarg>a_90 and yarg>a_90 then //第2
+        begin 
+            xarg :=-xarg;
+        end else 
+        if yarg<a_90 and xarg>a_90 then //第3
+        begin
+        end else 
+        if yarg<a_90 and xarg<a_90 then //第4
+        begin 
+        end 
+        return xarg;
+    end     
 end 
 type tg_canvas = class(TcustomCanvas) //画布对象
     uses utslvclgdi;
@@ -2119,9 +2259,11 @@ type tg_canvas = class(TcustomCanvas) //
         Handle := 0;
         faxesrgn := nil;
     end 
+    property axesvector read faxesvector write set_clip_vector;
     property axesrec read FaxesRec write set_clip_rect;
     private 
     FaxesRec;
+    faxesvector;
     FCvsHandle;
     faxesrgn;
     faxesrgntemp;
@@ -2129,10 +2271,13 @@ type tg_canvas = class(TcustomCanvas) //
     function set_clip_rect(rec);
     begin 
         FaxesRec := rec;
-        //faxesrgn.rect := rec; 
+        set_clip_vector( rec_to_points(rec));        
-        pts := rec_to_points(rec);
-        faxesrgn.points := pts; 
     end
+    function set_clip_vector(v);
+    begin
+        faxesvector :=v;
+        faxesrgn.points := faxesvector; 
+    end 
 end 
 type tg_axis_main = class(tg_axis) //主轴
     public 
@@ -2290,6 +2435,7 @@ type tg_axis = class(tg_base) //
     protected
     function draw_tics(cvs,info);virtual;
     begin
+        if not ifarray(info) then return ;
         for i,v in info do 
         begin 
             cvs.drawtext(v[0],v[1]);
@@ -2800,7 +2946,7 @@ type tg_text = class(tg_base)
             x := 0;
             y := 0;
         end        
-        if line_mode then 
+        if line_mode=tgc_on then 
         begin 
             rc := array(x,y,x+w,y+h);
             cvs.draw_rect().rect(rc).draw();                      
@@ -2850,6 +2996,7 @@ type tg_text = class(tg_base)
     function set_text(v);
     begin
         tx := array();
+        if not ifarray(v) then return ;
         for i,vi in v do 
         begin 
             if ifstring(vi) then tx[length(tx)] := vi;
@@ -3482,6 +3629,7 @@ type tg_legend = class(tg_base) //ͼ
     begin
         idx := 0;
         flg := false;
+        if not ifarray(s) then return ;
         for i,v in s do 
         begin
             if not ifstring(v) then continue;            
@@ -3606,11 +3754,12 @@ type tg_Polyline = class(tg_graph) //
     function paint(cvs);override; //绘图
     begin
         if tgc_on<> visible then return ;
+        bx := axes.zoom_box;
         tempbarw := 0;
         if clip_state=tgc_on then
         begin
             //cvs.axesclip();
-            bx := axes.zoom_box;
+            
             pts := array();
             for i,v in rec_to_points( array(bx[0,0],bx[1,0],bx[0,1],bx[1,1])) do 
             begin 
@@ -3659,7 +3808,7 @@ type tg_Polyline = class(tg_graph) //
     function executecommand(cmd,p);override;
     begin
         case cmd of
-            "points_in_canvas":return (visible=tgc_on)? fline_points_in_canvas:nil; //Êý¾ÝÉ¢µã
+            "points_in_canvas":return (visible=tgc_on)? fline_points_in_canvas:array(); //数据散点
         end;
         return inherited;
     end 
@@ -4027,12 +4176,16 @@ type tg_base = class(TNode,tg_evet_conainter) //
     end 
     function paint(cvs);virtual;  //绘制
     begin
-        if tgc_on<> visible then return ;
+            
+    end 
+    function paint_pre(cvs);virtual;
+    begin        
+        paint(cvs);
         for i := 0 to NodeCount-1 do 
         begin
             vi := GetNodeByIndex(i);
-            vi.paint(cvs);
+            vi.paint_pre(cvs);
-        end 
+        end     
     end 
     function hit_at(info):bool; //命中处理,鼠标信息 
     begin
@@ -4120,6 +4273,7 @@ type tg_base = class(TNode,tg_evet_conainter) //
     property change_locked read fchange_locked write fchange_locked;
     property onhit_at read fonhit_at write fonhit_at;     
     public 
+    tgtype;    //类型名称
     user_data;
     tag;
     protected
@@ -4518,6 +4672,14 @@ function graph_paint_points(mk,dc,xys);
 begin
     return paint_marks(mk,dc,xys);
 end 
+function graph_paint_boolen_value(n,v);
+begin
+    return tg_boolen_value(n,v);
+end 
+function graph_paint_rec_to_points(rec);
+begin
+    return rec_to_points(rec);
+end 
 function paint_lines(cvs,pls,xys,cls,ifo);//划线
 begin
     o := static  new tg_const();

funcext/tvclib/uvcpropertytypespersistence.tsf

@@ -1513,6 +1513,7 @@ type UniSelProperty=class(TPropertyType)
     function UnifRagge(d);
     begin
         r := array();
+        if not ifarray(d) then return r;
         for i,v in d do
         begin
             r[i]:= array(v,v);
@@ -2129,7 +2130,9 @@ end
 type ttfmnode = class()
     function setinhertedpaths(phs);
     begin
-        finheritedpaths := phs;
+        if ifarray(phs) then 
+            finheritedpaths := phs;
+        else finheritedpaths := array();
     end 
     function create(t,n);
     begin

funcext/tvclib/uwindowsinterface.tsf

@@ -481,6 +481,16 @@ type twindowsapi = class()
     Function DrawMenuBar(hwd:pointer):integer;stdcall;external "User32.dll"  name "DrawMenuBar"; 
     Function SetMenu(hwd:pointer;hmenu:pointer):integer;stdcall;external "User32.dll"  name "SetMenu"; 
     Function GetMenu(hwd:pointer):pointer;stdcall;external "User32.dll"  name "GetMenu"; 
+    //////////////////////////////////////////////////////////////
+    function open_chm(fn,pg);
+    begin
+        if ifstring(pg) and pg  then 
+            pm := format('%s::/%s.htm',fn,pg);
+        else pm := fn;
+        HtmlHelpA(GetDesktopWindow(),pm,0,nil);
+    end 
+    function HtmlHelpA(hwndCaller:pointer;pszFile:string;uCommand:integer;dwData:pointer):pointer;stdcall;external "HHCTRL.OCX" name "HtmlHelpA";
+    //////////////////////////////////////////////////////////
     //**********************************************
     function GetDesktopWindow():pointer;stdcall;external "User32.dll"  name "GetDesktopWindow"; 
     Function GetDC(hwd :pointer):pointer;stdcall;external "User32.dll"  name "GetDC"; 

whatsnew.txt

@@ -1,3 +1,57 @@
+更新日志--------2024-09-13
+                  修正：pdf_plugin。
+                  升级：支持使用二进制类描述头中的静态常量。
+                  修正：防止Python多线程锁失败使用强制加锁模式防止多线程运行不稳定。
+                  升级：支持新的calcctrlword，0x100和0x200支持nil类型的.操作和[]操作，对于无参读操作返回NIL。
+                  升级：新增nilinvoke预定义支持识别是否支持上述行为{$IFDEF nilinvoke} {$ENDIF}。
+                  升级：支持::,:.,mcell,mrow,mcol,mIndexCount,mIndex等的对象重载，使得对象支持这些算符。
+                  升级：新增pn_calcctrlword()常量函数。
+                  升级：支持在pubkrnl.ini中[TSL]段中使用CalcCtrlWord=来控制缺省的计算控制字，使得系统的缺省行为可配置。
+                  修正：使用HashCode调用方法的二进制类（如采用此特性开发的TStringList）的派生类，无法访问基类方法问题。
+                  兼容：保持对nil for in什么都不做的行为，防止利用此特性的程序报错。
+                  修正：特殊使用堆栈溢出未能被主动侦测的问题。
+                  修正：堆栈溢出异常因堆栈缺乏无法记载具体原因的问题。
+                  修正：fmarray的复数矩阵无法被子矩阵模式赋值的问题。
+                  修正：syscreatemutex在ubuntu18.04下成功返回0的错误表现，并防止和LINUX其他句柄冲突。
+
+更新日志--------2024-08-30
+                  升级：新增平台委托执行函数LIST和STOP客户机函数支持。
+
+更新日志--------2024-08-29
+                  修正：xlsreadwrite/import xlsx的多线程问题。
+                  升级：支持for in以及msize,mrows,mcols的对象重载，使得对象支持这些算符。
+
+更新日志--------2024-08-27
+                  升级：解释器内核支持globalcache数据在数组中以多级数组的模式进行访问。
+                  修正：python多线程的支持问题。
+
+更新日志--------2024-08-21
+                  修正：office_plugin import开始行列在中间区域的问题。
+                  新增：pdf_plugin，支持pdf生成的功能。
+                  修订：jdbc驱动对PG特殊类型转换导致的问题。
+
+更新日志--------2024-08-16
+                  修正：FIREDAC模式ArrayDML ODBC类型连接模式（例如MSSQL）一列多个BLOB当出现NULL行之后的行均被设置为NULL的问题。
+
+更新日志--------2024-08-13
+                  修正：客户端操作数据表类型插入列的问题。
+                  修正：div在禁止nil运算时无法计算的问题。
+                  修正：复数的特殊计算相关的内核问题。
+
+更新日志--------2024-07-31
+                  升级：office-lib。
+                  优化： MedianOf,LargeOf,SmallOf,PercentileOf,PercentRankOf,QuartileOf,RankOf,TrimMeanOf对每行进行运算的效率问题。
+
+更新日志--------2024-07-22
+                  修正：7-19日升级引起的thashedstringlist工作异常的问题。
+                  修正：7-19日升级的内核优化问题。
+
+更新日志--------2024-07-19
+                  升级：支持优化设置8返回系统类调用的优化信息。如果1+2+4+8 15为返回全部，之前7可以返回全部。
+                  升级：支持tslassigning关键字，识别对象的读操作是否是在对象赋值中。例如a.b.c:=1，b的执行可以得到状态。
+                  升级：TinyODBC/TSJDBC。
+                  升级：内核优化。
+
 更新日志--------2024-07-10
                   升级：支持缺省加载tslpkg目录里的*.pkg.load包。
                   升级：TSL命令行支持--build=模式下将无命名空间的函数打包成指定namespace的函数。理论上多套应用包括同名公共函数均可以采用此模式独立打包。