diff --git a/designer/ctl_mgr/vcldesginer.tpj b/designer/ctl_mgr/vcldesginer.tpj index ad1aaf3..d50ddb3 100644 --- a/designer/ctl_mgr/vcldesginer.tpj +++ b/designer/ctl_mgr/vcldesginer.tpj @@ -49,11 +49,6 @@ array( "type":"form", "dir":"" ), - "t_searchdir_mgr":( - "name":"t_searchdir_mgr", - "type":"form", - "dir":"" - ), "tsl1":( "name":"tsl1", "type":"tsl", diff --git a/designer/teditorform.tsf b/designer/teditorform.tsf index 25ff1b1..fd51075 100644 --- a/designer/teditorform.tsf +++ b/designer/teditorform.tsf @@ -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 diff --git a/designer/udesignerproject.tsf b/designer/udesignerproject.tsf index 4408d25..99b4edd 100644 --- a/designer/udesignerproject.tsf +++ b/designer/udesignerproject.tsf @@ -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 diff --git a/designer/utslcodeeditor.tsf b/designer/utslcodeeditor.tsf index 2e799bb..179fce9 100644 --- a/designer/utslcodeeditor.tsf +++ b/designer/utslcodeeditor.tsf @@ -4558,6 +4558,7 @@ type TEditList=class(TComboBox) begin inherited; width := 280; + Height := 26; dropdowncount := 30; FMaxCoder := 20; ReadONly := false; diff --git a/designer/utslvcldcomponents.tsf b/designer/utslvcldcomponents.tsf index ac8ad80..ce57608 100644 --- a/designer/utslvcldcomponents.tsf +++ b/designer/utslvcldcomponents.tsf @@ -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 @@ -717,7 +741,23 @@ type TDComponent = class() **} inherited;" ); - SetDefalutEvent(ev,true); + 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; c := WndClass(); if c is class(TComponent) then @@ -737,7 +777,7 @@ type TDComponent = class() {** @explan(说明)获得改变的属性%% **} - if FCwnd then return FCwnd.GetChangedPublish(f); + if FCwnd then return FCwnd.GetChangedPublish(f); return array(); end function GetPublishProperties();virtual; @@ -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 diff --git a/designer/utslvcldesigner.tsf b/designer/utslvcldesigner.tsf index a501bc0..acd6a02 100644 --- a/designer/utslvcldesigner.tsf +++ b/designer/utslvcldesigner.tsf @@ -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 - begin + 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 diff --git a/editor-install.exe b/editor-install.exe index e019105..ea288fd 100644 Binary files a/editor-install.exe and b/editor-install.exe differ diff --git a/funcext/tvclib/cstructurelib.tsf b/funcext/tvclib/cstructurelib.tsf index 1628544..8734546 100644 --- a/funcext/tvclib/cstructurelib.tsf +++ b/funcext/tvclib/cstructurelib.tsf @@ -7,7 +7,8 @@ Interface 概览: 天软科技 20171215 添加注释 - 20240308 整理代码 + 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,11 +761,18 @@ 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_(); end else - ret[i]:= _getvalue_(i); + ret[i]:= _getvalue_(i); end return ret; end @@ -2257,13 +2298,25 @@ begin end else if(tp1="user")then begin - ret[i,5]:= "userarray"; - size := 1; + ret[i,5]:= "userarray"; sz := 0; - dp1 := min(alim,tpbyte); + 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); diff --git a/funcext/tvclib/t_children_sizer.tsf b/funcext/tvclib/t_children_sizer.tsf index 4357e9e..e9499ea 100644 --- a/funcext/tvclib/t_children_sizer.tsf +++ b/funcext/tvclib/t_children_sizer.tsf @@ -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); diff --git a/funcext/tvclib/tcomponent.tsf b/funcext/tvclib/tcomponent.tsf index 26cd2ef..22f9e42 100644 --- a/funcext/tvclib/tcomponent.tsf +++ b/funcext/tvclib/tcomponent.tsf @@ -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); diff --git a/funcext/tvclib/tcontrol.tsf b/funcext/tvclib/tcontrol.tsf index 5f0d101..4e835d1 100644 --- a/funcext/tvclib/tcontrol.tsf +++ b/funcext/tvclib/tcontrol.tsf @@ -48,6 +48,7 @@ type tcontrol = class(tcomponent) FOnDblClick; //双击 FOnDragDrop; FOnDragOver; + fonGetPreferredSize; FOnSize; FOnMove; //FOnEditingDone; @@ -564,7 +565,7 @@ type tcontrol = class(tcomponent) begin nft.changedkeys((fts .<> ftc)); wkactl.FontChanged(); - end + end ifop := true; end end @@ -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; @@ -1484,7 +1485,9 @@ type tcontrol = class(tcomponent) public procedure AdjustSize();virtual; // smart calling DoAutoSize begin - //includestate(FControlFlags,cfAutoSizeNeeded); + //includestate(FControlFlags,cfAutoSizeNeeded); + if csLoading in ComponentState then return ; + If csDestroying in Componentstate Then return ; if fautosizing then begin return ; @@ -1493,7 +1496,7 @@ type tcontrol = class(tcomponent) sf := self(true); if (sf is class(TWinControl)) and sf.WsPopUp then return ; if Parent then - begin + begin if Parent.autosize then Parent.AdjustSize(); else if Align<>alNone then Parent.DoControlAlign(); end @@ -1503,13 +1506,33 @@ type tcontrol = class(tcomponent) function GetPreferredSize(w,h);virtual; begin ft := Font; - if ft then - begin - c := caption; - w := ft.Width*(length(c)+2); - h := ft.Height+3; - end - end + 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+4; + end protected function set_Preferre_size(); begin @@ -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; diff --git a/funcext/tvclib/tgraphiccontrol.tsf b/funcext/tvclib/tgraphiccontrol.tsf index 62942b9..5009634 100644 --- a/funcext/tvclib/tgraphiccontrol.tsf +++ b/funcext/tvclib/tgraphiccontrol.tsf @@ -83,12 +83,14 @@ type tgraphiccontrol = class(TControl) function GetPreferredSize(w,h);override; begin ft := Font; - if ft then - begin - c := caption; - w := ft.Width*(max(length(c),1))+2; - h := ft.Height+3; + 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 function InvalidateRect(rec,f); begin diff --git a/funcext/tvclib/tslvcl.tsf b/funcext/tvclib/tslvcl.tsf index 47d522d..2df18e8 100644 --- a/funcext/tvclib/tslvcl.tsf +++ b/funcext/tvclib/tslvcl.tsf @@ -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); diff --git a/funcext/tvclib/twincontrol.tsf b/funcext/tvclib/twincontrol.tsf index 616502a..1169a22 100644 --- a/funcext/tvclib/twincontrol.tsf +++ b/funcext/tvclib/twincontrol.tsf @@ -2587,7 +2587,11 @@ type TWinControl = class(tcontrol) inherited; end; function AdjustSize();override; - begin + begin + If csDestroying in Componentstate Then + begin + return ; + end if autosizing then begin return ; @@ -2596,7 +2600,11 @@ type TWinControl = class(tcontrol) if IsUpDating() then begin return ; - end + 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 diff --git a/funcext/tvclib/utslvclcoolbar.tsf b/funcext/tvclib/utslvclcoolbar.tsf index 08f91d3..bb53e09 100644 --- a/funcext/tvclib/utslvclcoolbar.tsf +++ b/funcext/tvclib/utslvclcoolbar.tsf @@ -177,6 +177,7 @@ type tcustomcoolbar=class(tcustomcontrol) end function AdjustSize();override; begin + if csLoading in ComponentState then return ; inherited; doControlALign(); InvalidateRect(nil,false); diff --git a/funcext/tvclib/utslvclevent.tsf b/funcext/tvclib/utslvclevent.tsf index 8cdf197..7ead8c7 100644 --- a/funcext/tvclib/utslvclevent.tsf +++ b/funcext/tvclib/utslvclevent.tsf @@ -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(说明) 按键消息 diff --git a/funcext/tvclib/utslvclstdctl.tsf b/funcext/tvclib/utslvclstdctl.tsf index 0f87618..f11cc2e 100644 --- a/funcext/tvclib/utslvclstdctl.tsf +++ b/funcext/tvclib/utslvclstdctl.tsf @@ -526,12 +526,16 @@ type tcustombtn = class(TCustomControl) // begin dc.font.color := bc; end - 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,10 +2284,13 @@ type tVirtualCalender=class(TSLUIBASE) if FHost then begin ft := FHost.Font; - FCellWidth := ft.Width*3; - FCellHeight := ft.Height+4; - FTodayHeight := FCellHeight; - FMonthselheight := FCellHeight; + if ft then + begin + FCellWidth := ft.Width*3; + FCellHeight := ft.Height+4; + FTodayHeight := FCellHeight; + FMonthselheight := FCellHeight; + end end end function CalcDateMatrx(); @@ -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,11 +2580,9 @@ type TcustomLabel = class(TGraphicControl) end function FontChanged(o);override; begin - if autosize then - set_Preferre_size(); - else - InvalidateRect(nil,false); - end + inherited; + return InvalidateRect(nil,false); + end function paint();override; begin dc := canvas; @@ -2763,9 +2766,14 @@ type tcustomedit=class(TCustomControl) end function GetPreferredSize(w,h);override; begin - w := Width; ft := Font; - h := ft.Height+5; + 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; begin @@ -3088,13 +3096,11 @@ type tthreeEntry=class(TCustomControl) function GetPreferredSize(w,h);override; begin ft := font; - if ft then - begin - fth := ft.Height; - ftw := ft.Width; - w := ftw*11+fth; - h := fth+4; - end + if not ft then return ; + fth := ft.Height; + ftw := ft.Width; + w := ftw*11+fth; + h := fth+4; end function paint();override; begin @@ -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; @@ -6566,19 +6587,20 @@ type tcustomgroupbox=class(TCustomControl) ///////////////////////////////// end function FontChanged(o);override; - begin - + 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 diff --git a/funcext/tvclib/utvclgraphics.tsf b/funcext/tvclib/utvclgraphics.tsf index 3211d41..ff1ae71 100644 --- a/funcext/tvclib/utvclgraphics.tsf +++ b/funcext/tvclib/utvclgraphics.tsf @@ -117,7 +117,8 @@ uses utslvclauxiliary; data array(x,y,z) 相对于坐标系的位置 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 - begin - fmovetip.Visible := true; - return fmovetip.data_idx := i; - end - end + if fhitidx>=0 then + begin + fmovetip.Visible := true; + 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 HandleAllocated() then return ; + 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(); + fg_timer.stop(); cvs := canvas; + f_validate_doing := true; ffigureprepared := false; ffigure.paint_pre(cvs); - ffigureprepared := true; + 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 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; @@ -2257,7 +2351,7 @@ type tg_canvas = class(TcustomCanvas) // function destroy(); begin Handle := 0; - faxesrgn := nil; + faxesrgn := nil; end property axesvector read faxesvector write set_clip_vector; property axesrec read FaxesRec write set_clip_rect; @@ -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 @@ -2954,7 +3049,8 @@ type tg_text = class(tg_base) rgn_points_trans(Frgnpoints,-ffont_angle); x := 0; y := 0; - end + 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 @@ -3275,10 +3438,8 @@ type tg_tips = class(tg_base) // cvs.draw_rect.rect(rec).draw(); end b_x := rec[0]; - b_y := rec[1]; - - set_fontinfo_to_canvas(cvs); - + 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(); + //cvs.axesclip(); + 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))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; 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(); + v4 := array(ifo["xy0",i,0]-b_w_x,ifo["xy0",i,1]-b_w_y); + 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: @@ -4775,15 +4989,14 @@ begin end end o.tgc_LS_filled: - begin - + 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(); - mg_bds(bds,d); + 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); diff --git a/funcext/tvclib/utvclgraphicsext.tsf b/funcext/tvclib/utvclgraphicsext.tsf new file mode 100644 index 0000000..e534afe --- /dev/null +++ b/funcext/tvclib/utvclgraphicsext.tsf @@ -0,0 +1,2115 @@ +unit utvclgraphicsext; +interface +uses utslvclauxiliary,utvclgraphics;//,utslvclconstant; +{ +//玫瑰图 +uses tslvcl,utvclgraphics,utvclgraphicsext; +app := initializeapplication(); +app.createform(class(tfm),fm); +fm.show(); +app.run(); +type tfm=class(tvcform) + function create(aowner); + begin + inherited; + caption := "玫瑰图"; + width := 800; + Height := 800; + fg := new tg_WinControl(self); + fg.parent := self; + fg.Align := alClient; + //////////设置坐标轴属性//////////////////////// + axs := new tg_axes(); + axs.figure := fg.figure; + axs.title.text := "玫瑰图"; + args := array(('name':'a','value':300) + ,('name':'b','value':200) + ,('name':'c','value':500) + ,('name':'d','value':700) + ,('name':'e','value':300) + ,('name':'f','value':200) + ,('name':'g','value':500) + ,('name':'h','value':700) + ,('name':'i','value':300) + ,('name':'j','value':200) + ,('name':'k','value':500) + ,('name':'l','value':700) + ); + line := new tg_Polypie(); + line.graph_data := args; + line.pie_type := "rose"; //'ring'; + line.parent := axs; + //绘制图例 + lg := new tg_legend(); + lg.parent := axs; + //lg.location := lg.tgc_by_axes; + lg.postion := array(-0.11,0.7); + //lg.text := array("aaa","bbb",'ccc','ddd'); + lg.links := array(line); + //构造提示标签 + fmovetip := new tg_tips(); + fmovetip.parent := line; + fmovetip.box_mode := true; //false; + fmovetip.display_function := function(o,ps,d) + begin + p := o.parent; + if not fshowpos then return; + if p then + begin + dd := p.get_graph_data_by_idx(o.data_idx); + p.xyz_to_zoom(fshowpos[0],fshowpos[1],nil,x1,y1); + ps := array(x1,y1); + d := array(dd["name"],tostn(dd["value"])); + end + end + //设置提示数据点 + line.onhit_at := function(o,d) + begin + x := d["cvsx"]; + y := d["cvsy"]; + r := o.ExecuteCommand("hit_part",array(x,y)); + r := r >= 0; + return r; + end + line.addEventListener("mouse_in", function(e) + begin + if e.eventPhase <> 2 then return; + e.stoppropagation(); + end + ,true); + line.addEventListener("mouse_out", function(e) + begin + if e.eventPhase <> 2 then return; + fmovetip.Visible := false; + e.stoppropagation(); + end + ,true); + line.addEventListener("mouse_move", function(e) + begin + if e.eventPhase <> 2 then return; + e.stoppropagation(); + x := e.cvsx; + y := e.cvsy; + idx := e.target.ExecuteCommand("hit_part",array(x,y)); + if idx >= 0 then + begin + fmovetip.data_idx := idx; + fshowpos := array(x,y); + fmovetip.Visible := true; + end + end + ,true); + end + fmovetip; + fg; + fshowpos; +end + +//雷达图 +uses tslvcl,utvclgraphics,utvclgraphicsext; +app := initializeapplication(); +app.createform(class(tfm),fm); +fm.show(); +app.run(); +type tfm = class(tvcform) + function create(aowner); + begin + inherited; + caption := "雷达图"; + width := 800; + Height := 800; + fg := new tg_WinControl(self); + fg.parent := self; + fg.Align := alClient; + //////////设置坐标轴属性//////////////////////// + axs := new tg_axes(); + axs.box := true; + axs.figure := fg.figure; + axs.title.text := "雷达图"; + line := new tg_Polyradar(); + indicator := array( + ('name':'射击','max':300), + ('name':'游泳','max':200), + ('name':'篮球','max':500), + ('name':'足球','max':700), + ('name':'跑步','max':300), + ('name':'举重','max':200) + ); + indicator := array( + ('name':'射击','max':110), + ('name':'游泳','max':110), + ('name':'篮球','max':110), + ('name':'足球','max':110), + ('name':'跑步','max':110), + ('name':'举重','max':110) + ); + args := array( + ('name':'一班','value':array(90, 80, 85, 85, 95, 95)), + ('name':'二班','value':array(85, 65, 65, 90, 100, 70)), + ('name':'三班','value':array(70, 60, 99, 50, 90, 80)) + ); + + line.graph_data := args; + line.indicator := indicator; + line.parent := axs; + lg := new tg_legend(); + lg.parent := axs; + lg.postion := array(-0.11,0.7); + lg.links := array(line); + end + fg; +end +//树图 +uses tslvcl,utvclgraphics,utvclgraphicsext; +app := initializeapplication(); +app.createform(class(tfm),fm); +fm.show(); +app.run(); +type tfm = class(tvcform) + function create(aowner); + begin + inherited; + Caption := "树图"; + fg := new tg_WinControl(self); + fg.Caption := "树图"; + fg.parent := self; + fg.Align := alClient; + //////////设置坐标轴属性//////////////////////// + axs := new tg_axes(); + axs.figure := fg.figure; + axs.title.text := "树图"; + //设置线型属性 + line := new tg_Polytree(); + line.parent := axs; + line.lineinfo.color := 0x0000ff; + line.markinfo.bkcolor := 0x00ff00; + line.markinfo.color := 0x0000ff; + line.mark_mode := true; + line.markinfo.size := 5; + line.show_text := true;//展示节点文本 + d := array(); + idx := 0; + line.graph_data := array('name':'111','show': true,'children':( + ('name':'222','children':(('name':'333','children':(('name':'111','children':( + ('name':'222','children':(('name':'333','children':(('name':'111','children':( + ('name':'222','children':(('name':'333','children':(('name':'111','children':( + ('name':'222','children':(('name':'333','children':()),('name':'444','children':(('name':'111','children':( + ('name':'222','children':(('name':'333','children':()),('name':'444','children':(('name':'111','children':( + ('name':'222','children':(('name':'333','children':()),('name':'444','children':()))), + ('name':'555','children':(('name':'666','children':()),('name':'777','children':()))), + ('name':'888','children':(('name':'999','children':()),('name':'xxx','children':()),('name':'zzz','children':()))) + ) + ))))), + ('name':'555','children':(('name':'666','show': false,'children':()),('name':'777','children':()))), + ('name':'888','children':(('name':'999','children':()),('name':'xxx','children':()),('name':'zzz','children':()))) + ) + ))))), + ('name':'555','children':(('name':'666','children':()),('name':'777','children':()))), + ('name':'888','children':(('name':'999','children':()),('name':'xxx','children':()),('name':'zzz','children':(('name':'111','children':( + ('name':'222','children':(('name':'333','children':()),('name':'444','children':()))), + ('name':'555','children':(('name':'666','children':()),('name':'777','children':()))), + ('name':'888','children':(('name':'999','children':()),('name':'xxx','children':()),('name':'zzz','children':()))) + ) + ))))) + ) + ))),('name':'444','children':()))), + ('name':'555','children':(('name':'666','children':()),('name':'777','children':()))), + ('name':'888','children':(('name':'999','children':()),('name':'xxx','children':()),('name':'zzz','children':(('name':'111','children':( + ('name':'222','children':(('name':'333','children':()),('name':'444','children':()))), + ('name':'555','children':(('name':'666','children':()),('name':'777','children':(('name':'111','children':( + ('name':'222','children':(('name':'333','children':()),('name':'444','children':()))), + ('name':'555','children':(('name':'666','children':()),('name':'777','children':()))), + ('name':'888','children':(('name':'999','children':()),('name':'xxx','children':()),('name':'zzz','children':()))) + ) + ))))), + ('name':'888','children':(('name':'999','children':()),('name':'xxx','children':()),('name':'zzz','children':()))) + ) + ))))) + ) + ))),('name':'444','children':()))), + ('name':'555','children':(('name':'666','children':()),('name':'777','children':()))), + ('name':'888','children':(('name':'999','children':()),('name':'xxx','children':()),('name':'zzz','children':()))) + ) + ))),('name':'444','children':(('name':'111','children':( + ('name':'222','children':(('name':'333','children':()),('name':'444','children':(('name':'111','children':( + ('name':'222','children':(('name':'333','children':()),('name':'444','children':()))), + ('name':'555','children':(('name':'666','children':()),('name':'777','children':()))), + ('name':'888','children':(('name':'999','children':()),('name':'xxx','children':()),('name':'zzz','children':()))) + ) + ))))), + ('name':'555','children':(('name':'666','children':()),('name':'777','children':()))), + ('name':'888','children':(('name':'999','children':()),('name':'xxx','children':()),('name':'zzz','children':()))) + ) + ))))), + ('name':'555','children':(('name':'666','children':()),('name':'777','children':(('name':'111','children':( + ('name':'222','children':(('name':'333','children':()),('name':'444','children':()))), + ('name':'555','children':(('name':'666','children':()),('name':'777','children':()))), + ('name':'888','children':(('name':'999','children':()),('name':'xxx','children':()),('name':'zzz','children':()))) + ) + ))))), + ('name':'888','children':(('name':'999','children':(('name':'111','children':( + ('name':'222','children':(('name':'333','children':()),('name':'444','children':()))), + ('name':'555','children':(('name':'666','children':(('name':'111','children':( + ('name':'222','children':(('name':'333','children':()),('name':'444','children':()))), + ('name':'555','children':(('name':'666','children':()),('name':'777','children':()))), + ('name':'888','children':(('name':'999','children':()),('name':'xxx','children':()),('name':'zzz','children':(('name':'111','children':( + ('name':'222','children':(('name':'333','children':()),('name':'444','children':()))), + ('name':'555','children':(('name':'666','children':()),('name':'777','children':()))), + ('name':'888','children':(('name':'999','children':()),('name':'xxx','children':()),('name':'zzz','children':(('name':'111','children':( + ('name':'222','children':(('name':'333','children':()),('name':'444','children':()))), + ('name':'555','children':(('name':'666','children':()),('name':'777','children':()))), + ('name':'888','children':(('name':'999','children':()),('name':'xxx','children':()),('name':'zzz','children':()))) + ) + ))))) + ) + ))))) + ) + ))),('name':'777','children':()))), + ('name':'888','children':(('name':'999','children':()),('name':'xxx','children':()),('name':'zzz','children':(('name':'111','children':( + ('name':'222','children':(('name':'333','children':()),('name':'444','children':()))), + ('name':'555','children':(('name':'666','children':()),('name':'777','children':()))), + ('name':'888','children':(('name':'999','children':()),('name':'xxx','children':()),('name':'zzz','children':(('name':'111','children':( + ('name':'222','children':(('name':'333','children':()),('name':'444','children':()))), + ('name':'555','children':(('name':'666','children':()),('name':'777','children':()))), + ('name':'888','children':(('name':'999','children':()),('name':'xxx','children':()),('name':'zzz','children':()))) + ) + ))))) + ) + ))))) + ) + ))),('name':'xxx','children':(('name':'111','children':( + ('name':'222','children':(('name':'333','children':()),('name':'444','children':()))), + ('name':'555','children':(('name':'666','children':()),('name':'777','children':()))), + ('name':'888','children':(('name':'999','children':()),('name':'xxx','children':()),('name':'zzz','children':(('name':'111','children':( + ('name':'222','children':(('name':'333','children':()),('name':'444','children':()))), + ('name':'555','children':(('name':'666','children':()),('name':'777','children':()))), + ('name':'888','children':(('name':'999','children':()),('name':'xxx','children':()),('name':'zzz','children':(('name':'111','children':( + ('name':'222','children':(('name':'333','children':()),('name':'444','children':()))), + ('name':'555','children':(('name':'666','children':()),('name':'777','children':()))), + ('name':'888','children':(('name':'999','children':()),('name':'xxx','children':()),('name':'zzz','children':(('name':'111','children':( + ('name':'222','children':(('name':'333','children':()),('name':'444','children':()))), + ('name':'555','children':(('name':'666','children':()),('name':'777','children':()))), + ('name':'888','children':(('name':'999','children':()),('name':'xxx','children':()),('name':'zzz','children':()))) + ) + ))))) + ) + ))))) + ) + ))))) + ) + ))),('name':'zzz','children':(('name':'777','children':()))))) + ) + ); + + end + fg; +end +//k线图 +uses tslvcl,utvclgraphics,utvclgraphicsext; +app := initializeapplication(); +app.createform(class(tfm),fm); +fm.show(); +app.run(); +type tfm = class(tvcform) + function create(aowner); + begin + inherited; + Caption := "k线图"; + fg := new tg_WinControl(self); + fg.parent := self; + fg.Align := alClient; + //////////设置坐标轴属性//////////////////////// + axs := new tg_axes(); + axs.figure := fg.figure; + axs.title.text := "k线图 "; + axs.title.fontinfo.size := 15; + axs.title.fontinfo.color := 0xff0000; + axs.x_label.text := "日期"; + axs.grid(0).Width := 2; + axs.grid(0).color := 0x0ff0f0; + axs.auto_ticks(0) := false; + //设置线型属性 + line := new tg_Polycandlestick(); + line.lineinfo.color := 0xff0000; + line.bullcolor := 0x0000ff; + line.bearcolor := 0x00ff00; + line.line_mode := false; + line.graph_data := array(("2017-10-24",1.1,1,1.3,0.3),("2017-10-25",3,4,4.5,2.5),("2017-10-26",5,8,9,3),("2017-10-27",10,8,9,3),("2017-10-28",5,8,9,8.5),("2017-10-29",5,8,9,3) + ,("2017-10-30",5,8,9,3),("2017-10-31",5,8,9,3),("2017-11-01",5,8,9,3)); + line.parent := axs; + end + fg; +end +//盒须图 +uses tslvcl,utvclgraphics,utvclgraphicsext; +app := initializeapplication(); +app.createform(class(tfm),fm); +fm.show(); +app.run(); +type tfm = class(tvcform) + function create(aowner); + begin + inherited; + Caption := "盒须图"; + fg := new tg_WinControl(self); + fg.Caption := "盒须图"; + fg.parent := self; + fg.Align := alClient; + //////////设置坐标轴属性//////////////////////// + axs := new tg_axes(); + axs.figure := fg.figure; + axs.title.text := "盒须图"; + axs.title.fontinfo.size := 15; + axs.title.fontinfo.color := 0xff0000; + axs.axises(1).tics_color := 0x0000ff; + axs.axises(1).fontinfo.size := 8; + axs.axises(1).lineinfo.color := 0x00ff00; + axs.grid(0).Width := 2; + axs.grid(0).color := 0x0ff0f0; + line := new tg_Polyboxplot(); + line.lineinfo.color := 0xff0000; + line.graph_data := array((850, 740, 900, 1070, 930, 850, 950, 980, 980, 880, 1000, 980, 930, 650, 760, 810, 1000, 1000, 960, 960), + (960, 940, 960, 940, 880, 800, 850, 880, 900, 840, 830, 790, 810, 880, 880, 830, 800, 790, 760, 800), + (880, 880, 880, 860, 720, 720, 620, 860, 970, 950, 880, 910, 850, 870, 840, 840, 850, 840, 840, 840), + (890, 810, 810, 820, 800, 770, 760, 740, 750, 760, 910, 920, 890, 860, 880, 720, 840, 850, 850, 780), + (890, 840, 780, 810, 760, 810, 790, 810, 820, 850, 870, 870, 810, 740, 810, 940, 950, 800, 810, 870) + ); + line.parent := axs; + end + fg; +end +//旭日图 +uses tslvcl,utvclgraphics,utvclgraphicsext; +app := initializeapplication(); +app.createform(class(tfm),fm); +fm.show(); +app.run(); +type tfm = class(tvcform) + function create(aowner); + begin + inherited; + caption := '旭日图'; + width := 800; + Height := 800; + fg := new tg_WinControl(self); + fg.parent := self; + fg.Align := alClient; + //////////设置坐标轴属性//////////////////////// + axs := new tg_axes(); + axs.box := true; + axs.figure := fg.figure; + axs.title.text :="旭日图"; + args := array( + 'name': '组织', + 'children': ( + ( + 'name': '总经理办公室', + 'children': ( + ( + 'name': '财务部', + "itemstyle":("color":0xff00ff), + 'value': 15, + 'children': ( + ('name': '会计', 'value': 2), + ( + 'name': '财务主管', + 'value': 5, + 'children': ( + ('name': '财务专员', 'value': 2) + ) + ), + ('name': '财务助理', 'value': 4) + ) + ), + ('name': '市场部', 'children': (('name': '市场经理', 'value': 4))), + ( + 'name': '人力资源部', + 'value': 10, + 'children': ( + ('name': '人事经理', 'value': 5, 'itemStyle': ('color': 'yellow')), + ('name': '招聘专员', 'value': 1) + ) + ) + ) + ), + ( + 'name': '技术部', + 'children': ( + ( + 'name': '研发部', + 'children': ( + ('name': '项目经理', 'value': 3), + ( + 'name': '开发工程师', + 'value': 4, + 'children': (('name': '实习生', 'value': 2)) + ) + ) + ) + ) + ), + ( + 'name': '销售部', + 'children': ( + ( + 'name': '销售经理', + 'children': ( + ('name': '销售代表', 'value': 1), + ('name': '销售助理', 'value': 2) + ) + ) + ) + ) + ) + ); + line := new tg_Polysunburst(); + line.graph_data := args; + line.parent := axs; + end + fg; +end +} +type tg_Polycandlestick = class(tg_graph) //k线图 + function create(pms); + begin + inherited; + fbarrgn := array(); + clip_state := tgc_on; + line_mode := tgc_on; + mark_mode := tgc_off; + fbar_width := 0.3; + fdata_bounds := array((0,1),(0,1),(0,1)); + end + function get_data_bounds();override; //边界 + begin + fdata_bounds[0,1] := length(fgraph_data); + return fdata_bounds; + end + function paint(cvs);override; //绘制 + begin + if tgc_on<> visible then return ; + tempbarw := 0; + bx := axes.zoom_box; + if clip_state=tgc_on then + begin + pts := array(); + for i,v in graph_paint_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); + end + cvs.clip_rgn(pts); + end else + begin + cvs.axesunclip(); + end + xys := array(); + wick_y := array(); + set_lineinfo_to_canvas(cvs); + xlbl := array("0"); + xcd := array(0); + for i,v in fgraph_data do + begin + xlbl[i+1] := v[0]; + xcd[i+1] := i+1; + end + axes.axises(0).tics_coord := xcd; + axes.axises(0).tics_labels := xlbl; + ys := array(); + for i,v in fgraph_data do + begin + if not zoom_to_xyz(i+1,v[1],bx[2,0],x,y) then return ; + xys[i] := array(integer(x),integer(y)); + if not zoom_to_xyz(i+1,v[3],bx[2,0],x,y) then return ; + wick_y[i][0] := array(integer(x),integer(y)); + if not zoom_to_xyz(i+1,v[4],bx[2,0],x,y) then return ; + wick_y[i][1] := array(integer(x),integer(y)); + zoom_to_xyz(i+1,v[2],bx[2,0],x,y) ; + ys[i] := array(integer(x),integer(y)); + if not zoom_to_xyz(i+1,v[1],bx[2,0],x,y) then return ; + if not(tempbarw) and fbar_width>0 then ////////计算宽度/////// + begin + b := get_abs_barwidth(); + zoom_to_xyz((i+1+b/2),v[1],bx[2,0],xtemp,ytemp); + xtemp-=x; + ytemp-=y; + tempbarw := array(); + tempbarw[0] := b*(xtemp)/(abs(xtemp)+abs(ytemp)); + tempbarw[1] := b*(ytemp)/(abs(xtemp)+abs(ytemp)); + end + end + fline_points_in_canvas := xys; + fbarrgn := array(); + pinfo := array("line_mode":line_mode,"bar_width":tempbarw,"color":lineinfo.color,"bullcolor":fbullcolor,"bearcolor":fbearcolor,"bkcolor":lineinfo.bkcolor,"xy0":ys,"wick_y": wick_y); + paint_candlestick(cvs,0,xys,0,fgraph_data,pinfo); + fbarrgn := pinfo["barrgn"]; + inherited; + end + function executecommand(cmd,p);override; + begin + case cmd of + "hit_point": + begin + for i,v in fbarrgn do + begin + if point_in_rgn(p,v) then return i; + end + return -1; + end + "points_in_canvas":return (visible=tgc_on)? fline_points_in_canvas:nil; //??????? + end; + return inherited; + end + published + property bar_width read fbar_width write set_barwidth;//宽度 + property bullcolor read fbullcolor write set_bullcolor;//牛色 + property bearcolor read fbearcolor write set_bearcolor;//熊色 + private + fline_points_in_canvas; + fbarrgn; + fdata_bounds; + fforeground; + fbackground; + fbar_width; + fbullcolor; + fbearcolor; + protected + function set_graph_data(d);override; //设置数据 + begin + if d<>fgraph_data then + begin + //fx := d[:,0]; + fy := d[:,3]; + fdata_bounds[0,0] := 0; + fdata_bounds[1,0] := minvalue(fy); + //fdata_bounds[0,1] := 10; + fdata_bounds[1,1] := maxvalue(fy); + inherited; + end + end + private + function get_abs_barwidth();//获得 + begin + if fbar_width>0 and fbar_width<=1 then + begin + if zoom_to_xyz(0,0,nil,x1,y1) and zoom_to_xyz(1,0,nil,x2,y2) then + begin + return (abs(x1-x2)+abs(y1-y2))*fbar_width; + end + end + return fbar_width; + end + function set_barwidth(v);//设置宽度 + begin + if (v<>fbar_width) and (v>0) then + begin + fbar_width := v; + prop_changed("barwidth",v); + end + end + function set_bullcolor(v);//牛色 + begin + //if not graph_paint_boolen_value(v,nv) then return ; + if v<>fbullcolor and ifnumber(v) then + begin + fbullcolor := v; + prop_changed("bullcolor",v); + end + end + function set_bearcolor(v);//熊色 + begin + //if not graph_paint_boolen_value(v,nv) then return ; + if v<>fbearcolor and ifnumber(v) then + begin + fbearcolor := v; + prop_changed("bearcolor",v); + end + end +end +type tg_Polyboxplot = class(tg_graph) //盒须图 + function create(pms); + begin + inherited; + fbarrgn := array(); + clip_state := tgc_on; + line_mode := tgc_on; + mark_mode := tgc_off; + fbar_width := 0.3; + fdata_bounds := array((0,1),(0,1),(0,1)); + end + function get_data_bounds();override; //?????? + begin + return fdata_bounds; + end + function paint(cvs);override; //??? + begin + if tgc_on<> visible then return ; + bx := axes.zoom_box; + if clip_state=tgc_on then + begin + //cvs.axesclip(); + pts := array(); + for i,v in graph_paint_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); + end + cvs.clip_rgn(pts); + end else + begin + cvs.axesunclip(); + end + xys := array(); + medians := array(); + wick_y := array(); + outliers := array(); + inliers := array(()); + set_lineinfo_to_canvas(cvs); + ys := array(); + for i,v in fgraph_data do + begin + q1 := Quartile(v,1); + q2 := Quartile(v,2); + q3 := Quartile(v,3); + iqr := q3-q1; + maximum := q3+(1.5*iqr); + minimum := q1-(1.5*iqr); + inliers[i] := array(); + for j,w in v do + begin + len := length(outliers); + if w>=minimum and w<=maximum then + begin + inlen := length(inliers[i]); + inliers[i][inlen] := w; + end + else if w < minimum then + begin + if not zoom_to_xyz(i+1,w,bx[2,0],x,y) then return ; + outliers[len] := array(integer(x),integer(y)); + + end + else + begin + if not zoom_to_xyz(i+1,w,bx[2,0],x,y) then return ; + outliers[len] := array(integer(x),integer(y)); + end + end + + if not zoom_to_xyz(i+1,q1,bx[2,0],x,y) then return ; + xys[i] := array(integer(x),integer(y)); + if not zoom_to_xyz(i+1,q2,bx[2,0],x,y) then return ; + medians[i] := array(integer(x),integer(y)); + if not zoom_to_xyz(i+1,MaxValue(inliers[i]),bx[2,0],x,y) then return ; + wick_y[i][0] := array(integer(x),integer(y)); + if not zoom_to_xyz(i+1,MinValue(inliers[i]),bx[2,0],x,y) then return ; + wick_y[i][1] := array(integer(x),integer(y)); + zoom_to_xyz(i+1,q3,bx[2,0],x,y) ; + ys[i] := array(integer(x),integer(y)); + + if not zoom_to_xyz(i+1,q1,bx[2,0],x,y) then return ; + if not(tempbarw) and fbar_width>0 then ////////????bar????/////// + begin + b := get_abs_barwidth(); + zoom_to_xyz((i+1+b/2),q1,bx[2,0],xtemp,ytemp); + xtemp-=x; + ytemp-=y; + tempbarw := array(); + tempbarw[0] := b*(xtemp)/(abs(xtemp)+abs(ytemp)); + tempbarw[1] := b*(ytemp)/(abs(xtemp)+abs(ytemp)); + end + end + fline_points_in_canvas := xys; + pinfo := array("line_mode":line_mode,"bar_width":tempbarw,"color":lineinfo.color,"bkcolor":lineinfo.bkcolor,"xy0":ys,"wick_y": wick_y, "medians": medians); + paint_boxplot(cvs,0,xys,0,pinfo); + fbarrgn := pinfo["barrgn"]; + mk := markinfo.clone(); + if mark_mode=tgc_on and mk.size>2 then + begin + graph_paint_points(mk,cvs,outliers); + end + inherited; + end + function executecommand(cmd,p);override; + begin + case cmd of + "points_in_canvas":return (visible=tgc_on)? fline_points_in_canvas:nil; //??????? + end; + return inherited; + end + function get_legend_size(w,h);virtual; //?????????? + begin + mk := markinfo; + h := fontinfo.size+4; + w := 100; + if mark_mode=tgc_on then + begin + h := max(10,mk.size+4); + w := 5*h; + end + end + function paint_legend(cvs,rec);override; //??????? + begin + y0 := ceil(rec[1]+(rec[3]-rec[1])/2); + dis := ceil((rec[2]-rec[0])/5); + xys := array((rec[0]+dis,y0),(rec[0]+4*dis,y0)); + set_lineinfo_to_canvas(cvs); + graph_paint_lines(cvs,tgc_LS_interpolated,xys,0,array("line_mode":line_mode,"bar_width":fbar_width,"color":lineinfo.color,"bkcolor":lineinfo.bkcolor)); + mk := markinfo.clone(); + if mark_mode=tgc_on and mk.size>2 then + begin + xys := array((rec[0]+dis*2,y0),(rec[0]+3*dis,y0)); + graph_paint_points(mk,cvs,xys); + end + end + property bar_width read fbar_width write set_bar_width;//= "0" ?????? + private + fbarrgn; + fline_points_in_canvas; + fdata_bounds; + fforeground; + fbackground; + fbar_width; + protected + function set_graph_data(d);override; //???????? + begin + if d<>fgraph_data then + begin + fdata_bounds[0,0] := 0; + fdata_bounds[0,1] := length(d); + fdata_bounds[1,0] := minvalue(minvalue(d)); + fdata_bounds[1,1] := maxvalue(maxvalue(d)); + inherited; + end + end + private + function get_abs_barwidth();//获得 + begin + if fbar_width>0 and fbar_width<=1 then + begin + if zoom_to_xyz(0,0,nil,x1,y1) and zoom_to_xyz(1,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 +end +type tg_Polypie = class(tg_graph) //饼图 + function create(pms); + begin + inherited; + clip_state := tgc_on; + fcolormap := array(0xc67054, 0x75cc91, 0x58c8fa, 0x6666ee, 0xdec073, 0x72a23b, 0x5284fc, 0xb4609a, 0xcc7cea); + line_mode := tgc_on; + mark_mode := tgc_off; + fpie_type := 'pie'; + fdata_bounds := array((0,1),(0,1),(0,1)); + fsection_info := array(); + end + function get_data_bounds();override; //?????? + begin + return fdata_bounds; + end + function paint(cvs);override; + begin + if tgc_on<> visible then return ; + bx := axes.zoom_box; + if clip_state=tgc_on then + begin + //cvs.axesclip(); + pts := array(); + for i,v in graph_paint_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); + end + cvs.clip_rgn(pts); + end else + begin + cvs.axesunclip(); + end + xys := array(); + medians := array(); + wick_y := array(); + outliers := array(); + inliers := array(()); + set_lineinfo_to_canvas(cvs); + ys := array(); + total := 0; + total_value_list := array(); + for i,v in fgraph_data do + begin + total := total + v['value']; + total_value_list[i] := v['value']; + end + pie_radian := data_process(fgraph_data, total); + prominentidx := 1;//-1; // ?????????? + prominentrate := 0; // ?????????? + pie_data := array(); + fpei_parts_data := array(); + for i,v in pie_radian do + begin + if fpie_type='pie' then + begin + fsection_info[i]['StartAngle'] := v[0]; + fsection_info[i]['EndAngle'] := v[1]; + fsection_info[i]['MinRadius'] := 0; + fsection_info[i]['MaxRadius' ] := 1.2; + pie_data := 1+get_pie_lines(v[0],v[1],i=prominentidx,prominentrate); + end + else if fpie_type='ring' then + begin + pie_data := 1+get_pie_ring_lines(v[0],v[1],0.7,0.4,i=prominentidx,prominentrate); + end + else if fpie_type='rose' then + begin + proportion := total_value_list[i] / MaxValue(total_value_list); + pie_data := 1+get_rose_lines(v[0],v[1],i=prominentidx,prominentrate, proportion); + end + xys := array(); + inner_xyz := array(); + for j,v in pie_data do + begin + if not zoom_to_xyz(v[0],v[1],bx[2,0],x,y) then return ; + xys[j] := array(integer(x),integer(y)); + end + index := i%length(fcolormap); + item_color := fcolormap[index]; + paint_pie(cvs,xys,array("line_mode":line_mode,"bar_width":tempbarw,"color":item_color,"bkcolor":item_color,"xy0":ys)); + fpei_parts_data[i] := xys; + end + end + function executecommand(cmd,p);override; + begin + case cmd of + "hit_part": + begin + for i,v in fpei_parts_data do + begin + if point_in_rgn(p,v,true) then return i; + end + return -1; + end + "get_section_info":return (visible=tgc_on)? fsection_info:nil; //??????? + "points_in_section":return (visible=tgc_on)? IsPointInPieSection(p):false; //??????? + end; + return inherited; + end + function get_legend_size(w,h);override; //?????????? + begin + sz := fontinfo.size; + h := (sz+6)*max(1,length(pie_radian))+5; + w := 0; + ws := 5; + for i,v in fgraph_data do + begin + si :=v["name"]; + if ifstring(si) then ws := max((length(si))*sz,ws); + end + w +=ws; + w +=35; + end + function paint_legend(cvs,rec);override; //??????? + begin + set_lineinfo_to_canvas(cvs); + set_fontinfo_to_canvas(cvs); + h := fontinfo.size+6;// + ((h-fontinfo.size)/2); + y0 := rec[1]+h; + for i,v in fgraph_data do + begin + index := i%length(fcolormap); + item_color := fcolormap[index]; + xys := array((rec[0]+2,y0+i*h),(rec[0]+25,y0+i*h),(rec[0]+25,y0-fontinfo.size+i*h),(rec[0]+2,y0-fontinfo.size+i*h)); + paint_pie(cvs,xys,array("line_mode":line_mode,"bar_width":fbar_width,"color":item_color,"bkcolor":item_color)); + cvs.textout(v["name"],array(rec[0]+30,y0+(i-1)*h)); + end + end + property color_map read fcolormap write set_colormap;// ??? + property pie_type read fpie_type write fpie_type;// ??????? + property section_info read fsection_info;//= "0" ?????? + private + pie_radian; + fpei_parts_data; + fdata_bounds; + fpie_type; + fforeground; + fbackground; + fsection_info; + fcolormap; + protected + function set_graph_data(d);override; //???????? + begin + if d<>fgraph_data then + begin + fdata_bounds[0,0] := 0; + fdata_bounds[1,0] := 0; + fdata_bounds[0,1] := 2; + fdata_bounds[1,1] := 2; + inherited; + end + end + private + function set_colormap(v); + begin + if ifarray(v) and v<>fcolormap then + begin + fcolormap := v; + end + end + function IsPointInPieSection(opt); + begin + px := opt[0]; // 鼠标的x坐标 + py := opt[1]; // 鼠标的y坐标 + cx := opt[2]; // 圆心的x坐标 + cy := opt[3]; // 圆心的y坐标 + arc := opt[4]; // 当前扇区的信息，包括起始和结束角度、最小和最大半径 + xyz_to_zoom(opt[0], opt[1], z, px, py); + + // 计算鼠标点相对于圆心的角度，范围在 [-π, π] + pointAngle := CalculateAngle(px, py, cx, cy); + // 将角度规范化到 [0, 2π)，确保是从12点钟方向顺时针方向 + if pointAngle < 0 then + pointAngle := pointAngle + 2 * pi(); + // 计算鼠标点到圆心的距离 + pointDistance := Sqrt(Sqr(px - cx) + Sqr(py - cy)); + // 获取并规范化扇形的起始和结束角度到 [0, 2π) + normalizedArcStart := arc['StartAngle'] ; + normalizedArcEnd := arc['EndAngle']; + // 检查角度是否在扇形范围内 + if normalizedArcStart > normalizedArcEnd then + // 处理跨越0度的情况 + isInAngleRange := (pointAngle >= normalizedArcStart) or (pointAngle <= normalizedArcEnd) + else + // 正常情况 + isInAngleRange := (pointAngle >= normalizedArcStart) and (pointAngle <= normalizedArcEnd); + // 检查点是否在扇形的半径范围内 + isInRadiusRange := (pointDistance >= arc['MinRadius']) and (pointDistance <= arc['MaxRadius']); + // 综合判断鼠标点是否在当前扇区内 + Result := isInAngleRange and isInRadiusRange; + return Result; // 返回最终判断结果 + end; + function CalculateAngle(px, py, cx, cy: Real): Real; + begin + return ArcTan2( px - cx,py - cy); + end; + function data_process(data, total); // + begin + currentAngle := 0; + segments := array(); + for i,v in data do + begin + segments[i][0] := currentAngle; + segments[i][1] := currentAngle + (v['value'] / total) * 2 * pi(); + currentAngle := segments[i][1]; + end + return segments; + end + function get_pie_lines(arg1,arg2,prominent,prominentrate); //????????????? + begin + stp := pi()/360; + 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 + function get_pie_points(arg1, arg2, prominent, prominentrate, num_radii, num_angles); + begin + stp_angle := (arg2 - arg1) / num_angles; // 根据角度范围划分的角度步长 + r := array(); // 初始化结果数组 + idx := 0; + // 遍历不同的半径 + for radius_idx := 0 to num_radii do + begin + radius := radius_idx / num_radii; // 计算当前点的半径，范围在[0, 1] + + // 遍历角度范围内的点 + for angle := arg1 + (prominent ? stp_angle : 0) to arg2 - (prominent ? stp_angle : 0) step stp_angle do + begin + r[idx++] := array(sin(angle) * radius, cos(angle) * radius); // 生成点的坐标并存储 + end + end + // 如果需要突出显示中间区域 + if prominent then + begin + rx := r[integer(idx / 2)] * prominentrate; // 突出显示中间的点 + for i := 0 to idx - 1 do + begin + r[i] += rx; // 偏移点位置，使其更突出 + end + end + return r; // 返回包围区域内的所有点 + end + function get_rose_lines(arg1,arg2,prominent,prominentrate,proportion); //??????????????? + begin + stp := pi()/360; + 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)*proportion,cos(i)*proportion); + 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 +end +type tg_Polyradar = class(tg_graph) //雷达图 + function create(pms); + begin + findicator_texts := array(); + inherited; + clip_state := tgc_on; + fcolormap := array(0xc67054, 0x75cc91, 0x58c8fa, 0x6666ee, 0xdec073, 0x72a23b, 0x5284fc, 0xb4609a, 0xcc7cea); + line_mode := tgc_on; + mark_mode := tgc_off; + fdata_bounds := array((0,1),(0,1),(0,1)); + end + function get_data_bounds();override; //数据边界 + begin + return fdata_bounds; + end + function paint(cvs);override; //绘制 + begin + if tgc_on<> visible then return ; + bx := axes.zoom_box; + if clip_state=tgc_on then + begin + //cvs.axesclip(); + pts := array(); + for i,v in graph_paint_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); + end + cvs.clip_rgn(pts); + end else + begin + cvs.axesunclip(); + end + xys := array(); + medians := array(); + wick_y := array(); + outliers := array(); + inliers := array(()); + set_lineinfo_to_canvas(cvs); + ys := array(); + radar_indicator_radian := data_indicator_process(findicator); + draw_radar_grid(cvs,radar_indicator_radian); + + for j,w in fgraph_data do + begin + vl := array(); + for jj,vj in w['value'] do + begin + vl[jj] := vj/findicator[jj]['max']; + end + cl := fcolormap[j%length(fcolormap)]; + cvs.pen.color := cl; + for i,v in 1+get_radar_cyclings(radar_indicator_radian,vl) do + begin + zoom_to_xyz(v[0],v[1],z,x,y) ; + xys[i] := array(x,y); + end + cvs.brush.color := cl; + cvs.brush.style := BS_SOLID; + cvs.alpha := 60+j*10; + cvs.draw_polygon().points(xys).draw(); + cvs.alpha := 255; + cvs.draw_polyline().points(xys).draw(); + end + end + function executecommand(cmd,p);override; + begin + case cmd of + "points_in_canvas":return (visible=tgc_on)? fline_points_in_canvas:nil; //??????? + end; + return inherited; + end + + function get_legend_size(w,h);override; //图例大小 + begin + sz := fontinfo.size; + h := (sz+6)*max(1,length(fgraph_data))+5; + w := 0; + ws := 5; + for i,v in fgraph_data do + begin + si :=v["name"]; + if ifstring(si) then ws := max((length(si))*sz,ws); + end + w +=ws; + w +=35; + end + function paint_legend(cvs,rec);override; //图例绘制 + begin + set_lineinfo_to_canvas(cvs); + set_fontinfo_to_canvas(cvs); + h := fontinfo.size+6;// + ((h-fontinfo.size)/2); + y0 := rec[1]+h; + for i,v in fgraph_data do + begin + index := i%length(fcolormap); + item_color := fcolormap[index]; + xys := array((rec[0]+2,y0+i*h),(rec[0]+25,y0+i*h),(rec[0]+25,y0-fontinfo.size+i*h),(rec[0]+2,y0-fontinfo.size+i*h)); + paint_pie(cvs,xys,array("line_mode":line_mode,"bar_width":fbar_width,"color":item_color,"bkcolor":item_color)); + cvs.textout(v["name"],array(rec[0]+30,y0+(i-1)*h)); + end + end + property color_map read fcolormap write fcolormap; + property indicator read findicator write set_indicator;// 指标轴 + private + fline_points_in_canvas; + fdata_bounds; + fcolormap; + fforeground; + fbackground; + findicator; + findicator_texts; + protected + function set_graph_data(d);override; //???????? + begin + if d<>fgraph_data then + begin + fdata_bounds[0,0] := -0.1; + fdata_bounds[0,1] := 2.1; + fdata_bounds[1,0] := -0.2; + fdata_bounds[1,1] := 2.1; + inherited; + end + end + private + function set_indicator(v); + begin + if ifarray(v) and v<>findicator then + begin + findicator := v; + draw_indicator_text(v); + end + end + function data_indicator_process(data); //计算数据 + begin + borders := Length(data); + angleStep := 2 * pi() / borders; + currentAngle := 0; + segments := array(0); + for i,v in data do + begin + if i=0 then continue; + currentAngle += angleStep; + segments[i] := currentAngle; + end + return segments; + end + function draw_indicator_text(data); + begin + borders := Length(data); + angleStep := 2 * pi() / borders; + currentAngle := 0; + rightVertices := array(); + for i,v in findicator_texts do + begin + v.parent := nil; + end + findicator_texts := array(); + for i := 0 to borders - 1 do + begin + text_indicator := 1+array(sin(currentAngle)*1,cos(currentAngle)*1); + gtx := new tg_text(); + gtx.clip_state := tgc_off; + gtx.line_mode := false; + gtx.parent := self; + gtx.text := array(data[i]['name']); + gtx.data := text_indicator; + if currentAngle<(pi()/4) then + begin + gtx.textalign := 8; + end else + if currentAngle<(pi()*3/4) then + begin + gtx.textalign := 4; + end else + if currentAngle<(pi()*5/4) then + begin + gtx.textalign := 2; + end else + if currentAngle<(pi()*7/4) then + begin + gtx.textalign := 6; + end else gtx.textalign := 8; + //gtx.font_angle := currentAngle-pi()*3/4; + currentAngle := currentAngle + angleStep; + findicator_texts[i] := gtx; + end + end + function get_radar_cyclings(iradar,r1); + begin + vis := array(); + r := array(); + for i,vi in iradar do + begin + if ifarray(r1) then rx := r1[i]; + else rx := r1; + x0 := sin(vi)*rx; + y0 := cos(vi)*rx; + r[i] := array(x0,y0); + end + r[length(r)] := r[0]; + return r; + end + function draw_radar_grid(cvs,iradar); + begin + bx := axes.zoom_box; + z := bx[2,0]; + vis := array(); + set_lineinfo_to_canvas(cvs); + for i,vi in iradar do + begin + x0 := sin(vi); + y0 := cos(vi); + if not zoom_to_xyz(x0+1,y0+1,z,x,y) then return ; + zoom_to_xyz(1,1,z,x1,y1); + cvs.moveto(array(x1,y1)); + cvs.lineto(array(x,y)); + end + n := 4; + st := 1/n; + for i := 1 to n do + begin + for i,v in 1+get_radar_cyclings(iradar,i*st) do + begin + zoom_to_xyz(v[0],v[1],z,x,y) ; + if i=0 then cvs.moveto(x,y); + else cvs.lineto(x,y); + end + end + end +end +type tg_Polytree = class(tg_graph) //树图对象 + function create(pms); + begin + inherited; + clip_state := tgc_on; + line_mode := tgc_on; + mark_mode := tgc_off; + fshow_text := tgc_on; + fdata_bounds := array((0,50),(0,50),(0,50)); + fnode_space_x := 50; + end + function get_data_bounds();override; //数据边界 + begin + return fdata_bounds; + end + function paint(cvs);override; //绘图 + begin + if tgc_on<> visible then return ; + bx := axes.zoom_box; + if clip_state=tgc_on then + begin + pts := array(); + for i,v in graph_paint_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); + end + cvs.clip_rgn(pts); + end else + begin + cvs.axesunclip(); + end + xys := array(); + set_lineinfo_to_canvas(cvs); + ys := array(); + fline_points_in_canvas := xys; + render_tree(fstructure_tree, cvs, bx); + end + function executecommand(cmd,p);override; + begin + case cmd of + "points_in_canvas":return (visible=tgc_on)? fline_points_in_canvas:nil; //数据散点 + end; + return inherited; + end + function firstwalk(V,Distance);override; // 第一次递归 + begin + if V.NodeCount = 0 then + begin + if V.leftmost_sibling <> nil then + begin + if V.left_brother() = nil then + V.X := 0 + Distance; + else + V.X := V.left_brother().X + Distance; + end + else + V.X := 0; + end + else + begin + DefaultAncestor := V.GetNodeByIndex(0); + for i := 0 to V.NodeCount-1 do + begin + firstwalk(V.GetNodeByIndex(i), Distance); + DefaultAncestor := apportion(V.GetNodeByIndex(i), DefaultAncestor, Distance); + end; + ExecuteShifts(V); + Midpoint := (V.GetNodeByIndex(0).X + V.LastChild.X) / 2; + W := V.left_brother(); + if W <> nil then + begin + V.X := W.X + Distance; + V.ModVal := V.X - Midpoint; + end + else + V.X := Midpoint; + end; + return V; + end; + function apportion(V,DefaultAncestor, Distance);override; //修正子孙节点定位 + begin + LeftBrother := V.left_brother(); + if LeftBrother <> nil then + begin + VInnerRight := V; + VOuterRight := V; + VInnerLeft := LeftBrother; + VOuterLeft := V.leftmost_sibling; + if VOuterLeft = nil then VOuterLeft := V; + + SInnerRight := V.ModVal; + SOuterRight := V.ModVal; + SInnerLeft := VInnerLeft.ModVal; + SOuterLeft := VOuterLeft.ModVal; + + while (VInnerLeft.right() <> nil) and (VInnerRight.left() <> nil) do + begin + VInnerLeft := VInnerLeft.right(); + VInnerRight := VInnerRight.left(); + VOuterLeft := VOuterLeft.left(); + VOuterRight := VOuterRight.right(); + if VInnerLeft = 0 then + begin + end + if VOuterRight = 0 then + begin + end + VOuterRight.Ancestor := V; + + Shift := (VInnerLeft.X + SInnerLeft) - (VInnerRight.X + SInnerRight) + Distance; + if Shift > 0 then + begin + Anc := get_ancestor(VInnerLeft, V, DefaultAncestor); + move_subtree(Anc, V, Shift); + SInnerRight := SInnerRight + Shift; + SOuterRight := SOuterRight + Shift; + end; + SInnerLeft := SInnerLeft + VInnerLeft.ModVal; + SInnerRight := SInnerRight + VInnerRight.ModVal; + SOuterLeft := SOuterLeft + VOuterLeft.ModVal; + SOuterRight := SOuterRight + VOuterRight.ModVal; + end; + + if (VInnerLeft.right() <> nil) and (VOuterRight.right() = nil) then + begin + VOuterRight.Thread := VInnerLeft.right(); + VOuterRight.ModVal := VOuterRight.ModVal + (SInnerLeft - SOuterRight); + end + else if (VInnerRight.left() <> nil) and (VOuterLeft.left() = nil) then + begin + VOuterLeft.Thread := VInnerRight.left(); + VOuterLeft.ModVal := VOuterLeft.ModVal + (SInnerRight - SOuterLeft); + end; + DefaultAncestor := V; + end; + return DefaultAncestor; + end; + function move_subtree(WL,WR, Shift);override; //移动子树 + begin + Subtrees := WR.TNumber - WL.TNumber; + _WRChange := WR.Change - (Shift / Subtrees); + WR.Change := _WRChange; + _WRShift := WR.Shift + Shift; + WR.Shift := _WRShift; + _WLChange := WL.Change + (Shift / Subtrees); + WL.Change :=_WLChange; + _WRX := WR.X + Shift; + WR.X := _WRX; + _WRModVal := WR.ModVal + Shift; + WR.ModVal := _WRModVal; + end; + function ExecuteShifts(V);override; + begin + Shift := 0; + Change := 0; + for i := V.NodeCount-1 downto 0 do + begin + W := V.GetNodeByIndex(i); + W.X := W.X + Shift; + W.ModVal := W.ModVal + Shift; + Change := Change + W.Change; + Shift := Shift + W.Shift + Change; + if Change = NAN then + if Change = -INF then + end; + end; + function get_ancestor(VIL, V, DefaultAncestor);override; //如果vil节点的祖先节点在v节点的兄弟节点中，那么返回vil的祖先节点，否则返回default_ancestor + begin + if (VIL.Ancestor <> nil) and (V.Parent <> nil) and (VIL.Ancestor.Parent = V.Parent) then + return VIL.Ancestor; + else + return DefaultAncestor; + end; + function second_walk(V, M, Depth, Min);override; //第二次遍历 + begin + V.X := V.X + M; + V.Y := Depth; + if Min = -1 then + Min := V.X + else if V.X < Min then + Min := V.X; + + for i := 0 to V.NodeCount-1 do + Min := second_walk(V.GetNodeByIndex(i), M + V.ModVal, Depth + 1, Min); + + return Min; + end; + function third_walk(V, N);override; // 第三次遍历 + begin + V.X := V.X + N; + for i := 0 to V.NodeCount-1 do + third_walk(V.GetNodeByIndex(i), N); + end; + function Buchheim(Tree);override; + begin + DT := firstwalk(Tree, 1); + Min := second_walk(DT, 0, 0, -1); + if Min < 0 then third_walk(DT, -Min); + return DT; + end; + function handle_tree(V);override; + begin + V.X := V.X * fnode_space_x; + V.X := V.X + fnode_space_x; + V.Y := V.Y * fnode_space_x; + V.Y := V.Y + fnode_space_x; + for i := 0 to V.NodeCount-1 do handle_tree(V.GetNodeByIndex(i)); + end; + function render_tree(Tree,cvs, bx);override; //绘制树 + begin + if Tree.ShowNode then + begin + for j := 0 to Tree.NodeCount-1 do + begin + if Tree.GetNodeByIndex(j).ShowNode then + begin + xys := array(); + set_lineinfo_to_canvas(cvs); + ys := array(); + //_data := array((Tree.X,Tree.Y),(Tree.X,(Tree.Y + Tree.GetNodeByIndex(j).Y) / 2),(Tree.GetNodeByIndex(j).X,(Tree.Y + Tree.GetNodeByIndex(j).Y) / 2),(Tree.GetNodeByIndex(j).X,Tree.GetNodeByIndex(j).Y)); + _data := array( + (Tree.Y, Tree.X), + ((Tree.Y + Tree.GetNodeByIndex(j).Y) / 2, Tree.X), + ((Tree.Y + Tree.GetNodeByIndex(j).Y) / 2, Tree.GetNodeByIndex(j).X), + (Tree.GetNodeByIndex(j).Y, Tree.GetNodeByIndex(j).X) + ); + + for i,v in _data do + begin + if not zoom_to_xyz(v[0],v[1],bx[2,0],x,y) then return ; + xys[i] := array(integer(x),integer(y)); + + end + fline_points_in_canvas := xys; + paint_tree(cvs,xys,array("line_mode":line_mode,"bar_width":0,"color":lineinfo.color,"bkcolor":lineinfo.bkcolor,"xy0":ys)); + mk := markinfo.clone(); + if mark_mode=tgc_on and mk.size>2 then + begin + graph_paint_points(mk,cvs,array(xys[0], xys[3])); + end + if (Tree.GetNodeByIndex(j).NodeCount) then render_tree(Tree.GetNodeByIndex(j),cvs, bx); + end + end + end + end; + property node_space_x read fnode_space_x write set_node_space_x;//= "0" 柱状宽度 + property show_text read fshow_text write set_show_text;//= "0" 柱状宽度 + private + fline_points_in_canvas; + fdata_bounds; + fforeground; + fbackground; + fnode_space_x; + fshow_text; + fstructure_tree; + protected + function set_graph_data(d);override; //设置数据 + begin + if d<>fgraph_data then + begin + test_tree := new tg_tree_node(d,nil,0,1); + Buchheim_tree := Buchheim(test_tree); + handle_tree(Buchheim_tree); + fstructure_tree := Buchheim_tree; + find_data_bounds(fstructure_tree); + fdata_bounds[0,1] := fdata_bounds[0,1] +fnode_space_x; + fdata_bounds[1,1] := fdata_bounds[1,1] +fnode_space_x; + inherited; + end + end + private + function set_node_space_x(v); + begin + if v >=0 and v<>fnode_space_x then + begin + fnode_space_x := v; + prop_changed("node_space_x",v); + end + end + function set_show_text(v); + begin + if not graph_paint_boolen_value(v,nv) then return ; + if nv<>fshow_text then + begin + fshow_text := nv; + find_data_bounds(fstructure_tree); + prop_changed("show_text",nv); + end + end + function find_data_bounds(Tree); //设置数据 + begin + if not fstructure_tree then return ; + if Tree.ShowNode then + begin + if fshow_text = tgc_on then + begin + n := Tree.TName; + if n and ifstring(n) then + begin + if tree.ftextobj then + begin + gtx.data := array(Tree.Y, Tree.X); + end else + begin + gtx := new tg_text(); + gtx.clip_state := tgc_on; + gtx.parent := self; + gtx.text := array(n); + gtx.data := array(Tree.Y, Tree.X); + tree.ftextobj := gtx; + end + end else + begin + if tree.ftextobj then + begin + tree.ftextobj.visible := false; + end + end + end + + if Tree.NodeCount >0 then + begin + for j := 0 to Tree.NodeCount-1 do + begin + fdata_bounds[0,0] := 0; + fdata_bounds[1,0] := 0; + fdata_bounds[0,1] := Max(fdata_bounds[0,1],Tree.GetNodeByIndex(j).Y); + fdata_bounds[1,1] := Max(fdata_bounds[1,1],Tree.GetNodeByIndex(j).X); + find_data_bounds(Tree.GetNodeByIndex(j)); + end + end + end + end +end +type tg_Polysunburst = class(tg_graph) //旭日图 + function create(pms); + begin + inherited; + ftext_container := array(); + clip_state := tgc_on; + fcolormap := array(0xc67054, 0x75cc91, 0x58c8fa, 0x6666ee, 0xdec073, 0x72a23b, 0x5284fc, 0xb4609a, 0xcc7cea); + line_mode := tgc_on; + mark_mode := tgc_off; + fbar_width := 0; + fdata_bounds := array((0,1),(0,1),(0,1)); + fshow_text := tgc_on; + end + function get_data_bounds();override; //边界 + begin + return fdata_bounds; + end + function paint(cvs);override; //绘制 + begin + if tgc_on<> visible then return ; + bx := axes.zoom_box; + if clip_state=tgc_on then + begin + pts := array(); + for i,v in graph_paint_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); + end + cvs.clip_rgn(pts); + end else + begin + cvs.axesunclip(); + end + xys := array(); + medians := array(); + wick_y := array(); + outliers := array(); + inliers := array(()); + set_lineinfo_to_canvas(cvs); + ys := array(); + axes.axises(0).tics_coord := x_coord; + axes.axises(0).tics_labels := x_label; + CalculateCoordinates(1.0, 10.0, 0.4, 0.7, 0, 360, fgraph_data, cvs, bx); + inherited; + end + function executecommand(cmd,p);override; + begin + case cmd of + "points_in_canvas":return (visible=tgc_on)? fline_points_in_canvas:nil; //??????? + end; + return inherited; + end + function CalculateCoordinates(x1, y1, r1, r2, startAngle, endAngle, node, cvs, bx); + begin + totalValue := CalculateTotalValue(node); + angle := startAngle; + _r3 := r1 + (r2 - r1); + _r4 := r2 + (r2 - r1); + if ifarray(node['children']) then + begin + for i := 0 to length(node['children'])-1 do + begin + childStartAngle := angle; + xys := array(); + _portion := CalculateTotalValue(node['children'][i]) / totalValue; + childEndAngle := angle +_portion * 2 * pi() * x1; + pie_data := fcenter+get_pie_ring_lines(childStartAngle,childEndAngle,r2,r1,0,0); + for j,v in pie_data do + begin + if not zoom_to_xyz(v[0],v[1],bx[2,0],x,y) then return ; + xys[j] := array(integer(x),integer(y)); + zoom_to_xyz(v[0],0,0,x,y) ; + end + fline_points_in_canvas := xys; + its := node['children'][i]['itemstyle']['color']; + item_color := ifnumber(its)?its: fcolormap[1]; + paint_sunburst(cvs,xys,array("line_mode":line_mode,"bar_width":0,"color":0xffffff,"bkcolor":item_color,"xy0":ys)); + CalculateCoordinates(_portion * x1, y1, _r3, _r4, childStartAngle, childEndAngle, node['children'][i], cvs, bx); + angle := childEndAngle; + end; + end + end; + function CalculateTotalValue(node); //设置数据 + begin + if node = nil then + return 0; + pv := 0; + if node['value'] <> nil then pv := node['value']; + //return node['value']; + + totalValue := 0; + if node['children'] <> nil then + begin + for i := 0 to length(node['children'])-1 do + begin + totalValue := totalValue + CalculateTotalValue(node['children'][i]); + end; + end + return max(pv,totalValue); + node['value'] := totalValue; + return node['value']; + end; + function getTreeDepth(node); //获取深度 + begin + if node['children'] = nil then + begin + return 0; + end + _deep := 0; + for i := 0 to length(node['children'])-1 do + begin + _deep := Max(_deep, getTreeDepth(node['children'][i])); + end + return _deep + 1; + end + function get_pie_ring_center(arg1_,arg2_,r1,r2,prominent,prominentrate); //??????????????? + begin + arg := arg1_+(arg2_-arg1_)/2; + d1 := r1; + return array(sin(arg)*d1,cos(arg)*d1); + end + function get_legend_size(w,h);override; + begin + inherited ; + end + function paint_legend(cvs,rec);override; + begin + inherited; + end + property color_map read fcolormap write fcolormap;// + property show_text read fshow_text write set_show_text;// + private + ftext_container; + fline_points_in_canvas; + fdata_bounds; + fcolormap; + fshow_text; + fforeground; + fbackground; + fcenter; + protected + function set_graph_data(d);override; //设置数据 + begin + if d<>fgraph_data then + begin + clear_text(); + deep := getTreeDepth(d); + fcenter := deep*(0.7-0.4)+0.4; + fdata_bounds[0,0] := 0; + fdata_bounds[1,0] := 0; + fdata_bounds[0,1] := fcenter * 2; + fdata_bounds[1,1] := fcenter * 2; + inherited; + draw_text(); + end + end + private + function set_show_text(v); + begin + if not graph_paint_boolen_value(v,nv) then return ; + if nv<>fshow_text then + begin + fshow_text := nv; + draw_text(); + end + end + function clear_text(); + begin + for i,v in ftext_container do + begin + v.parent := nil; + end + ftext_container := array(); + end + function draw_text(); + begin + if fshow_text = tgc_on then + begin + CalculateTextCoordinates(1.0, 10.0, 0.1, 0.4, 0, 360, fgraph_data); + end else + begin + clear_text(); + end + end + function CalculateTextCoordinates(x1, y1, r1, r2, startAngle, endAngle, node); + begin + totalValue := CalculateTotalValue(node); + angle := startAngle; + _r3 := r1 + (r2 - r1); + _r4 := r2 + (r2 - r1); + if ifarray(node) and node["name"] and ifstring(node["name"]) then + begin + text_data := fcenter+get_pie_ring_center(startAngle,endAngle,r1,r2,0,0); + gtx := new tg_text(); + gtx.clip_state := tgc_on; + gtx.line_mode := 0; + if length(ftext_container)>0 then + gtx.font_angle := ((startAngle + endAngle) / 2) - pi()/2; + gtx.parent := self; + gtx.text := array(node['name']); + gtx.data := text_data; + ftext_container[length(ftext_container)] := gtx; + end + if ifarray(node['children']) then + begin + for i := 0 to length(node['children'])-1 do + begin + childStartAngle := angle; + _portion := CalculateTotalValue(node['children'][i]) / totalValue; + childEndAngle := angle +_portion * 2 * pi() * x1; + CalculateTextCoordinates(_portion * x1, y1, _r3, _r4, childStartAngle, childEndAngle, node['children'][i]); + angle := childEndAngle; + end; + end + end; +end +implementation +type tg_tree_node = class(TNode) + private + public + ftextobj; + fName; + X; // x坐标 + Y; // y坐标 + //fChildren; + Thread; // 线程节点，也就是指向下一个轮廓节点 + ModVal; // 根据左兄弟定位的x与根据子节点中间定位的x之差 + Ancestor; // 要么指向自身，要么指向所属树的根 + Change; + Shift; + TNumber; // 这是它在兄弟节点中的位置索引 1...n + LmostSibling; // 最左侧的兄弟节点 + ShowNode; + function Create(tree,p,depth,number);virtual; + begin + class(TNode).create(); + fName := tree['name']; + for i,v in tree['children'] do + begin + it := new tg_tree_node(v,self,depth+1, i+1) ; + it.parent := self; + AppendNode(it); + //self(true).fChildren := it; + end + X := -1; + Y := Depth; + Thread := nil; + ModVal := 0; + Ancestor := self(true); + Change := 0; + Shift := 0; + TNumber := number; + LmostSibling := nil; + ShowNode := tree['show'] = nil ? true : tree['show']; + end + function right(); // 有线程返回线程节点，否则返回最右侧的子节点，也就是树的右轮廓 + begin + if self.Thread <> nil then + Result := self.Thread; + else if self.NodeCount > 0 then + Result := self.LastChild; + else + Result := nil; + return Result; + end + + function left();virtual; // 有线程返回线程节点，否则返回最左侧的子节点，也就是树的左轮廓 + begin + if self.Thread <> nil then + result := self.Thread; + else if self.NodeCount > 0 then + Result := self.GetNodeByIndex(0); + else + Result := nil; + return Result; + end + + function left_brother(); // 获取前一个兄弟节点 + begin + Result := nil; + if self.Parent = nil then + return Result; + for i := 0 to self.parent.NodeCount-1 do + begin + if self.parent.GetNodeByIndex(i) = self then + return Result; + else + Result := self.parent.GetNodeByIndex(i); + end; + return Result; + end + + function get_lmost_sibling(); // 获取同一层级第一个兄弟节点，如果第一个是自身，那么返回null + begin + if (self.LmostSibling = nil) and (self.Parent <> nil) and (self <> self.Parent.GetNodeByIndex(0)) then + self.LmostSibling := self.Parent.GetNodeByIndex(0); + Result := self.LmostSibling; + return Result; + end + + function destroy();override; + begin + inherited; + if ftextobj then ftextobj.parent := nil; + ftextobj := nil; + end + property TName read fName; + property leftmost_sibling read get_lmost_sibling; +end +function get_pie_ring_lines(arg1,arg2,r1,r2,prominent,prominentrate); //??????????????? +begin + stp := pi()/360; + d1 := r1; + d2 := r2; + r := array(); + s := array(); + s_reverse := array(); + //r[0] := array(0,0); + idx := 0; + for i:= arg1+(prominent?stp:0) to arg2-(prominent?stp:0) step stp do + begin + s[idx] := array(sin(i)*d2,cos(i)*d2); + r[idx++] := array(sin(i)*d1,cos(i)*d1); + end + ls :=length(s); + for j,v in s do + begin + s_reverse[j] := s[ls-j-1]; + end + r &= s_reverse; + 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 +function paint_candlestick(cvs,pls,xys,cls,fdata,ifo); +begin + o := static new tg_const(); + b_w_x := integer(ifo["bar_width"][0]/2); + b_w_y := integer(ifo["bar_width"][1]/2); + //cvs.brush.color := ifo["bullcolor"]; + wflg := (abs(b_w_x)+abs(b_w_y))>1; + barrgn := array(); + for i,v in xys do + begin + 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.brush.style := tgc_BS_SOLID; + upper_wick_start := fdata[i][2]>= fdata[i][1]?ifo["xy0",i]:v; + lower_wick_start := fdata[i][2]>= fdata[i][1]?v:ifo["xy0",i]; + cvs.brush.color := fdata[i][2]>= fdata[i][1]?ifo["bullcolor"]:ifo["bearcolor"]; + cvs.pen.color := cvs.brush.color; // ??????????? + v1234 := array(v1,v2,v3,v4); + barrgn[i] := v1234; + cvs.draw_polygon().points(v1234).draw(); + cvs.moveto(upper_wick_start); + cvs.lineto(ifo["wick_y",i,0]); // ?????10???????????????????????????wick_y + cvs.moveto(lower_wick_start); + cvs.lineto(ifo["wick_y",i,1]); // ?????10??????????????????????????? + end else + begin + cvs.moveto(array(ifo["xy0",i,0],ifo["xy0",i,1])); + cvs.lineto(array(ifo["xy0",i,0],ifo["xy0",i,1])); + end + end + ifo["barrgn"] := barrgn; +end +function paint_boxplot(cvs,pls,xys,cls,ifo); //?????? +begin + o := static new tg_const(); + b_w_x := integer(ifo["bar_width"][0]/2); + b_w_y := integer(ifo["bar_width"][1]/2); + barrgn := array(); + wflg := (abs(b_w_x)+abs(b_w_y))>1; + for i,v in xys do + begin + 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); + v1234 := array(v1,v2,v3,v4); + barrgn[i] := v1234; + upper_wick_start := ifo["xy0",i]; + lower_wick_start := v; + cvs.pen.color := cvs.brush.color; // ??????????? + cvs.draw_polygon().points(v1234).draw(); + cvs.moveto(upper_wick_start); + cvs.lineto(ifo["wick_y",i,0]); // ?????10???????????????????????????wick_y + + cvs.moveto(lower_wick_start); + cvs.lineto(ifo["wick_y",i,1]); + upper_bound_start := array(ifo["wick_y",i,0,0]-b_w_x,ifo["wick_y",i,0,1]-b_w_y); + upper_bound_end := array(ifo["wick_y",i,0,0]+b_w_x,ifo["wick_y",i,0,1]+b_w_y); + cvs.moveto(upper_bound_start); + cvs.lineto(upper_bound_end); + + lower_bound_start := array(ifo["wick_y",i,1,0]-b_w_x,ifo["wick_y",i,1,1]-b_w_y); + lower_bound_end := array(ifo["wick_y",i,1,0]+b_w_x,ifo["wick_y",i,1,1]+b_w_y); + cvs.moveto(lower_bound_start); + cvs.lineto(lower_bound_end); + + medians_start := array(ifo["medians",i,0]-b_w_x,ifo["medians",i,1]-b_w_y); + medians_end := array(ifo["medians",i,0]+b_w_x,ifo["medians",i,1]+b_w_y); + cvs.moveto(medians_start); + cvs.lineto(medians_end); + end else + begin + cvs.moveto(array(ifo["xy0",i,0],ifo["xy0",i,1])); + cvs.lineto(array(ifo["xy0",i,0],ifo["xy0",i,1])); + end + end + ifo["barrgn"] := barrgn; +end + +function paint_pie(cvs,xys,ifo); //画饼 +begin + cvs.brush.color := ifo["bkcolor"]; + cvs.brush.style := tgc_BS_SOLID; + cvs.pen.style := 0; + cvs.pen.color := ifo["color"]; + cvs.draw_polygon().points(xys).draw(); +end +function paint_sunburst(cvs,xys,ifo);//画饼 +begin + return paint_pie(cvs,xys,ifo); + cvs.brush.color := ifo["bkcolor"]; + //cvs.brush.color := 0x0000ff; + cvs.brush.style := tgc_BS_SOLID; + cvs.pen.style := 0; + cvs.pen.color := ifo["color"]; + cvs.draw_polygon().points(xys).draw(); +end +function paint_tree(cvs,xys,ifo); //画树 +begin + cvs.brush.color := ifo["bkcolor"]; + cvs.pen.style := 0; + //cvs.pen.color := ifo["color"]; + //cvs.pen.color := 0x0000ff; + tree := cvs.draw_bezier(); + tree.startpoint(xys[0]); + tree.addpoints(array(xys[1])); + tree.addpoints(array(xys[2])); + tree.addpoints(array(xys[3])); + tree.draw(); +end + + +initialization +finalization +end. diff --git a/tsleditor.exe b/tsleditor.exe index 2326799..3dfe329 100644 Binary files a/tsleditor.exe and b/tsleditor.exe differ diff --git a/tslvcltool.exe b/tslvcltool.exe index d0854b3..42fdb15 100644 Binary files a/tslvcltool.exe and b/tslvcltool.exe differ