diff --git a/CommKrnl.dll b/CommKrnl.dll index 0e2a65e..f4bcbc2 100644 Binary files a/CommKrnl.dll and b/CommKrnl.dll differ diff --git a/MathKrnl.dll b/MathKrnl.dll index 98c5891..c0de73b 100644 Binary files a/MathKrnl.dll and b/MathKrnl.dll differ diff --git a/TSCrypt.dll b/TSCrypt.dll index 630ee9a..5afad24 100644 Binary files a/TSCrypt.dll and b/TSCrypt.dll differ diff --git a/TSL.exe b/TSL.exe index 1d58e87..483c5f3 100644 Binary files a/TSL.exe and b/TSL.exe differ diff --git a/TSLDebugModule.dll b/TSLDebugModule.dll index 88163db..540c463 100644 Binary files a/TSLDebugModule.dll and b/TSLDebugModule.dll differ diff --git a/TSLInterp.dll b/TSLInterp.dll index f7d6d93..3bd8460 100644 Binary files a/TSLInterp.dll and b/TSLInterp.dll differ diff --git a/TSLPlugin.dll b/TSLPlugin.dll index 569cbb0..a0c5512 100644 Binary files a/TSLPlugin.dll and b/TSLPlugin.dll differ diff --git a/designer/utslcodeeditor.tsf b/designer/utslcodeeditor.tsf index 2491363..522896e 100644 --- a/designer/utslcodeeditor.tsf +++ b/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 - HtmlHelpA(GetDesktopWindow(),pm,0,nil); - return; + if fapi then return fapi.open_chm((FTSLinterpPath+FChmName),s); 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 @@ -6090,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. diff --git a/designer/utslvcldesigner.tsf b/designer/utslvcldesigner.tsf index a195afc..a7ddaf1 100644 --- a/designer/utslvcldesigner.tsf +++ b/designer/utslvcldesigner.tsf @@ -592,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); @@ -607,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(); diff --git a/editor-install.exe b/editor-install.exe index 23087c6..599366b 100644 Binary files a/editor-install.exe and b/editor-install.exe differ diff --git a/funcext/tvclib/cstructurelib.tsf b/funcext/tvclib/cstructurelib.tsf index 6e65b00..1628544 100644 --- a/funcext/tvclib/cstructurelib.tsf +++ b/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]; diff --git a/funcext/tvclib/tslvcl.tsf b/funcext/tvclib/tslvcl.tsf index fcd907f..a2f44e5 100644 --- a/funcext/tvclib/tslvcl.tsf +++ b/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 diff --git a/funcext/tvclib/twincontrol.tsf b/funcext/tvclib/twincontrol.tsf index e1c6e0b..4d452bf 100644 --- a/funcext/tvclib/twincontrol.tsf +++ b/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 diff --git a/funcext/tvclib/ugtkinterface.tsf b/funcext/tvclib/ugtkinterface.tsf index 9bdde5f..01236b3 100644 --- a/funcext/tvclib/ugtkinterface.tsf +++ b/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); - _wapi.gtk_window_set_transient_for(h,trf); + trf := _wapi.gtk_widget_get_toplevel(hwndparent); + if _wapi.GTK_IS_WINDOW(trf) then + _wapi.gtk_window_set_transient_for(h,trf); end //设置default 后不使用 resize 函数 ///////////需要绑定show信号，所以此处提前widget_show 前 diff --git a/funcext/tvclib/utslmemo.tsf b/funcext/tvclib/utslmemo.tsf index ddf5216..32eeb94 100644 --- a/funcext/tvclib/utslmemo.tsf +++ b/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 diff --git a/funcext/tvclib/utslvcl_com.tsf b/funcext/tvclib/utslvcl_com.tsf index a61b49a..cb93969 100644 --- a/funcext/tvclib/utslvcl_com.tsf +++ b/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_("Release",makeinstance(thisfunction(Release))); - fvtable._setvalue_("AddRef",makeinstance(thisfunction(addref))); + fvtable._setvalue_("QueryInterface",makeinstance_com(thisfunction(QueryInterface))); + fvtable._setvalue_("Release",makeinstance_com(thisfunction(Release))); + 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_("GetTypeInfo",makeinstance(thisfunction(GetTypeInfo))); - fvtable._setvalue_("GetIDsOfNames",makeinstance(thisfunction(GetIDsOfNames))); - fvtable._setvalue_("Invoke",makeinstance(thisfunction(Invoke_))); + fvtable._setvalue_("GetTypeInfoCount",makeinstance_com(thisfunction(GetTypeInfoCount))); + fvtable._setvalue_("GetTypeInfo",makeinstance_com(thisfunction(GetTypeInfo))); + fvtable._setvalue_("GetIDsOfNames",makeinstance_com(thisfunction(GetIDsOfNames))); + 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_("GetTypeComp",makeinstance(thisfunction(GetTypeComp))); - fvtable._setvalue_("GetFuncDesc",makeinstance(thisfunction(GetFuncDesc))); - fvtable._setvalue_("GetVarDesc",makeinstance(thisfunction(GetVarDesc))); - fvtable._setvalue_("GetNames",makeinstance(thisfunction(GetNames))); - fvtable._setvalue_("GetRefTypeOfImplType",makeinstance(thisfunction(GetRefTypeOfImplType))); - fvtable._setvalue_("GetImplTypeFlags",makeinstance(thisfunction(GetImplTypeFlags))); - fvtable._setvalue_("GetIDsOfNames",makeinstance(thisfunction(GetIDsOfNames))); - fvtable._setvalue_("Invoke",makeinstance(thisfunction(Invoke_))); - fvtable._setvalue_("GetDocumentation",makeinstance(thisfunction(GetDocumentation))); - fvtable._setvalue_("GetDllEntry",makeinstance(thisfunction(GetDllEntry))); - fvtable._setvalue_("GetRefTypeInfo",makeinstance(thisfunction(GetRefTypeInfo))); - fvtable._setvalue_("AddressOfMember",makeinstance(thisfunction(AddressOfMember))); - fvtable._setvalue_("CreateInstance",makeinstance(thisfunction(CreateInstance))); - fvtable._setvalue_("GetMops",makeinstance(thisfunction(GetMops))); - fvtable._setvalue_("GetContainingTypeLib",makeinstance(thisfunction(GetContainingTypeLib))); - fvtable._setvalue_("ReleaseTypeAttr",makeinstance(thisfunction(ReleaseTypeAttr))); - fvtable._setvalue_("ReleaseFuncDesc",makeinstance(thisfunction(ReleaseFuncDesc))); - fvtable._setvalue_("ReleaseVarDesc",makeinstance(thisfunction(ReleaseVarDesc))); + fvtable._setvalue_("GetTypeAttr",makeinstance_com(thisfunction(GetTypeAttr))); + fvtable._setvalue_("GetTypeComp",makeinstance_com(thisfunction(GetTypeComp))); + fvtable._setvalue_("GetFuncDesc",makeinstance_com(thisfunction(GetFuncDesc))); + fvtable._setvalue_("GetVarDesc",makeinstance_com(thisfunction(GetVarDesc))); + fvtable._setvalue_("GetNames",makeinstance_com(thisfunction(GetNames))); + fvtable._setvalue_("GetRefTypeOfImplType",makeinstance_com(thisfunction(GetRefTypeOfImplType))); + fvtable._setvalue_("GetImplTypeFlags",makeinstance_com(thisfunction(GetImplTypeFlags))); + fvtable._setvalue_("GetIDsOfNames",makeinstance_com(thisfunction(GetIDsOfNames))); + fvtable._setvalue_("Invoke",makeinstance_com(thisfunction(Invoke_))); + fvtable._setvalue_("GetDocumentation",makeinstance_com(thisfunction(GetDocumentation))); + fvtable._setvalue_("GetDllEntry",makeinstance_com(thisfunction(GetDllEntry))); + fvtable._setvalue_("GetRefTypeInfo",makeinstance_com(thisfunction(GetRefTypeInfo))); + fvtable._setvalue_("AddressOfMember",makeinstance_com(thisfunction(AddressOfMember))); + fvtable._setvalue_("CreateInstance",makeinstance_com(thisfunction(CreateInstance))); + fvtable._setvalue_("GetMops",makeinstance_com(thisfunction(GetMops))); + fvtable._setvalue_("GetContainingTypeLib",makeinstance_com(thisfunction(GetContainingTypeLib))); + fvtable._setvalue_("ReleaseTypeAttr",makeinstance_com(thisfunction(ReleaseTypeAttr))); + fvtable._setvalue_("ReleaseFuncDesc",makeinstance_com(thisfunction(ReleaseFuncDesc))); + 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_("BindType",makeinstance(thisfunction(BindType))); + fvtable._setvalue_("Bind",makeinstance_com(thisfunction(Bind))); + 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_("LockServer",makeinstance(thisfunction(LockServer))); + fvtable._setvalue_("CreateInstance",makeinstance_com(thisfunction(CreateInstance))); + 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. \ No newline at end of file diff --git a/funcext/tvclib/utslvclauxiliary.tsf b/funcext/tvclib/utslvclauxiliary.tsf index 8d988b8..c11ebce 100644 --- a/funcext/tvclib/utslvclauxiliary.tsf +++ b/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 diff --git a/funcext/tvclib/utslvclstdctl.tsf b/funcext/tvclib/utslvclstdctl.tsf index fe6f79d..4c738df 100644 --- a/funcext/tvclib/utslvclstdctl.tsf +++ b/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; diff --git a/funcext/tvclib/utslvcltree.tsf b/funcext/tvclib/utslvcltree.tsf index 1532068..2b7bf65 100644 --- a/funcext/tvclib/utslvcltree.tsf +++ b/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)); //滚动 diff --git a/funcext/tvclib/utvclgraphics.tsf b/funcext/tvclib/utvclgraphics.tsf index 5437ead..ebe427a 100644 --- a/funcext/tvclib/utvclgraphics.tsf +++ b/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 xarga_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 xarga_90 then //第1 + begin + xarg := -xarg; + end else + if xarg>a_90 and yarg>a_90 then //第2 + begin + xarg :=-xarg; + end else + if yarga_90 then //第3 + begin + end else + if yarg 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); - end + vi.paint_pre(cvs); + 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(); diff --git a/funcext/tvclib/uvcpropertytypespersistence.tsf b/funcext/tvclib/uvcpropertytypespersistence.tsf index 9a057f7..7f693ad 100644 --- a/funcext/tvclib/uvcpropertytypespersistence.tsf +++ b/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 diff --git a/funcext/tvclib/uwindowsinterface.tsf b/funcext/tvclib/uwindowsinterface.tsf index 1ffcf27..e7505e3 100644 --- a/funcext/tvclib/uwindowsinterface.tsf +++ b/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"; diff --git a/plugin/TSLCPLUGIN.DLL b/plugin/TSLCPLUGIN.DLL index f298826..0d6d2cc 100644 Binary files a/plugin/TSLCPLUGIN.DLL and b/plugin/TSLCPLUGIN.DLL differ diff --git a/plugin/TSLClient.dll b/plugin/TSLClient.dll index 643364b..a8f5545 100644 Binary files a/plugin/TSLClient.dll and b/plugin/TSLClient.dll differ diff --git a/plugin/TSSecurity.dll b/plugin/TSSecurity.dll index 07f45ff..684ab7a 100644 Binary files a/plugin/TSSecurity.dll and b/plugin/TSSecurity.dll differ diff --git a/plugin/office_plugin.DLL b/plugin/office_plugin.DLL index 0a99b82..3a78adf 100644 Binary files a/plugin/office_plugin.DLL and b/plugin/office_plugin.DLL differ diff --git a/protocol.dll b/protocol.dll index c8aaca2..97185b5 100644 Binary files a/protocol.dll and b/protocol.dll differ diff --git a/tsleditor.exe b/tsleditor.exe index a1b1ce7..c14cb9b 100644 Binary files a/tsleditor.exe and b/tsleditor.exe differ diff --git a/tslkrnl.dll b/tslkrnl.dll index b3da2b1..b7b70a1 100644 Binary files a/tslkrnl.dll and b/tslkrnl.dll differ diff --git a/tslpcre.dll b/tslpcre.dll index 671a6fc..f584028 100644 Binary files a/tslpcre.dll and b/tslpcre.dll differ diff --git a/tslvcltool.exe b/tslvcltool.exe index 83d8a31..7e11582 100644 Binary files a/tslvcltool.exe and b/tslvcltool.exe differ diff --git a/tsnet.dll b/tsnet.dll index f14dfed..a35b0c0 100644 Binary files a/tsnet.dll and b/tsnet.dll differ diff --git a/whatsnew.txt b/whatsnew.txt index d0b9de6..96d4651 100644 --- a/whatsnew.txt +++ b/whatsnew.txt @@ -1,3 +1,43 @@ +更新日志--------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对每行进行运算的效率问题。