添加绘图扩展库

This commit is contained in:
liujianjun 2025-02-12 17:45:12 +08:00
parent 314869d09c
commit a0717b7cd3
21 changed files with 2851 additions and 213 deletions

View File

@ -49,11 +49,6 @@ array(
"type":"form", "type":"form",
"dir":"" "dir":""
), ),
"t_searchdir_mgr":(
"name":"t_searchdir_mgr",
"type":"form",
"dir":""
),
"tsl1":( "tsl1":(
"name":"tsl1", "name":"tsl1",
"type":"tsl", "type":"tsl",

View File

@ -190,13 +190,13 @@ type teditorform = class(TVCform) //
FTslFormatMenu := new tmenu(self); FTslFormatMenu := new tmenu(self);
FTslFormatMenu.Caption := c_m_tsl_style_config; FTslFormatMenu.Caption := c_m_tsl_style_config;
FTslFormatMenu.OnClick := function(o,e)begin FTslFormatMenu.OnClick := function(o,e)begin
move_popwnd_to_center2(FFormatInfoWnd); class(UtslCodeEditor).move_popwnd_to_center2(FFormatInfoWnd);
FFormatInfoWnd.show(); FFormatInfoWnd.show();
end end
FCodeBlockMenu := new TMenu(self); FCodeBlockMenu := new TMenu(self);
FCodeBlockMenu.caption := c_m_tsl_block; FCodeBlockMenu.caption := c_m_tsl_block;
FCodeBlockMenu.OnClick := function(o,e)begin FCodeBlockMenu.OnClick := function(o,e)begin
move_popwnd_to_center2(fBlockManager); class(UtslCodeEditor).move_popwnd_to_center2(fBlockManager);
fBlockManager.ShowModal(); fBlockManager.ShowModal();
end end
@ -1145,7 +1145,7 @@ type TBlockManager=class(TVCForm)
FEditer.caption := "Ìí¼Ó´úÂë¿é..." FEditer.caption := "Ìí¼Ó´úÂë¿é..."
end end
FEditer.SetData(FList.SelectedValue); FEditer.SetData(FList.SelectedValue);
move_popwnd_to_center2(FEditer); class(UtslCodeEditor).move_popwnd_to_center2(FEditer);
FEditer.showmodal(); FEditer.showmodal();
end end

View File

@ -1010,7 +1010,8 @@ type TProjectView = class(TVCForm) //
//FTfmComponets := array(); //FTfmComponets := array();
//FTmfParser.GetAllSubObjects(nil,FTfmComponets); //FTmfParser.GetAllSubObjects(nil,FTfmComponets);
FDesigner.LoadTreeNode(FTmfParser,inh,FCurrentOpend); FDesigner.LoadTreeNode(FTmfParser,inh,FCurrentOpend);
FDesigner.EditerCodeChanged(); xx := FTslEditer.OpenAndGotoFileByName(FCurrentOpend.gettsfname());
FDesigner.EditerCodeChanged(FCurrentOpend);
end end
fopenbuzy := false; fopenbuzy := false;
end else end else

View File

@ -4558,6 +4558,7 @@ type TEditList=class(TComboBox)
begin begin
inherited; inherited;
width := 280; width := 280;
Height := 26;
dropdowncount := 30; dropdowncount := 30;
FMaxCoder := 20; FMaxCoder := 20;
ReadONly := false; ReadONly := false;

View File

@ -378,6 +378,7 @@ type TDComponent = class()
end end
o.Component := nil; o.Component := nil;
ndp.Owner.SetSel(ndp); ndp.Owner.SetSel(ndp);
return true;
end end
end end
function cutclick(o,e);virtual; //剪切节点 function cutclick(o,e);virtual; //剪切节点
@ -389,11 +390,34 @@ type TDComponent = class()
function pasteclick(o,e);virtual; //粘贴节点 function pasteclick(o,e);virtual; //粘贴节点
begin begin
cp:=o.Component; cp:=o.Component;
if not cp then exit; if not cp then
begin
MessageBoxA("容器节点错误!","粘贴",0,nd.owner);
exit;
end
nd := cp.TreeNode; nd := cp.TreeNode;
If not nd then exit; If not nd then
begin
MessageBoxA("容器节点错误!","粘贴",0,nd.owner);
exit;
end
global g_script_can_set_not_focus := true;
d := nd.owner.Designer; d := nd.owner.Designer;
d.pasttonode(nd); case d.pasttonode(nd) of
-1:
begin
MessageBoxA("粘贴内容为空!","粘贴",0,nd.owner);
end
1:
begin
MessageBoxA(("粘贴控件到"$nd.Caption$"成功"),"粘贴",0,nd.owner);
end
else
begin
MessageBoxA(("粘贴控件到"$nd.Caption$"失败!\r\n请注意该节点是否能容纳粘贴控件"),"粘贴",0,nd.owner);
end
end ;
g_script_can_set_not_focus := false;
end end
function deleteclick(o,e);virtual; //控件删除操作 function deleteclick(o,e);virtual; //控件删除操作
begin begin
@ -716,6 +740,22 @@ type TDComponent = class()
@param(e)(tuievent) 消息对象 %% @param(e)(tuievent) 消息对象 %%
**} **}
inherited;" inherited;"
);
SetDefalutEvent(ev,true);
ev :=array(
"event":"ongetpreferredsize",
"name":"gprefsize",
"param":array("o","e"),
"virtual":true,
"body":
" {**
@explan(说明) 获取最佳的尺寸 %%
@param(o)(tcontrol)控件 %%
@param(e)(tmmeasuresize) 消息对象 %%
**}
e.width := 50; //宽度
e.height := 300; //高度
"
); );
SetDefalutEvent(ev,true); SetDefalutEvent(ev,true);
if not(AOwner is class(TComponent)) then exit; if not(AOwner is class(TComponent)) then exit;
@ -2210,6 +2250,7 @@ type TDToolBar = class(TDComponent)
function Create(AOwner);override; function Create(AOwner);override;
begin begin
inherited; inherited;
excludepropertys := array("childsizing");
end end
function ComponentCreater(tnode,owner);override; function ComponentCreater(tnode,owner);override;
begin begin
@ -2253,6 +2294,7 @@ type TDcoolBar = class(TDComponent)
function Create(AOwner);override; function Create(AOwner);override;
begin begin
inherited; inherited;
excludepropertys := array("childsizing");
end end
function ComponentCreater(tnode,owner);override; function ComponentCreater(tnode,owner);override;
begin begin

View File

