liujianjun/tslediter
3
0
Fork 1
Code Issues Pull Requests Projects Releases Wiki Activity

更新tsl64

Browse Source
This commit is contained in:
liujianjun
2024-09-20 14:59:34 +08:00
parent 18c5435bf6
commit cc72d4c6fc
33 changed files with 344 additions and 95 deletions
Download Patch File Download Diff File Expand all files Collapse all files
funcext/tvclib/cstructurelib.tsf
+1
View File
@@ -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
+1
View File
@@ -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
+3 -1
View File
@@ -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
+19 -6
View File
@@ -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 前
funcext/tvclib/utslmemo.tsf
+7 -1
View File
@@ -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
+46 -31
View File
@@ -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.
funcext/tvclib/utslvclauxiliary.tsf
+2 -1
View File
@@ -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
+8 -1
View File
@@ -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
+3 -2
View File
@@ -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
+188 -26
View File
@@ -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;
pts := rec_to_points(rec);
faxesrgn.points := pts;
set_clip_vector( rec_to_points(rec));
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);
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();
funcext/tvclib/uvcpropertytypespersistence.tsf
+4 -1
View File
@@ -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
+10
View File
@@ -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";