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

添加绘图扩展库

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
designer/ctl_mgr/vcldesginer.tpj
View File

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

6
designer/teditorform.tsf
View File

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

3
designer/udesignerproject.tsf
View File

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

1
designer/utslcodeeditor.tsf
View File

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

48
designer/utslvcldcomponents.tsf
View File

@ -378,6 +378,7 @@ type TDComponent = class()
end
o.Component := nil;
ndp.Owner.SetSel(ndp);
return true;
end
end
function cutclick(o,e);virtual; //剪切节点
@ -389,11 +390,34 @@ type TDComponent = class()
function pasteclick(o,e);virtual; //粘贴节点
begin
cp:=o.Component;
if not cp then exit;
if not cp then
begin
MessageBoxA("容器节点错误！","粘贴",0,nd.owner);
exit;
end
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.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
function deleteclick(o,e);virtual; //控件删除操作
begin
@ -716,6 +740,22 @@ type TDComponent = class()
@param(e)(tuievent) 消息对象 %%
**}
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);
if not(AOwner is class(TComponent)) then exit;
@ -2210,6 +2250,7 @@ type TDToolBar = class(TDComponent)
function Create(AOwner);override;
begin
inherited;
excludepropertys := array("childsizing");
end
function ComponentCreater(tnode,owner);override;
begin
@ -2253,6 +2294,7 @@ type TDcoolBar = class(TDComponent)
function Create(AOwner);override;
begin
inherited;
excludepropertys := array("childsizing");
end
function ComponentCreater(tnode,owner);override;
begin

81
designer/utslvcldesigner.tsf
View File

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

BIN
editor-install.exe
View File

Binary file not shown.

57
funcext/tvclib/cstructurelib.tsf
View File

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

19
funcext/tvclib/t_children_sizer.tsf
View File

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

10
funcext/tvclib/tcomponent.tsf
View File

@ -342,6 +342,16 @@ public //
AOwner.InsertComponent(Self);
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(); //获得域根节点
begin
if fasdomain then return self(true);

38
funcext/tvclib/tcontrol.tsf
View File

@ -48,6 +48,7 @@ type tcontrol = class(tcomponent)
FOnDblClick; //Ë«»÷
FOnDragDrop;
FOnDragOver;
fonGetPreferredSize;
FOnSize;
FOnMove;
//FOnEditingDone;
@ -1016,8 +1017,8 @@ type tcontrol = class(tcomponent)
if (o is class(TWinControl)) and o.WsPopUp then return ;
if (Align=alNone) then
begin
//p := Parent ;
//if p and p.childsizing.layout>0 then return p.AdjustSize();
p := Parent ;
if p and p.childsizing.layout>0 then return p.AdjustSize();
AdjustSize();
end
end
@ -1029,8 +1030,8 @@ type tcontrol = class(tcomponent)
if not NoRecycled() then return ;
CallMessgeFunction(OnSize,o,e);
DoWMSIZE(o,e);
//p := Parent ;
//if p and p.childsizing.layout>0 then return p.AdjustSize();
p := Parent ;
if p and p.childsizing.layout>0 then return p.AdjustSize();
AdjustSize();
end
function CMCursorChanged(o,e):CM_CURSORCHANGED;virtual;
@ -1485,6 +1486,8 @@ type tcontrol = class(tcomponent)
procedure AdjustSize();virtual; // smart calling DoAutoSize
begin
//includestate(FControlFlags,cfAutoSizeNeeded);
if csLoading in ComponentState then return ;
If csDestroying in Componentstate Then return ;
if fautosizing then
begin
return ;
@ -1503,12 +1506,32 @@ type tcontrol = class(tcomponent)
function GetPreferredSize(w,h);virtual;
begin
ft := Font;
if ft then
if not ft then return ;
if fonGetPreferredSize then
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;
w := ft.Width*(length(c)+2);
h := ft.Height+3;
end
h := ft.Height+4;
end
protected
function set_Preferre_size();
@ -1562,6 +1585,7 @@ type tcontrol = class(tcomponent)
**}
//property MouseEntered read FMouseEntered;
property OnSize:eventhandler read FOnSize write FOnSize;
property ongetpreferredsize:eventhandler read fonGetPreferredSize write fonGetPreferredSize;
property OnMove:eventhandler read FOnMove write FOnMove;
property OnMouseMove:eventhandler read FOnMouseMove Write FOnMouseMove;
property OnPopupMenu:eventhandler read FOnPopupMenu write FOnPopupMenu;

6
funcext/tvclib/tgraphiccontrol.tsf
View File

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

26
funcext/tvclib/tslvcl.tsf
View File

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

16
funcext/tvclib/twincontrol.tsf
View File

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

1
funcext/tvclib/utslvclcoolbar.tsf
View File

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

9
funcext/tvclib/utslvclevent.tsf
View File

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

82
funcext/tvclib/utslvclstdctl.tsf
View File

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

447
funcext/tvclib/utvclgraphics.tsf
View File

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

2115
funcext/tvclib/utvclgraphicsext.tsf Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
tsleditor.exe
View File

Binary file not shown.

BIN
tslvcltool.exe
View File

Binary file not shown.