@ -266,21 +266,33 @@ type TVclDesigner = class(tvcform)
end end
function pasttonode(nd);//粘贴节点 function pasttonode(nd);//粘贴节点
begin begin
if not fcutcopyinfo then return ; if not fcutcopyinfo then return -1;
ifc := fcutcopyinfo[2]; ifc := fcutcopyinfo[2];
r := pastinfotonode2(nd,fcutcopyinfo,1,not(ifc)); r := pastinfotonode2(nd,fcutcopyinfo,1,not(ifc));
if ifc and not(r<>1) then if ifc and ifstring(r) then
begin begin
fcutcopyinfo := nil; //如果失败就不清除内容 fcutcopyinfo := nil; //如果失败就不清除内容
end end
if ifstring(r) and r then return true;
end end
function pastinfotonode2(nd,data,fst,notcute); function pastinfotonode2(nd,data,fst,notcute);
begin begin
r := pastinfotonode(nd,data,fst,notcute); ndobjs := array();
r := pastinfotonode(nd,data,fst,notcute,ndobjs);
needadjust := array();
for i,v in ndobjs do
begin
v.set_loadstate(false);
if v is class(TWinControl) then
begin
if v.ControlCount<1 then needadjust[length(needadjust)] := v;
end else needadjust[length(needadjust)] := v;
end
for i,v in needadjust do v.AdjustSize();
if ifstring(r) then fdolist.add(nd.Component.name,"paste",r); if ifstring(r) then fdolist.add(nd.Component.name,"paste",r);
return r; return r;
end end
function pastinfotonode(nd,data,fst,notcute); //粘贴节点 function pastinfotonode(nd,data,fst,notcute,ndobjs); //粘贴节点
begin begin
tc := data[0]; tc := data[0];
if ifstring(tc) then tc := class(TDComponent).GetClassItem(tc); if ifstring(tc) then tc := class(TDComponent).GetClassItem(tc);
@ -292,9 +304,17 @@ type TVclDesigner = class(tvcform)
pwnd := nd.Component.Cwnd; pwnd := nd.Component.Cwnd;
nnd := tc.ComponentCreater(nd,pwnd); nnd := tc.ComponentCreater(nd,pwnd);
if not nnd then return 1; //加入失败处理 if not nnd then return 1; //加入失败处理
nn := nnd.CreateName(); nn := nnd.CreateName();
FVariableSelecter.additem(nnd); FVariableSelecter.additem(nnd);
BindCwndMessage(nnd.Cwnd); BindCwndMessage(nnd.Cwnd);
nndw := nnd.Cwnd;
if nndw is class(tcontrol) then
begin
nndw.set_loadstate(true);
ndobjs[length(ndobjs)] := nndw;
end
if fst and (pwnd is class(TWinControl)) then if fst and (pwnd is class(TWinControl)) then
pclt := pwnd.ClientRect; //获得父节点区域 pclt := pwnd.ClientRect; //获得父节点区域
for i,v in data do for i,v in data do
@ -317,9 +337,14 @@ type TVclDesigner = class(tvcform)
end end
nnd.SetComponentProperties(i,vi); nnd.SetComponentProperties(i,vi);
end end
for i,v in data[1] do for i,v in data[1] do //构造子对象
begin begin
pastinfotonode(nnd.TreeNode,v); pastinfotonode(nnd.TreeNode,v,nil,nil,ndobjs);
end
for i,v in data[3] do //设置lazy属性
begin
nnd.SetComponentProperties(i,v);
end end
return nnd.name; return nnd.name;
end end
@ -334,20 +359,17 @@ type TVclDesigner = class(tvcform)
lzs := array(); lzs := array();
for i,v in cr do for i,v in cr do
begin begin
if not(v and ifstring(i) ) then continue; //严格判断 if not(ifstring(i) ) then continue; //严格判断
if i in array("cursel","itemindex","autosize","align","childsizing","font","anchor") then lzs[i] := v; if i in array("cursel","itemindex","autosize","align","childsizing","font","anchor") then lzs[i] := v;
else else
r[i] := v; r[i] := v;
end end
for i,v in lzs do
begin
r[i] := v;
end
r["name"] := tc.name; r["name"] := tc.name;
for i := 0 to node.ItemCount-1 do for i := 0 to node.ItemCount-1 do
begin begin
r[1,i] := getnodeinfodata((node.items)[i]);// r[1,i] := getnodeinfodata((node.items)[i]);//
end end
r[3] := lzs;
end end
return r; return r;
end end
@ -1318,10 +1340,11 @@ type TVclDesigner = class(tvcform)
return ;// return ;//
end end
FTree.Loading := true; FTree.Loading := true;
outobjs := array();
try try
prs := array(); prs := array();
obarray := array(); obarray := array();
loadtfmtotree(Ptfm,Ptfm.gettree2,FTree.RootItem,FTree,prs,obarray,const inh,1); loadtfmtotree(Ptfm,Ptfm.gettree2,FTree.RootItem,FTree,prs,obarray,const inh,1,outobjs);
for i,v in prs do for i,v in prs do
begin begin
va := obarray[v[2]]; va := obarray[v[2]];
@ -1333,9 +1356,27 @@ type TVclDesigner = class(tvcform)
except except
end ; end ;
needadjust := array();
for i,voj in outobjs do
begin
voj.set_loadstate(false);
if voj is class(TWinControl) then
begin
if voj.ControlCount<1 then
begin
needadjust[length(needadjust)] := voj;
end
end else
needadjust[length(needadjust)] := voj;
end
for i,voj in needadjust do
begin
voj.AdjustSize();
end
FTree.Loading := nil; FTree.Loading := nil;
end end
function loadtfmtotree(p,d,node,wr,prs,obarray,inhname,first);//当如信息 function loadtfmtotree(p,d,node,wr,prs,obarray,inhname,first,outobjs);//当如信息
begin begin
{** {**
@explan(说明) 导入tfm文件 %% @explan(说明) 导入tfm文件 %%
@ -1360,15 +1401,19 @@ type TVclDesigner = class(tvcform)
it.Imgs := fdimagelist.GetImageId("tdcreateform"); it.Imgs := fdimagelist.GetImageId("tdcreateform");
end end
comp := it.ComponentCreater(node,wr); comp := it.ComponentCreater(node,wr);
compcwnd := comp.Cwnd;
if compcwnd is class(tcontrol) then
outobjs[length(outobjs)] := compcwnd;
compcwnd.set_loadstate(true);
if first then if first then
begin begin
{$ifdef linux} {$ifdef linux}
if setflg then if setflg then
begin begin
comp.Cwnd.parent := self; compcwnd.parent := self;
end end
{$endif} {$endif}
comp.Cwnd.Handle; compcwnd.Handle;
end end
comp.isinherited := d["inherited"]; comp.isinherited := d["inherited"];
comp.inheritedparent := d["parent"]; comp.inheritedparent := d["parent"];
@ -1387,7 +1432,7 @@ type TVclDesigner = class(tvcform)
begin begin
if ifarray(ddp["align"]) and (ddp["align"]["value"]="alnone") then if ifarray(ddp["align"]) and (ddp["align"]["value"]="alnone") then
begin begin
comp.Cwnd.align := alnone; compcwnd.align := alnone;
end end
end end
lazy := array(); lazy := array();
@ -1415,13 +1460,13 @@ type TVclDesigner = class(tvcform)
end end
for i,v in d["object"] do for i,v in d["object"] do
begin begin
call(thisfunction,p,v,comp.TreeNode,comp.Cwnd,prs,obarray,inhname); call(thisfunction,p,v,comp.TreeNode,compcwnd,prs,obarray,inhname,nil,outobjs);
end end
for i,v in lazy do for i,v in lazy do
begin begin
comp.SetComponentProperties(v[0],v[1],v[2]); comp.SetComponentProperties(v[0],v[1],v[2]);
end end
BindCwndMessage(comp.Cwnd); BindCwndMessage(compcwnd);
//comp.DoControlAlign(); //comp.DoControlAlign();
end end

Binary file not shown.

View File

@ -8,6 +8,7 @@ Interface
天软科技 天软科技
20171215 添加注释 20171215 添加注释
20240308 整理代码 20240308 整理代码
20250211 userÀàÐÍÖ§³ÖÊý×é "user[n]"
*) *)
(** (**
@example(范例--内存管理--1) @example(范例--内存管理--1)
@ -174,6 +175,7 @@ type ctslctrans = class(tmemoryclass)
_nomalloc; _nomalloc;
_ptr;//对象地址 _ptr;//对象地址
_objs;//子对象 _objs;//子对象
_objstartsubs;//
_objstart;//起始位置 _objstart;//起始位置
_objsize;//字节长度 _objsize;//字节长度
_objst;//类型 _objst;//类型
@ -448,7 +450,7 @@ type ctslctrans = class(tmemoryclass)
raise "内存管理对象构造错误!"; raise "内存管理对象构造错误!";
return; return;
end end
_objsize := _objstart := _objss := _objst := _objs := array(); _objstartsubs := _objsize := _objstart := _objss := _objst := _objs := array();
ldata := length(data)-1; ldata := length(data)-1;
_size := data[ldata,3]+data[ldata,4]-data[0,3]; _size := data[ldata,3]+data[ldata,4]-data[0,3];
Fstrcdata := data; Fstrcdata := data;
@ -481,6 +483,17 @@ type ctslctrans = class(tmemoryclass)
_objs[v0]:= new ctslctrans(v2,tptr,nil); _objs[v0]:= new ctslctrans(v2,tptr,nil);
end end
end else end else
if v1="userarray2" then
begin
v0s := array();
v22 := modyv(v2,v3);
for ii,vii in v["pos"] do
begin
_objstartsubs[i,ii] := vii;
v0s[ii] := new ctslctrans(v22,ptr+vii,ifset);
end
_objs[v0]:= v0s;
end else
if v1="userarray" then if v1="userarray" then
begin begin
_objs[v0]:= new ctslctrans(modyv(v2,v3),ptr+v3,ifset);//+v3 _objs[v0]:= new ctslctrans(modyv(v2,v3),ptr+v3,ifset);//+v3
@ -517,6 +530,17 @@ type ctslctrans = class(tmemoryclass)
_objs[v0]:= no; _objs[v0]:= no;
_tool.writeptr(_ptr+v3,no._ptr); _tool.writeptr(_ptr+v3,no._ptr);
end else end else
if v1="userarray2" then
begin
v0s := array();
v22 := modyv(v2,v3);
for ii,vii in v["pos"] do
begin
_objstartsubs[v0,ii] := vii;
v0s[ii] := new ctslctrans(v22,_ptr+vii,true);
end
_objs[v0]:= v0s;
end else
if v1="userarray" then if v1="userarray" then
begin begin
no := new ctslctrans(modyv(v2,v3),_ptr+v3,true);//+v3; no := new ctslctrans(modyv(v2,v3),_ptr+v3,true);//+v3;
@ -570,6 +594,16 @@ type ctslctrans = class(tmemoryclass)
o := _objs[i]; o := _objs[i];
o._setcptr_(tptr); o._setcptr_(tptr);
end else end else
if v="userarray2" then
begin
for ii,vii in _objstartsubs[i] do
begin
tptr := ptr+vii;
o := _objs[i,ii];
o._setcptr_(tptr);
end
end else
if v="userarray" then if v="userarray" then
begin begin
tptr := ptr+v3; tptr := ptr+v3;
@ -727,6 +761,13 @@ type ctslctrans = class(tmemoryclass)
ret := array(); ret := array();
for i,v in _objs do for i,v in _objs do
begin begin
if ifarray(v) then
begin
for j,vj in v do
begin
ret[i,j] := vj._getdata_();
end
end else
if v is class(ctslctrans)then if v is class(ctslctrans)then
begin begin
ret[i]:= v._getdata_(); ret[i]:= v._getdata_();
@ -2258,12 +2299,24 @@ begin
if(tp1="user")then if(tp1="user")then
begin begin
ret[i,5]:= "userarray"; ret[i,5]:= "userarray";
size := 1;
sz := 0; sz := 0;
dp1 := min(alim,tpbyte); dp1 := min(alim,tpbyte);
npoint := ceil(npoint/dp1)* dp1; npoint := ceil(npoint/dp1)* dp1;
ret1 := tslarraytocstructcalc(v,alim,npoint,sz); ret1 := tslarraytocstructcalc(v,alim,npoint,sz);
ret[i,2]:= ret1; ret[i,2]:= ret1;
if size>1 then
begin
ret[i,5]:= "userarray2";
npointi := npoint;
ret[i,"pos",0] :=npointi ;
for ii:=2 to size do
begin
npointi := ceil((npointi+sz)/dp1)* dp1;
ret[i,"pos",ii-1] :=npointi ;
end
sz := npointi-npoint+sz;
end else
size := 1;
end else end else
begin begin
raise ("类型错误:" $ tp1); raise ("类型错误:" $ tp1);

View File

@ -19,16 +19,16 @@ type t_children_sizer = class()
flayout := 0; flayout := 0;
fhorizontalspacing := 10; fhorizontalspacing := 10;
fverticalspacing := 10; fverticalspacing := 10;
ftopbottomspacing := 5; ftopbottomspacing := 10;
fleftrightspacing := 20; fleftrightspacing := 10;
fautosizing := 0; fautosizing := 0;
end end
function AdjustSize(); //µ÷Õû function AdjustSize(); //µ÷Õû
begin begin
if flayout=0 then return ; if flayout=0 then return ;
if fautosizing then return ; if fautosizing then return ;
fautosizing := true;
if not fowner then return ; if not fowner then return ;
fautosizing := true;
faownercls := fowner.ClientRect; faownercls := fowner.ClientRect;
dolayoutctls(w,h); dolayoutctls(w,h);
if fowner.autosize then if fowner.autosize then
@ -45,7 +45,7 @@ type t_children_sizer = class()
if p and p.autosize then p.AdjustSize();//´¦Àí´«µ½ if p and p.autosize then p.AdjustSize();//´¦Àí´«µ½
fautosizing := false; fautosizing := false;
end end
function getsizerinfo(); function getsizerinfo(); //获取信息
begin begin
r := array(); r := array();
r["layout"] := flayout; r["layout"] := flayout;
@ -56,7 +56,7 @@ type t_children_sizer = class()
r["leftrightspacing"] := fleftrightspacing; r["leftrightspacing"] := fleftrightspacing;
return r; return r;
end end
function setsizerinfo(v); function setsizerinfo(v);//设置信息
begin begin
if not(ifarray(v) and v) then return ; if not(ifarray(v) and v) then return ;
flg := false; flg := false;
@ -81,7 +81,7 @@ type t_children_sizer = class()
end end
"horizontalspacing": "horizontalspacing":
begin begin
if vi<>fhorizontalspacing and vi>0 then if vi<>fhorizontalspacing and vi>=0 then
begin begin
fhorizontalspacing := vi; fhorizontalspacing := vi;
flg := true; flg := true;
@ -89,7 +89,7 @@ type t_children_sizer = class()
end end
"verticalspacing": "verticalspacing":
begin begin
if vi<>fverticalspacing and vi>0 then if vi<>fverticalspacing and vi>=0 then
begin begin
fverticalspacing := vi; fverticalspacing := vi;
flg := true; flg := true;
@ -97,7 +97,7 @@ type t_children_sizer = class()
end end
"topbottomspacing": "topbottomspacing":
begin begin
if vi<>ftopbottomspacing and vi>0 then if vi<>ftopbottomspacing and vi>=0 then
begin begin
ftopbottomspacing := vi; ftopbottomspacing := vi;
flg := true; flg := true;
@ -105,7 +105,7 @@ type t_children_sizer = class()
end end
"leftrightspacing": "leftrightspacing":
begin begin
if vi<>fleftrightspacing and vi>0 then if vi<>fleftrightspacing and vi>=0 then
begin begin
fleftrightspacing := vi; fleftrightspacing := vi;
flg := true; flg := true;
@ -259,7 +259,6 @@ type t_children_sizer = class()
end end
end end
end end
function setcontrolsperline(v); function setcontrolsperline(v);
begin begin
nv := integer(v); nv := integer(v);

View File

@ -342,6 +342,16 @@ public //
AOwner.InsertComponent(Self); AOwner.InsertComponent(Self);
end end
end end
function set_loadstate(v); //ÉèÖÃloading״̬
begin
if v then
begin
includestate(FComponentState,csLoading);
end else
begin
excludestate(FComponentState,csLoading);
end
end
function RootOwner(); //获得域根节点 function RootOwner(); //获得域根节点
begin begin
if fasdomain then return self(true); if fasdomain then return self(true);

View File

@ -48,6 +48,7 @@ type tcontrol = class(tcomponent)
FOnDblClick; //Ë«»÷ FOnDblClick; //Ë«»÷
FOnDragDrop; FOnDragDrop;
FOnDragOver; FOnDragOver;
fonGetPreferredSize;
FOnSize; FOnSize;
FOnMove; FOnMove;
//FOnEditingDone; //FOnEditingDone;
@ -1016,8 +1017,8 @@ type tcontrol = class(tcomponent)
if (o is class(TWinControl)) and o.WsPopUp then return ; if (o is class(TWinControl)) and o.WsPopUp then return ;
if (Align=alNone) then if (Align=alNone) then
begin begin
//p := Parent ; p := Parent ;
//if p and p.childsizing.layout>0 then return p.AdjustSize(); if p and p.childsizing.layout>0 then return p.AdjustSize();
AdjustSize(); AdjustSize();
end end
end end
@ -1029,8 +1030,8 @@ type tcontrol = class(tcomponent)
if not NoRecycled() then return ; if not NoRecycled() then return ;
CallMessgeFunction(OnSize,o,e); CallMessgeFunction(OnSize,o,e);
DoWMSIZE(o,e); DoWMSIZE(o,e);
//p := Parent ; p := Parent ;
//if p and p.childsizing.layout>0 then return p.AdjustSize(); if p and p.childsizing.layout>0 then return p.AdjustSize();
AdjustSize(); AdjustSize();
end end
function CMCursorChanged(o,e):CM_CURSORCHANGED;virtual; function CMCursorChanged(o,e):CM_CURSORCHANGED;virtual;
@ -1485,6 +1486,8 @@ type tcontrol = class(tcomponent)
procedure AdjustSize();virtual; // smart calling DoAutoSize procedure AdjustSize();virtual; // smart calling DoAutoSize
begin begin
//includestate(FControlFlags,cfAutoSizeNeeded); //includestate(FControlFlags,cfAutoSizeNeeded);
if csLoading in ComponentState then return ;
If csDestroying in Componentstate Then return ;
if fautosizing then if fautosizing then
begin begin
return ; return ;
@ -1503,12 +1506,32 @@ type tcontrol = class(tcomponent)
function GetPreferredSize(w,h);virtual; function GetPreferredSize(w,h);virtual;
begin begin
ft := Font; ft := Font;
if ft then if not ft then return ;
if fonGetPreferredSize then
begin begin
e := new tmmeasuresize();
CallMessgeFunction(fonGetPreferredSize,self(true),e);
if e.width>=0 and e.Height>=0 then
begin
w := e.Width;
h := e.Height;
end else
begin
try
info := fonGetPreferredSize.functioninfo();
fn := info["functionname"];
if ifstring(info["classname"]) then fn := info["classname"] $ "." $ fn;
fn := "onGetPreferredSize call: "$fn $" err!";
except
fn := "onGetPreferredSize is not function";
end ;
raise fn;
end
return ;
end
c := caption; c := caption;
w := ft.Width*(length(c)+2); w := ft.Width*(length(c)+2);
h := ft.Height+3; h := ft.Height+4;
end
end end
protected protected
function set_Preferre_size(); function set_Preferre_size();
@ -1562,6 +1585,7 @@ type tcontrol = class(tcomponent)
**} **}
//property MouseEntered read FMouseEntered; //property MouseEntered read FMouseEntered;
property OnSize:eventhandler read FOnSize write FOnSize; property OnSize:eventhandler read FOnSize write FOnSize;
property ongetpreferredsize:eventhandler read fonGetPreferredSize write fonGetPreferredSize;
property OnMove:eventhandler read FOnMove write FOnMove; property OnMove:eventhandler read FOnMove write FOnMove;
property OnMouseMove:eventhandler read FOnMouseMove Write FOnMouseMove; property OnMouseMove:eventhandler read FOnMouseMove Write FOnMouseMove;
property OnPopupMenu:eventhandler read FOnPopupMenu write FOnPopupMenu; property OnPopupMenu:eventhandler read FOnPopupMenu write FOnPopupMenu;

View File

@ -83,13 +83,15 @@ type tgraphiccontrol = class(TControl)
function GetPreferredSize(w,h);override; function GetPreferredSize(w,h);override;
begin begin
ft := Font; ft := Font;
if ft then if not ft then return ;
if ongetpreferredsize then
begin begin
return inherited;
end
c := caption; c := caption;
w := ft.Width*(max(length(c),1))+2; w := ft.Width*(max(length(c),1))+2;
h := ft.Height+3; h := ft.Height+3;
end end
end
function InvalidateRect(rec,f); function InvalidateRect(rec,f);
begin begin
{** {**

View File

@ -6112,7 +6112,7 @@ type Ttfm2Component = class(TTmfParser)
return findclass(nn); return findclass(nn);
end end
end end
function SetTfmData(owner,obj,data,lazydata); function SetTfmData(owner,obj,data,lazydata,outobjs);
begin begin
u1 := obj.GetPublishproperties(); u1 := obj.GetPublishproperties();
u2 := obj.GetPublishEvents(); u2 := obj.GetPublishEvents();
@ -6157,6 +6157,11 @@ type Ttfm2Component = class(TTmfParser)
if cobj then if cobj then
begin begin
nobj := createobject(cobj,owner); nobj := createobject(cobj,owner);
if nobj is class(tcontrol) then
begin
outobjs[length(outobjs)] := nobj;
nobj.set_loadstate(true);
end
try try
if(nobj is class(TToolBar))then if(nobj is class(TToolBar))then
begin begin
@ -6173,7 +6178,8 @@ type Ttfm2Component = class(TTmfParser)
invoke(owner,n,1,nobj); invoke(owner,n,1,nobj);
except except
end; end;
call(thisfunction,owner,nobj,v,lazydata);
call(thisfunction,owner,nobj,v,lazydata,outobjs);
end end
end end
end end
@ -6189,7 +6195,8 @@ type Ttfm2Component = class(TTmfParser)
lazydata := array(); lazydata := array();
//lazydata[0] := array(); //lazydata[0] := array();
darray := gettree2(); darray := gettree2();
SetTfmData(owner,owner,darray,lazydata); outobjs := array();
SetTfmData(owner,owner,darray,lazydata,outobjs);
for i,v in lazydata do for i,v in lazydata do
begin begin
try try
@ -6198,6 +6205,19 @@ type Ttfm2Component = class(TTmfParser)
except except
end; end;
end end
needadjust := array();
for i,v in outobjs do
begin
v.set_loadstate(false);
if (v is class(TWinControl)) then
begin
if v.ControlCount<1 then needadjust[length(needadjust)] := v;
end else needadjust[length(needadjust)] := v;
end
for i,v in needadjust do
begin
v.AdjustSize();
end
end end
end end
function LoadFromTfm(owner); function LoadFromTfm(owner);

View File

@ -2588,6 +2588,10 @@ type TWinControl = class(tcontrol)
end; end;
function AdjustSize();override; function AdjustSize();override;
begin begin
If csDestroying in Componentstate Then
begin
return ;
end
if autosizing then if autosizing then
begin begin
return ; return ;
@ -2597,6 +2601,10 @@ type TWinControl = class(tcontrol)
begin begin
return ; return ;
end end
If csLoading in Componentstate Then
begin
return ;
end
cs := fchildsizing; cs := fchildsizing;
if cs and cs.layout>0 then return cs.AdjustSize(); if cs and cs.layout>0 then return cs.AdjustSize();
if autosize then if autosize then
@ -2627,10 +2635,17 @@ type TWinControl = class(tcontrol)
end end
function GetPreferredSize(w,h);override; function GetPreferredSize(w,h);override;
begin begin
if ongetpreferredsize then return inherited;
brec := BoundsRect; brec := BoundsRect;
crec := ClientRect; crec := ClientRect;
dw := (brec[2]-brec[0])-(crec[2]-crec[0]); dw := (brec[2]-brec[0])-(crec[2]-crec[0]);
dh := (brec[3]-brec[1])-(crec[3]-crec[1]); dh := (brec[3]-brec[1])-(crec[3]-crec[1]);
cs := fchildsizing;
if autosize and cs.layout>0 then
begin
dh += cs.topbottomspacing;
dw += cs.leftrightspacing;
end
cts := Controls; cts := Controls;
w := 0; w := 0;
h := 0; h := 0;
@ -2675,6 +2690,7 @@ type TWinControl = class(tcontrol)
h := max(h,ah); h := max(h,ah);
w+=dw; w+=dw;
h+=dh; h+=dh;
end end
procedure DoControlAlign({rect});override; procedure DoControlAlign({rect});override;
begin begin

View File

@ -177,6 +177,7 @@ type tcustomcoolbar=class(tcustomcontrol)
end end
function AdjustSize();override; function AdjustSize();override;
begin begin
if csLoading in ComponentState then return ;
inherited; inherited;
doControlALign(); doControlALign();
InvalidateRect(nil,false); InvalidateRect(nil,false);

View File

@ -68,6 +68,15 @@ type TMMENUSELECT=class(tuieventbase)
@param(flags)(integer) ״̬ %% @param(flags)(integer) ״̬ %%
**} **}
end end
type tmmeasuresize = class(tuieventbase)
function create();override;
begin
width := -1;
height := -1;
end
width;
height;
end
type TMKEY=class(tuieventbase) type TMKEY=class(tuieventbase)
{** {**
@param(˵Ã÷) °´¼üÏûÏ¢ @param(˵Ã÷) °´¼üÏûÏ¢

View File

@ -527,11 +527,15 @@ type tcustombtn = class(TCustomControl) //
dc.font.color := bc; dc.font.color := bc;
end end
end end
end end
function GetPreferredSize(w,h);override; function GetPreferredSize(w,h);override;
begin begin
class(tcontrol).GetPreferredSize(w,h); class(tcontrol).GetPreferredSize(w,h);
if ongetpreferredsize then return ;
bs := BoundsRect;
cs := ClientRect;
dh := (bs[3]-bs[1])-(cs[3]-cs[1])+2;
h+=dh;
end end
function FontChanged(o);override; //×ÖÌå¸Ä±ä function FontChanged(o);override; //×ÖÌå¸Ä±ä
begin begin
@ -569,9 +573,7 @@ type tcustombtn = class(TCustomControl) //
bs := caption; bs := caption;
inherited; inherited;
if bs = caption then return ; if bs = caption then return ;
//if autosize then return set_Preferre_size();
if NoRecycled() then AdjustSize(); if NoRecycled() then AdjustSize();
//InvalidateRect(nil,false);
end end
function PaintMouseDown();virtual; //°´Ï»æÖÆ function PaintMouseDown();virtual; //°´Ï»æÖÆ
begin begin
@ -2282,12 +2284,15 @@ type tVirtualCalender=class(TSLUIBASE)
if FHost then if FHost then
begin begin
ft := FHost.Font; ft := FHost.Font;
if ft then
begin
FCellWidth := ft.Width*3; FCellWidth := ft.Width*3;
FCellHeight := ft.Height+4; FCellHeight := ft.Height+4;
FTodayHeight := FCellHeight; FTodayHeight := FCellHeight;
FMonthselheight := FCellHeight; FMonthselheight := FCellHeight;
end end
end end
end
function CalcDateMatrx(); function CalcDateMatrx();
begin begin
calc_size_base(); calc_size_base();
@ -2562,12 +2567,12 @@ type TcustomLabel = class(TGraphicControl)
if ifstring(s)and caption <> s then if ifstring(s)and caption <> s then
begin begin
inherited; inherited;
//if autosize then set_Preferre_size();
if NoRecycled() then AdjustSize(); if NoRecycled() then AdjustSize();
end end
end end
function AdjustSize();override; function AdjustSize();override;
begin begin
if csLoading in ComponentState then return ;
if autosizing then return ; if autosizing then return ;
if autosize then if autosize then
set_Preferre_size(); set_Preferre_size();
@ -2575,10 +2580,8 @@ type TcustomLabel = class(TGraphicControl)
end end
function FontChanged(o);override; function FontChanged(o);override;
begin begin
if autosize then inherited;
set_Preferre_size(); return InvalidateRect(nil,false);
else
InvalidateRect(nil,false);
end end
function paint();override; function paint();override;
begin begin
@ -2763,8 +2766,13 @@ type tcustomedit=class(TCustomControl)
end end
function GetPreferredSize(w,h);override; function GetPreferredSize(w,h);override;
begin begin
w := Width;
ft := Font; ft := Font;
if not ft then return ;
if ongetpreferredsize then
begin
return class(tcontrol).GetPreferredSize(w,h);
end
w := Width;
h := ft.Height+5; h := ft.Height+5;
end end
function ContextMenu(o,e);override; function ContextMenu(o,e);override;
@ -3088,14 +3096,12 @@ type tthreeEntry=class(TCustomControl)
function GetPreferredSize(w,h);override; function GetPreferredSize(w,h);override;
begin begin
ft := font; ft := font;
if ft then if not ft then return ;
begin
fth := ft.Height; fth := ft.Height;
ftw := ft.Width; ftw := ft.Width;
w := ftw*11+fth; w := ftw*11+fth;
h := fth+4; h := fth+4;
end end
end
function paint();override; function paint();override;
begin begin
for i,v in FEntrys do for i,v in FEntrys do
@ -3120,6 +3126,7 @@ type tthreeEntry=class(TCustomControl)
end end
function AdjustSize();override; function AdjustSize();override;
begin begin
if csLoading in ComponentState then return ;
if autosizing then return ; if autosizing then return ;
if not HandleAllocated() then return ; if not HandleAllocated() then return ;
calcCtls(); calcCtls();
@ -3556,6 +3563,7 @@ type TCustomListBoxbase=class(TCustomScrollControl)
end end
function AdjustSize();override; function AdjustSize();override;
begin begin
if csLoading in ComponentState then return ;
if not HandleAllocated() then return ; if not HandleAllocated() then return ;
UpDateScrollBar(); UpDateScrollBar();
class(TWinControl).AdjustSize(); class(TWinControl).AdjustSize();
@ -4401,6 +4409,11 @@ type TCustomComboBoxbase=class(TCustomControl)
function GetPreferredSize(w,h);override; function GetPreferredSize(w,h);override;
begin begin
class(tcontrol).GetPreferredSize(w,h); class(tcontrol).GetPreferredSize(w,h);
if onGetPreferredSize then return ;
bs := BoundsRect;
cs := ClientRect;
dh := (bs[3]-bs[1])-(cs[3]-cs[1])+2;
h+=dh;
w := Width; w := Width;
end end
function Paint();override; function Paint();override;
@ -5217,6 +5230,7 @@ type TcustomToolBar=class(TCustomControl)
begin begin
ft := Font; ft := Font;
if not ft then return ; if not ft then return ;
if ongetpreferredsize then return class(tcontrol).GetPreferredSize(w,h);
ftw := ft.Width; ftw := ft.Width;
fth := ft.Height; fth := ft.Height;
brec := BoundsRect; brec := BoundsRect;
@ -5258,8 +5272,6 @@ type TcustomToolBar=class(TCustomControl)
h := fth+2+dh; h := fth+2+dh;
end end
end; end;
return ;
end else end else
begin begin
imglst := ImageList; //ͼ±ê imglst := ImageList; //ͼ±ê
@ -5291,7 +5303,6 @@ type TcustomToolBar=class(TCustomControl)
w+=dw; w+=dw;
h+=dh; h+=dh;
return ;
end end
end end
function MouseDown(o,e);override; function MouseDown(o,e);override;
@ -6075,6 +6086,11 @@ type TcustomStatusBar=class(TCustomControl)
function GetPreferredSize(w,h);override; function GetPreferredSize(w,h);override;
begin begin
class(tcontrol).GetPreferredSize(w,h); class(tcontrol).GetPreferredSize(w,h);
if ongetpreferredsize then return ;
bs := BoundsRect;
cs := ClientRect;
dh := (bs[3]-bs[1])-(cs[3]-cs[1])+2;
h+=dh;
w := Width; w := Width;
end end
published published
@ -6473,6 +6489,11 @@ type TCustomSpinEdit = class(TCustomControl)
function GetPreferredSize(w,h);override; function GetPreferredSize(w,h);override;
begin begin
class(tcontrol).GetPreferredSize(w,h); class(tcontrol).GetPreferredSize(w,h);
if ongetpreferredsize then return ;
bs := BoundsRect;
cs := ClientRect;
dh := (bs[3]-bs[1])-(cs[3]-cs[1]);
h+=dh;
w := Width; w := Width;
end end
function paint();override; function paint();override;
@ -6567,18 +6588,19 @@ type tcustomgroupbox=class(TCustomControl)
end end
function FontChanged(o);override; function FontChanged(o);override;
begin begin
ft := Font; ft := Font;
if ft then if ft then
begin begin
ftwidth := ft.Width; ftwidth := ft.Width;
ftheight := ft.Height; ftheight := ft.Height;
inherited; inherited;
InvalidateRect(nil,false);
end end
//doControlALign(); //doControlALign();
end end
function AdjustSize();override; function AdjustSize();override;
begin begin
if csLoading in ComponentState then return ;
if autosizing then return ; if autosizing then return ;
inherited; inherited;
doControlALign(); doControlALign();
@ -6985,19 +7007,6 @@ type tcustomipaddr = class(TCustomControl)
FPrev; FPrev;
FNext; FNext;
static UnLocked; static UnLocked;
{protected
function filterstring(c);override;
begin
s := text;
if s="0" and c="0" then return "";
s+=c;
if s then
begin
r := StrToIntDef(s,0);
if r<=FRange[1] then return c;
end
return "";
end }
end end
public public
function Create(AOwner);override; function Create(AOwner);override;
@ -7164,10 +7173,21 @@ type tcustomipaddr = class(TCustomControl)
function GetPreferredSize(w,h);override; function GetPreferredSize(w,h);override;
begin begin
ft := Font; ft := Font;
if not ft then return ;
if ongetpreferredsize then
begin
return class(tcontrol).GetPreferredSize(w,h);
end
ftw := ft.Width; ftw := ft.Width;
fth := ft.Height; fth := ft.Height;
w := 21*ftw+2; if FHasPort then w := 27*ftw;
h := fth+5; else w := 20*ftw;
h := fth;//+3;
bs := BoundsRect;
cs := ClientRect;
dh := (bs[3]-bs[1])-(cs[3]-cs[1])+2;
h+=dh;
w+= (bs[2]-bs[0])-(cs[2]-cs[0])+2 ;
end end
function Recycling();override; function Recycling();override;
begin begin

View File

@ -118,6 +118,7 @@ uses utslvclauxiliary;
tg_WinControl:绘图展示窗口对象,管理了一个 tg_figure 对象在paint消息的时候构造tg_canvas 对象并调用tg_figrue的paint函数实现图形的绘制 tg_WinControl:绘图展示窗口对象,管理了一个 tg_figure 对象在paint消息的时候构造tg_canvas 对象并调用tg_figrue的paint函数实现图形的绘制
其仅仅作为一个案例,用户可以按照其原理构造自己的画布对象,驱动绘制,得到图形 其仅仅作为一个案例,用户可以按照其原理构造自己的画布对象,驱动绘制,得到图形
tg_picture: 图片容器可以将图片保存为png
消息对象 消息对象
tg_evt 基类 tg_evt 基类
@ -145,6 +146,61 @@ uses utslvclauxiliary;
冒泡阶段,从目标对象向上传递到figure对象 冒泡阶段,从目标对象向上传递到figure对象
} }
{ {
//////////////////保存绘制的图片到png//////////////////////////
uses utvclgraphics;
fg := new tg_picture(800,800);
//////////设置坐标轴属性////////////////////////
axs := new tg_axes();
axs.box := false;
axs.figure := fg;
axs.title.text := "hello pie ";
axs.axises(1).visible:=false;
axs.axises(0).visible:= false;
axs.data_bounds(0) := array(-0.1,2.1);
axs.data_bounds(1) := array(-0.1,2.1);
axs.data_bounds(2) := array(-0.5,0.5);
args := array(
(pi()/4,pi()/3,0x0000ff),
(pi()/3,pi()/2,0x00ff00),
(pi()/2,pi()*3/2,0xff0000),
(pi()*3/2,pi()*9/4,0xff00ff)
);
prominentidx := 0; //凸显的块
prominentrate := 0.1; //凸显的块
for i,v in args do
begin
line := new tg_Polyline();
line.polyline_style := line.tgc_LS_filled;
line.closed := true;
c := (i=2)?1.1:1;
line.graph_data := 1+get_pie_lines(v[0],v[1],i=prominentidx,prominentrate);
line.lineinfo.bkcolor := v[2];
line.parent := axs;
end
fg.save_png(%% D:\test\ppt2.png%%); //保存
function get_pie_lines(arg1,arg2,prominent,prominentrate);
begin
stp := pi()/180;
d := 1;
r := array();
r[0] := array(0,0);
idx := 1;
for i:= arg1+(prominent?stp:0) to arg2-(prominent?stp:0) step stp do
begin
r[idx++] := array(sin(i),cos(i));
end
r[idx] :=array(0,0);
if prominent then
begin
rx := r[integer(idx/2)]*prominentrate;
for i := 0 to idx do
begin
r[i]+=rx;
end
end
return r;
end
//////////////////线图范例////////////////////////// //////////////////线图范例//////////////////////////
uses tslvcl,utvclgraphics; uses tslvcl,utvclgraphics;
app := initializeapplication(); app := initializeapplication();
@ -441,8 +497,7 @@ type tfm = class(tvcform)
gtx.onhit_at := function(o,d)begin gtx.onhit_at := function(o,d)begin
x := d["cvsx"]; x := d["cvsx"];
y := d["cvsy"]; y := d["cvsy"];
rgn := o.ExecuteCommand("text_rgn"); return o.ExecuteCommand("point_in_text",array(x,y));
return rgn and point_in_rgn(array(x,y),rgn);
end end
gtx.lineinfo.bkcolor := 0x00ff00; gtx.lineinfo.bkcolor := 0x00ff00;
gtx.parent :=line; gtx.parent :=line;
@ -489,13 +544,9 @@ type tfm = class(tvcform)
line.onhit_at := function(o,d)begin line.onhit_at := function(o,d)begin
x := d["cvsx"]; x := d["cvsx"];
y := d["cvsy"]; y := d["cvsy"];
for i,v in o.ExecuteCommand("points_in_canvas") do r := o.ExecuteCommand("hit_point",array(x,y));
begin fhitidx := r;
if abs(v[0]-x)<10 and abs(v[1]-y)<10 then return r>=0;
begin
return true;
end
end
end end
line.addEventListener("mouse_out",function(e)begin line.addEventListener("mouse_out",function(e)begin
if e.eventPhase<>2 then return ; if e.eventPhase<>2 then return ;
@ -508,16 +559,14 @@ type tfm = class(tvcform)
e.stoppropagation(); e.stoppropagation();
x := e.cvsx; x := e.cvsx;
y := e.cvsy; y := e.cvsy;
for i,v in e.target.ExecuteCommand("points_in_canvas") do if fhitidx>=0 then
begin
if abs(v[0]-x)<10 and abs(v[1]-y)<10 then
begin begin
fmovetip.Visible := true; fmovetip.Visible := true;
return fmovetip.data_idx := i; return fmovetip.data_idx := fhitidx;
end end else fmovetip.Visible := false;
end
end,true); end,true);
end end
fhitidx;
fdragtext; fdragtext;
ftextinitpos; ftextinitpos;
fmousedownpos; fmousedownpos;
@ -526,17 +575,44 @@ type tfm = class(tvcform)
fg; fg;
end end
} }
function point_in_rgn(p,rgn_); //判断点是否在区域中 function point_in_rgn(p,rgn_,method); //判断点是否在区域中
function graph_paint_lines(cvs,linestyle,xys,closed,ifo); //根据给定点绘制线 function graph_paint_lines(cvs,linestyle,xys,closed,ifo); //根据给定点绘制线
function graph_paint_points(mk,cvs,xys); //根据点信息绘制点 function graph_paint_points(mk,cvs,xys); //根据点信息绘制点
function graph_paint_boolen_value(n,v); function graph_paint_boolen_value(n,v);
function graph_paint_rec_to_points(rec); function graph_paint_rec_to_points(rec);
function r_2_a(arg);
type tg_WinControl = class(tcustomcontrol,tg_const) //绘图窗口 function a_2_r(arg);
function d2angle(v1,v2);
type tg_picture = class(tcustommemcanvas,tg_figure_container) //绘图对象
uses utslvclgdi;
function create(w,h);
begin
class(tcustommemcanvas).create(w,h);
class(tg_figure_container).create();
frect := array(0,0,w,h);
ffigure.rec_getter := function()begin
return frect;
end
end
function save_png(fn);
begin
paint();
savepng(fn);
end
private
frect;
function paint(); //绘制
begin
brush.color := 0xffffff;
FillRect(frect);
ffigure.paint_pre(self);
end
end
type tg_WinControl = class(tcustomcontrol,tg_figure_container) //绘图窗口
function create(AOwner); function create(AOwner);
begin begin
inherited; class(tcustomcontrol).create(AOwner);
ffigure := new tg_figure(); class(tg_figure_container).create();
fg_timer := new unit(utslvclstdctl).tcustomtimer(self); fg_timer := new unit(utslvclstdctl).tcustomtimer(self);
fg_timer.Interval := 300; fg_timer.Interval := 300;
fg_timer.Ontimer := thisfunction(figure_need_fresh); fg_timer.Ontimer := thisfunction(figure_need_fresh);
@ -548,19 +624,26 @@ type tg_WinControl = class(tcustomcontrol,tg_const) //
end end
function flushfigure(); function flushfigure();
begin begin
if not ffigureprepared then return ;
if f_validate_doing then return ;
if not HandleAllocated() then return ; if not HandleAllocated() then return ;
f_validate_doing := true; if not ffigureprepared then
begin
return ;
end
if f_validate_doing then
begin
return ;
end
fg_timer.start(); fg_timer.start();
end end
function paint();override; //绘制 function paint();override; //绘制
begin begin
fg_timer.stop(); fg_timer.stop();
cvs := canvas; cvs := canvas;
f_validate_doing := true;
ffigureprepared := false; ffigureprepared := false;
ffigure.paint_pre(cvs); ffigure.paint_pre(cvs);
ffigureprepared := true; ffigureprepared := true;
f_validate_doing := false;
end end
function DestroyHandle();override; function DestroyHandle();override;
begin begin
@ -619,14 +702,14 @@ type tg_WinControl = class(tcustomcontrol,tg_const) //
ffigure:=nil; ffigure:=nil;
inherited; inherited;
end end
property figure read ffigure;
private private
function figure_need_fresh(o,e); //定时刷新 function figure_need_fresh(o,e); //定时刷新
begin begin
o.stop(); o.stop();
if not ffigureprepared then return ; //没有准备好 if not ffigureprepared then return ; //没有准备好
if f_validate_doing then return;
InvalidateRect(nil,false); InvalidateRect(nil,false);
f_validate_doing := false;
end end
function e_2_array(e,tp); function e_2_array(e,tp);
begin begin
@ -646,11 +729,19 @@ type tg_WinControl = class(tcustomcontrol,tg_const) //
end end
private private
fmovecnt; fmovecnt;
ffigure;
fg_timer; fg_timer;
f_validate_doing; f_validate_doing;
ffigureprepared; ffigureprepared;
end end
type tg_figure_container = class(tg_const) //figure的容器
function create();
begin
ffigure := new tg_figure();
end
property figure read ffigure;
protected
ffigure;
end
type tg_figure = class(tg_evet_conainter) //绘图容器 type tg_figure = class(tg_evet_conainter) //绘图容器
function create(); function create();
begin begin
@ -868,6 +959,8 @@ type tg_figure = class(tg_evet_conainter) //
evt := new tg_evt_mouse(evt_mouse_in,d); //处理mouse in evt := new tg_evt_mouse(evt_mouse_in,d); //处理mouse in
dispatchEvent(evt,nds); dispatchEvent(evt,nds);
end end
end else
begin
end end
end end
end end
@ -1173,8 +1266,8 @@ type tg_axes = class(tg_base) //
end end
function create(pms); function create(pms);
begin begin
inherited;
f_changed := 0; f_changed := 0;
inherited;
ftheta := 0; ftheta := 0;
falpha := 0; falpha := 0;
flines_index := array( flines_index := array(
@ -1811,6 +1904,7 @@ type tg_axes = class(tg_base) //
tp.del_axes(self(true)); tp.del_axes(self(true));
fwilldelfigure := nil; fwilldelfigure := nil;
end end
if (v is class(tg_figure_container)) then return SetFigure(v.figure);
if v is class(tg_figure) then //添加 if v is class(tg_figure) then //添加
begin begin
fwilladdfigure := v; fwilladdfigure := v;
@ -2271,7 +2365,7 @@ type tg_canvas = class(TcustomCanvas) //
function set_clip_rect(rec); function set_clip_rect(rec);
begin begin
FaxesRec := rec; FaxesRec := rec;
set_clip_vector( rec_to_points(rec)); //set_clip_vector( rec_to_points(rec));
end end
function set_clip_vector(v); function set_clip_vector(v);
begin begin
@ -2314,7 +2408,7 @@ type tg_axis_main = class(tg_axis) //
private private
[weakref] faxes; [weakref] faxes;
end end
type tg_label_axis = class(tg_label) //坐标轴标签 type tg_label_axis = class(tg_base) //坐标轴标签
public public
function create(pms); function create(pms);
begin begin
@ -2922,6 +3016,7 @@ type tg_text = class(tg_base)
function create(pms); function create(pms);
begin begin
inherited; inherited;
ftextalign := 1;
clip_state := tgc_off; clip_state := tgc_off;
ftext := array(); ftext := array();
fdata := array(); fdata := array();
@ -2944,7 +3039,7 @@ type tg_text = class(tg_base)
end end
else cvs.axesunclip(); else cvs.axesunclip();
get_text_size(w,h,hi); get_text_size(w,h,hi);
set_lineinfo_to_canvas(cvs); modify_text_pos(x,y,w,h,ftextalign);
FPaintrect := array(x,y,x+w,y+h); FPaintrect := array(x,y,x+w,y+h);
Frgnpoints := rec_to_points(FPaintrect)[0:3]; Frgnpoints := rec_to_points(FPaintrect)[0:3];
if ffont_angle<>0 then if ffont_angle<>0 then
@ -2955,6 +3050,7 @@ type tg_text = class(tg_base)
x := 0; x := 0;
y := 0; y := 0;
end end
set_lineinfo_to_canvas(cvs);
if line_mode=tgc_on then if line_mode=tgc_on then
begin begin
rc := array(x,y,x+w,y+h); rc := array(x,y,x+w,y+h);
@ -2973,6 +3069,7 @@ type tg_text = class(tg_base)
case cmd of case cmd of
"text_rec": return (visible=tgc_on)? FPaintrect:nil; "text_rec": return (visible=tgc_on)? FPaintrect:nil;
"text_rgn": return (visible=tgc_on)? Frgnpoints:nil; //区域 "text_rgn": return (visible=tgc_on)? Frgnpoints:nil; //区域
"point_in_text": return (visible=tgc_on and Frgnpoints)? point_in_rgn(p,Frgnpoints):false; //区域
end ; end ;
return inherited; return inherited;
end end
@ -2980,13 +3077,23 @@ type tg_text = class(tg_base)
property text read ftext write set_text; //一维字符串数组 property text read ftext write set_text; //一维字符串数组
property data read fdata write set_data; //位置 x.y property data read fdata write set_data; //位置 x.y
property font_angle read ffont_angle write set_font_angle; //角度 property font_angle read ffont_angle write set_font_angle; //角度
property textalign read ftextalign write set_textalign;
private private
FPaintrect; FPaintrect;
Frgnpoints; Frgnpoints;
ftext; ftext;
fdata; fdata;
ffont_angle; ffont_angle;
ftextalign;
private private
function set_textalign(v);
begin
if v<>ftextalign and ( v in (1->9)) then
begin
ftextalign := v;
prop_changed("textalign",v);
end
end
function get_text_size(w,h,hi); function get_text_size(w,h,hi);
begin begin
fw := fontinfo.size; fw := fontinfo.size;
@ -3038,6 +3145,7 @@ type tg_label =class(tg_base) //
function create(pms); function create(pms);
begin begin
inherited; inherited;
ftextalign := 1;
clip_state := tgc_off; clip_state := tgc_off;
ftext := false; ftext := false;
flocation := tgc_by_coordinates; flocation := tgc_by_coordinates;
@ -3072,7 +3180,47 @@ type tg_label =class(tg_base) //
end end
end end
txtw := length(ftext)*fontinfo.size; txtw := length(ftext)*fontinfo.size;
rec := array(x_,y_,x_+txtw,y_+fontinfo.size); txth := fontinfo.size;
modify_text_pos(x_,y_,txtw,txth,ftextalign);
case ftextalign of
2:
begin
x_ := x_-txtw/2;
end
3:
begin
x_ := x_-txtw;
end
4:
begin
y_ := y_-txth/2;
end
5:
begin
x_ := x_-txtw/2;
y_ := y_-txth/2;
end
6:
begin
x_ := x_-txtw;
y_ := y_-txth/2;
end
7:
begin
y_ := y_-txth;
end
8:
begin
x_ := x_-txtw/2;
y_ := y_-txth;
end
9:
begin
x_ := x_-txtw;
y_ := y_-txth;
end
end;
rec := array(x_,y_,x_+txtw,y_+txth);
flabel_rgn := rec_to_points(rec)[0:3]; flabel_rgn := rec_to_points(rec)[0:3];
if ffont_angle<>0 then if ffont_angle<>0 then
begin begin
@ -3102,6 +3250,7 @@ type tg_label =class(tg_base) //
return (not p) or (p is class(tg_axis)); return (not p) or (p is class(tg_axis));
end end
published published
property textalign read ftextalign write set_textalign;
property text read ftext write set_text;//= "" property text read ftext write set_text;//= ""
property position read fposition write set_positon;//[-27.697388,-1.7130177] property position read fposition write set_positon;//[-27.697388,-1.7130177]
property location read flocation write Set_location; property location read flocation write Set_location;
@ -3118,6 +3267,7 @@ type tg_label =class(tg_base) //
//fractional_font ;//= "off" //fractional_font ;//= "off"
//font_angle ;//= 90 //font_angle ;//= 90
private private
ftextalign;
flabel_rgn; flabel_rgn;
flocation; flocation;
ftext; ftext;
@ -3127,6 +3277,14 @@ type tg_label =class(tg_base) //
fauto_position; fauto_position;
fauto_rotation; fauto_rotation;
private private
function set_textalign(v);
begin
if v<>ftextalign and ( v in (1->9)) then
begin
ftextalign := v;
prop_changed("textalign",v);
end
end
function Set_location(v); function Set_location(v);
begin begin
if flocation<>v and (v in array(tgc_by_axes,tgc_by_coordinates)) then if flocation<>v and (v in array(tgc_by_axes,tgc_by_coordinates)) then
@ -3218,6 +3376,11 @@ type tg_tips = class(tg_base) //
prop_changed("fdata_idx",pm); prop_changed("fdata_idx",pm);
end end
"tips_rec": return (visible=tgc_on )?FPaintrect:nil; //区域 "tips_rec": return (visible=tgc_on )?FPaintrect:nil; //区域
"hit_tip":
begin
if (visible<>tgc_on) then return nil;
return pointinrect(pm,FPaintrect);
end
end end
end end
function paint(cvs);override; function paint(cvs);override;
@ -3251,7 +3414,7 @@ type tg_tips = class(tg_base) //
ws := max(ws,length(v)*w+w); ws := max(ws,length(v)*w+w);
hs[i] := h+4; hs[i] := h+4;
end end
zoom_to_xyz(d[0],d[1],z,x_,y_); zoom_to_xyz(f_ps[0],f_ps[1],z,x_,y_);
sz := array(ws,sum(hs)); sz := array(ws,sum(hs));
if mark_mode = tgc_on then if mark_mode = tgc_on then
begin begin
@ -3276,9 +3439,7 @@ type tg_tips = class(tg_base) //
end end
b_x := rec[0]; b_x := rec[0];
b_y := rec[1]; b_y := rec[1];
set_fontinfo_to_canvas(cvs); set_fontinfo_to_canvas(cvs);
for i,v in ss do for i,v in ss do
begin begin
rci := array(b_x,b_y,b_x+ws,b_y+hs[i]); rci := array(b_x,b_y,b_x+ws,b_y+hs[i]);
@ -3560,6 +3721,16 @@ type tg_legend = class(tg_base) //ͼ
function executecommand(cmd,p);override; function executecommand(cmd,p);override;
begin begin
case cmd of case cmd of
"hit_legend":
begin
if (visible<>tgc_on) then return -1;
x := p[0];y := p[1];
for i,v in flegend_sub_recs do
begin
if pointinrect(p,v) then return i;
end
return -1;
end
"legend_rec":return (visible=tgc_on)? flegend_rec:nil; //整个图例区域 "legend_rec":return (visible=tgc_on)? flegend_rec:nil; //整个图例区域
"legend_sub_recs":return (visible=tgc_on)? flegend_sub_recs:nil; //各个图像的区域 "legend_sub_recs":return (visible=tgc_on)? flegend_sub_recs:nil; //各个图像的区域
end end
@ -3643,22 +3814,14 @@ type tg_legend = class(tg_base) //ͼ
prop_changed("postion",v); prop_changed("postion",v);
end end
end end
function set_text(s); function set_text(s); //图例字符串设置
begin begin
idx := 0; idx := 0;
flg := false; flg := false;
if not ifarray(s) then return ; if not ifarray(s) then return ;
for i,v in s do if ftext=s then return ;
begin ftext := s;
if not ifstring(v) then continue; prop_changed("text",s);
if v<>ftext[idx] then
begin
ftext[idx] := v;
flg++;
end
idx++;
end
if flg then prop_changed("text",s);
end end
function set_links(vs); //关联图 function set_links(vs); //关联图
begin begin
@ -3762,7 +3925,7 @@ type tg_Polyline = class(tg_graph) //
line_mode := tgc_on; line_mode := tgc_on;
mark_mode := tgc_off; mark_mode := tgc_off;
fpolyline_style := tgc_LS_interpolated;// interpolated,staircase,barplot,arrowed,filled,bar fpolyline_style := tgc_LS_interpolated;// interpolated,staircase,barplot,arrowed,filled,bar
fbar_width := 0; fbar_width := 0.3;
fdata_bounds := array((0,1),(0,1),(0,1)); fdata_bounds := array((0,1),(0,1),(0,1));
end end
function get_data_bounds();override; //数据边界 function get_data_bounds();override; //数据边界
@ -3774,35 +3937,36 @@ type tg_Polyline = class(tg_graph) //
if tgc_on<> visible then return ; if tgc_on<> visible then return ;
bx := axes.zoom_box; bx := axes.zoom_box;
tempbarw := 0; tempbarw := 0;
z0 := bx[2,0];
fface_rgn := array();
if clip_state=tgc_on then if clip_state=tgc_on then
begin begin
//cvs.axesclip(); //cvs.axesclip();
fface_rgn := array();
pts := array();
for i,v in rec_to_points( array(bx[0,0],bx[1,0],bx[0,1],bx[1,1])) do for i,v in rec_to_points( array(bx[0,0],bx[1,0],bx[0,1],bx[1,1])) do
begin begin
zoom_to_xyz(v[0],v[1],bx[2,0],x,y); zoom_to_xyz(v[0],v[1],z0,x,y);
pts[i] := array(x,y); fface_rgn[i] := array(x,y);
end end
cvs.clip_rgn(pts); cvs.clip_rgn(fface_rgn);
end else end else
begin begin
cvs.axesunclip(); cvs.axesunclip();
end end
xys := array(); xys := array();
set_lineinfo_to_canvas(cvs);
ys := array(); ys := array();
for i,v in fgraph_data do for i,v in fgraph_data do
begin begin
if not zoom_to_xyz(v[0],v[1],bx[2,0],x,y) then return ; if not zoom_to_xyz(v[0],v[1],z0,x,y) then return ;
if not(tempbarw) and fbar_width>0 then ////////处理bar的宽度/////// if not(tempbarw) and fbar_width>0 then ////////处理bar的宽度///////
begin begin
zoom_to_xyz((v[0]+fbar_width/2),v[1],bx[2,0],xtemp,ytemp); b := get_abs_barwidth();
zoom_to_xyz((v[0]+b/2),v[1],z0,xtemp,ytemp);
xtemp-=x; xtemp-=x;
ytemp-=y; ytemp-=y;
tempbarw := array(); tempbarw := array();
tempbarw[0] := fbar_width*(xtemp)/(abs(xtemp)+abs(ytemp)); tempbarw[0] := b*(xtemp)/(abs(xtemp)+abs(ytemp));
tempbarw[1] := fbar_width*(ytemp)/(abs(xtemp)+abs(ytemp)); tempbarw[1] := b*(ytemp)/(abs(xtemp)+abs(ytemp));
end end
xys[i] := array(integer(x),integer(y)); xys[i] := array(integer(x),integer(y));
case fpolyline_style of case fpolyline_style of
@ -3814,8 +3978,10 @@ type tg_Polyline = class(tg_graph) //
end; end;
end end
fline_points_in_canvas := xys; fline_points_in_canvas := xys;
//zoom_to_xyz(0,0,0,x,y); pinfo := array("line_mode":line_mode,"bar_width":tempbarw,"color":lineinfo.color,"bkcolor":lineinfo.bkcolor,"xy0":ys,"bar_rgns",array());
paint_lines(cvs,fpolyline_style,xys,fclosed,array("line_mode":line_mode,"bar_width":tempbarw,"color":lineinfo.color,"bkcolor":lineinfo.bkcolor,"xy0":ys)); set_lineinfo_to_canvas(cvs);
paint_lines(cvs,fpolyline_style,xys,fclosed,pinfo);
fline_bar_rgn := pinfo["bar_rgns"];
mk := markinfo.clone(); mk := markinfo.clone();
if mark_mode=tgc_on and mk.size>2 then if mark_mode=tgc_on and mk.size>2 then
begin begin
@ -3826,7 +3992,29 @@ type tg_Polyline = class(tg_graph) //
function executecommand(cmd,p);override; function executecommand(cmd,p);override;
begin begin
case cmd of case cmd of
"hit_point":
begin
if not(fface_rgn and point_in_rgn(p,fface_rgn)) then return -1;
case fpolyline_style of
tgc_LS_bar:
begin
for i,v in fline_bar_rgn do
begin
if point_in_rgn(p,v) then return i;
end
end else
begin
sz := markinfo.size+5;
for i,v in fline_points_in_canvas do
begin
if sqrt(sum((p-v)^2))<sz then return i;
end
end
end;
return -1;
end
"points_in_canvas":return (visible=tgc_on)? fline_points_in_canvas:array(); //数据散点 "points_in_canvas":return (visible=tgc_on)? fline_points_in_canvas:array(); //数据散点
"points_in_range":return (visible=tgc_on)? point_in_rgn(p,fline_points_in_canvas):false;
end; end;
return inherited; return inherited;
end end
@ -3847,7 +4035,7 @@ type tg_Polyline = class(tg_graph) //
dis := ceil((rec[2]-rec[0])/5); dis := ceil((rec[2]-rec[0])/5);
xys := array((rec[0]+dis,y0),(rec[0]+4*dis,y0)); xys := array((rec[0]+dis,y0),(rec[0]+4*dis,y0));
set_lineinfo_to_canvas(cvs); set_lineinfo_to_canvas(cvs);
paint_lines(cvs,tgc_LS_interpolated,xys,0,array("line_mode":line_mode,"bar_width":array(fbar_width,0),"color":lineinfo.color,"bkcolor":lineinfo.bkcolor)); paint_lines(cvs,tgc_LS_interpolated,xys,0,array("line_mode":line_mode,"bar_width":array(get_abs_barwidth(),0),"color":lineinfo.color,"bkcolor":lineinfo.bkcolor));
mk := markinfo.clone(); mk := markinfo.clone();
if mark_mode=tgc_on and mk.size>2 then if mark_mode=tgc_on and mk.size>2 then
begin begin
@ -3857,9 +4045,11 @@ type tg_Polyline = class(tg_graph) //
end end
property closed read fclosed write set_line_closed;//= "off" 封闭 property closed read fclosed write set_line_closed;//= "off" 封闭
property polyline_style read fpolyline_style write set_polyline_style;//= "0" 线型 property polyline_style read fpolyline_style write set_polyline_style;//= "0" 线型
property bar_width read fbar_width write fbar_width;//= "0" 柱状宽度 property bar_width read fbar_width write set_bar_width;//= "0" 柱状宽度
private private
fline_points_in_canvas; fline_points_in_canvas;
fline_bar_rgn;
fface_rgn;
fdata_bounds; fdata_bounds;
fclosed; fclosed;
fforeground; fforeground;
@ -3899,6 +4089,26 @@ type tg_Polyline = class(tg_graph) //
end end
end end
private private
function get_abs_barwidth();//获得
begin
if fbar_width>0 and fbar_width<=1 then
begin
dx := (fdata_bounds[0,1]-fdata_bounds[0,0])/(length(fgraph_data)-1);
if zoom_to_xyz(0,0,nil,x1,y1) and zoom_to_xyz(dx,0,nil,x2,y2) then
begin
return (abs(x1-x2)+abs(y1-y2))*fbar_width;
end
end
return fbar_width;
end
function set_bar_width(v);
begin
if v<>fbar_width and v>0 then
begin
fbar_width := v;
prop_changed("bar_width",nv);
end
end
function set_line_closed(v); function set_line_closed(v);
begin begin
if not tg_boolen_value(v,nv) then return ; if not tg_boolen_value(v,nv) then return ;
@ -3958,7 +4168,7 @@ type tg_line_info = class(tg_const) //
end end
"width","size": "width","size":
begin begin
if FWidth<>v and ifnumber(v) then if FWidth<>v and ifnumber(v) and (v>=0) then
begin begin
FWidth := v; FWidth := v;
if fonwer then fonwer.invalidate(); if fonwer then fonwer.invalidate();
@ -3974,13 +4184,12 @@ type tg_line_info = class(tg_const) //
end end
"bkcolor": "bkcolor":
begin begin
if fbkcolor<>v and ifnumber(v) then if fbkcolor<>v and (ifnumber(v) or ifnil(v)) then //设置颜色
begin begin
fbkcolor := v; fbkcolor := v;
if fonwer then fonwer.invalidate(); if fonwer then fonwer.invalidate();
end end
end end
end; end;
end end
[weakref]fonwer; [weakref]fonwer;
@ -4027,7 +4236,7 @@ type tg_font_info = class(tg_const) //
end end
"size": "size":
begin begin
if fsize<>v and ifnumber(v) then if fsize<>v and ifnumber(v) and (v>5) then
begin begin
fsize := v; fsize := v;
if fonwer then fonwer.invalidate(); if fonwer then fonwer.invalidate();
@ -4043,7 +4252,7 @@ type tg_font_info = class(tg_const) //
end end
"bkcolor": "bkcolor":
begin begin
if fbackground<>v and ifnumber(v) then if fbackground<>v and (ifnumber(v) or ifnil(v)) then
begin begin
fbackground := v; fbackground := v;
if fonwer then fonwer.invalidate(); if fonwer then fonwer.invalidate();
@ -4114,7 +4323,7 @@ type tg_mark_info = class(tg_const) //
end end
"bkcolor": "bkcolor":
begin begin
if fbackground<>v and ifnumber(v) then if fbackground<>v and (ifnumber(v) or ifnil(v)) then
begin begin
fbackground := v; fbackground := v;
if fonwer then fonwer.invalidate(); if fonwer then fonwer.invalidate();
@ -4228,7 +4437,7 @@ type tg_base = class(TNode,tg_evet_conainter) //
bcl := li.bkcolor; bcl := li.bkcolor;
if ifnumber(bcl) then if ifnumber(bcl) then
begin begin
cvs.brush.color := li.bkcolor; cvs.brush.color := bcl;
cvs.brush.Style := tgc_BS_SOLID; cvs.brush.Style := tgc_BS_SOLID;
end end
else else
@ -4733,22 +4942,27 @@ begin
begin begin
b_w_x := integer(ifo["bar_width"][0]/2); b_w_x := integer(ifo["bar_width"][0]/2);
b_w_y := integer(ifo["bar_width"][1]/2); b_w_y := integer(ifo["bar_width"][1]/2);
cvs.brush.color := ifo["bkcolor"]; //cvs.brush.color := ifo["bkcolor"];
wflg := (abs(b_w_x)+abs(b_w_y))>0.1;
bar_rgns := array();
for i,v in xys do for i,v in xys do
begin begin
if b_w_x>=1 or b_w_y>1 then if wflg then
begin begin
v1 := array(v[0]-b_w_x,v[1]-b_w_y); v1 := array(v[0]-b_w_x,v[1]-b_w_y);
v2 := array(v[0]+b_w_x,v[1]+b_w_y); v2 := array(v[0]+b_w_x,v[1]+b_w_y);
v3 := array(ifo["xy0",i,0]+b_w_x,ifo["xy0",i,1]+b_w_y); v3 := array(ifo["xy0",i,0]+b_w_x,ifo["xy0",i,1]+b_w_y);
v4 := array(ifo["xy0",i,0]-b_w_x,ifo["xy0",i,1]-b_w_y); v4 := array(ifo["xy0",i,0]-b_w_x,ifo["xy0",i,1]-b_w_y);
cvs.draw_polygon().points(array(v1,v2,v3,v4)).draw(); barrec := array(v1,v2,v3,v4);
bar_rgns[i] := barrec;
cvs.draw_polygon().points(barrec).draw();
end else end else
begin begin
cvs.moveto(array(v[0],v[1])); cvs.moveto(array(v[0],v[1]));
cvs.lineto(array(ifo["xy0",i,0],ifo["xy0",i,1])); cvs.lineto(array(ifo["xy0",i,0],ifo["xy0",i,1]));
end end
end end
ifo["bar_rgns"] := bar_rgns;
paint_lines(cvs,o.tgc_LS_interpolated,xys,cls,ifo); paint_lines(cvs,o.tgc_LS_interpolated,xys,cls,ifo);
end end
o.tgc_LS_arrowed: o.tgc_LS_arrowed:
@ -4776,14 +4990,13 @@ begin
end end
o.tgc_LS_filled: o.tgc_LS_filled:
begin begin
if cls=o.tgc_on then if cls=o.tgc_on then
begin begin
cvs.brush.color := ifo["bkcolor"]; //cvs.brush.color := ifo["bkcolor"];
cvs.draw_polygon().points(xys).draw(); cvs.draw_polygon().points(xys).draw();
end else end else
begin begin
cvs.brush.color := ifo["color"]; //cvs.brush.color := ifo["color"];
for i,v in xys do for i,v in xys do
begin begin
if i=0 then continue; if i=0 then continue;
@ -5025,11 +5238,56 @@ begin
if vi is class(tg_graph_base) then if vi is class(tg_graph_base) then
begin begin
bds := vi.get_data_bounds(); bds := vi.get_data_bounds();
if i=0 then
begin
d := bds;
end else
mg_bds(bds,d); mg_bds(bds,d);
end end
end end
return d; return d;
end end
function modify_text_pos(x_,y_,txtw,txth,al);
begin
case al of
2:
begin
x_ := x_-txtw/2;
end
3:
begin
x_ := x_-txtw;
end
4:
begin
y_ := y_-txth/2;
end
5:
begin
x_ := x_-txtw/2;
y_ := y_-txth/2;
end
6:
begin
x_ := x_-txtw;
y_ := y_-txth/2;
end
7:
begin
y_ := y_-txth;
end
8:
begin
x_ := x_-txtw/2;
y_ := y_-txth;
end
9:
begin
x_ := x_-txtw;
y_ := y_-txth;
end
end;
end
function get_rect_at_corner(x,y,w,h,itv,flg,mvx,mvy); //计算围绕点的区域位置 function get_rect_at_corner(x,y,w,h,itv,flg,mvx,mvy); //计算围绕点的区域位置
begin begin
//0左上 1右上 2 右下 3 左下 //0左上 1右上 2 右下 3 左下
@ -5106,7 +5364,10 @@ begin
end end
function d2angle(v1,v2); //角度计算 function d2angle(v1,v2); //角度计算
begin begin
return arccos(sum(v1*v2)/vectorsize(v1)/vectorsize(v2)); r := arccos(sum(v1*v2)/vectorsize(v1)/vectorsize(v2));
return r;
if r>0 or r<0 then return r;
return 0;
end end
function vectorsize(v); //向量长度 function vectorsize(v); //向量长度
begin begin
@ -5116,27 +5377,51 @@ function rec_to_points(rec);
begin begin
return array(rec[array(0,1)],rec[array(2,1)],rec[array(2,3)],rec[array(0,3)],rec[array(0,1)]); return array(rec[array(0,1)],rec[array(2,1)],rec[array(2,3)],rec[array(0,3)],rec[array(0,1)]);
end end
function point_in_rgn(p,rgn_); //判断点是否在区域中 function point_in_rgn(p,rgn_,method); //夹角法
begin begin
if (method = 1) or ifnil(method) then return point_in_polygon(p, rgn_);
arg := 0; arg := 0;
rgn := rgn_ union array(rgn_[0]); rgn := rgn_ union array(rgn_[0]);
for i := 1 to length(rgn)-1 do len := length(rgn);
if len<4 then return 0;
for i := 1 to len-1 do
begin begin
p1 := rgn[i-1]; p1 := rgn[i-1];
p2 := rgn[i]; p2 := rgn[i];
v1 := array(p1[0]-p[0],p1[1]-p[1]); v1 := array(p1[0]-p[0],p1[1]-p[1]);
v2 := array(p2[0]-p[0],p2[1]-p[1]); v2 := array(p2[0]-p[0],p2[1]-p[1]);
argi := d2angle(v1,v2); argi := d2angle(v1,v2);
arg+=argi; if argi>0 or argi<0 then arg+=argi;
end end
return (abs(arg/2-pi())<0.01); return (abs(arg/2-pi())<0.01);
end end
function point_in_polygon(point, polygon);//射线法
begin
x0 := point[0];
y0 := point[1];
ct := 0;
len := length(polygon)-1;
if len<3 then return 0;
for i ,v in polygon do
begin
x1 := v[0];
y1 := v[1];
if i=len then v2 := polygon[0];
else v2 := polygon[i+1];
x2 := v2[0];
y2 := v2[1];
if ((y1 > y0) <> (y2 > y0)) and x0 < ((x2 - x1) * (y0 - y1) / (y2 - y1) + x1) then ct += 1;
end
return (ct % 2) =1;
end
function rgn_points_trans(pts,ag); function rgn_points_trans(pts,ag);
begin begin
x := pts[0,0];
y := pts[0,1];
for i := 1 to length(pts)-1 do for i := 1 to length(pts)-1 do
begin begin
p_trans(pts[i,0]-pts[0,0],pts[i,1]-pts[0,1],ag,px,py); p_trans(pts[i,0]-x,pts[i,1]-y,ag,px,py);
pts[i] := array(pts[0,0]+px,pts[0,1]+py); pts[i] := array(x+px,y+py);
end end
end end
function tg_get_true_idx(idx); function tg_get_true_idx(idx);

File diff suppressed because it is too large Load Diff

Binary file not shown.

Binary file not shown.