diff --git a/designer/utslcodeeditor.tsf b/designer/utslcodeeditor.tsf index 179fce9..8ebc99c 100644 --- a/designer/utslcodeeditor.tsf +++ b/designer/utslcodeeditor.tsf @@ -2886,6 +2886,7 @@ type TEditer=class(TCustomcontrol) // subit.Parent := it; subit.OnClick := thisfunction(PageEditerMenuClick); end + FPageEditerMenus[v] := it; continue; end FPageEditerMenus[v]:= it; @@ -2900,10 +2901,11 @@ type TEditer=class(TCustomcontrol) // begin zd := GetCurrentItem().FEditer.Readonly; rd.Checked := zd; - it := FPageEditerMenus["粘贴(V)"]; - if it then it.Enabled := not zd; - it := FPageEditerMenus["剪切(X)"]; - if it then it.Enabled := not zd; + for ii,vv in array("转换为大写","转换为小写","删除尾空白","粘贴(V)","剪切(X)","文档格式") do + begin + it := FPageEditerMenus[vv]; + if it then it.Enabled := not zd; + end end rd := FPageEditerMenus["查看"]; if rd then @@ -3523,6 +3525,7 @@ type TEditer=class(TCustomcontrol) // function upperorlowercase(f); begin ed := GetCurrentEditer(); + if ed.ReadOnly then return ; IF not ed then return; s := ed.SelText; if s then diff --git a/designer/utslvcldebuger.tsf b/designer/utslvcldebuger.tsf index 9039774..108ddb7 100644 --- a/designer/utslvcldebuger.tsf +++ b/designer/utslvcldebuger.tsf @@ -85,8 +85,8 @@ type TFTSLScriptcustomMemo=class(TSYNmemoNorm) begin fy :=(FirstLine-TopLine) * LineHeight; r := ClientRect; - if fyr[3]then return; + if fy<(r[1]-2) then return; + if fy>(r[3]+2)then return; r[0]:= GutterWidth; r[1]:= max(0,fy); InvalidateRect(r,false); @@ -447,7 +447,7 @@ type TTslDebuga=class(TCustomControl) return filedelete("",(TS_ModulePath()+"FunCache.ini")); end public - property runbtncall read frunbtncall write frunbtncall; + property runbtncall read frunbtncall write frunbtncall; function addbtns(btns); //添加菜单 begin FBtns := btns; @@ -615,8 +615,8 @@ type TTslDebuga=class(TCustomControl) FDebugUsr := 0; FDebugPwd := 0; deletefuncacheini(); - getdebuger(pms); - exestr := format('"%s" "%s" -DEBUGSERVER -DEBUGLOGIN 0 -WAITATTACH -DEBUGPORT %d -libpath "%s" ',FDebugExe,FRuningfile,FDebugport,dirs); + getdebuger(pms,pdir); + exestr := format('"%s" "%s" -DEBUGSERVER -DEBUGLOGIN 0 -WAITATTACH -DEBUGPORT %d -libpath "%s" ',FDebugExe,FRuningfile,FDebugport,(pdir?pdir:dirs)); exestr += pms; fremotedbugstart := true; fscriptbrks := array(); @@ -1320,7 +1320,7 @@ type TTslDebuga=class(TCustomControl) begin fdefaultdbger := gettslexefullpath(); end - function getdebuger(pms); //获得调试程序 + function getdebuger(pms,pdir); //获得调试程序 begin p := static pluginpath(); global g_debug_chooser; @@ -1356,9 +1356,10 @@ type TTslDebuga=class(TCustomControl) while idx1 then f+=".tpj"; FProjectsManager.CreateTpjFomFile(f); end @@ -1089,6 +1089,12 @@ type TVclDesigner = class(tvcform) function toplevelwndkeydown(o,e); begin cd := e.CharCode; + if cd=vk_f12 then + begin + FProjectManager.GoToAFunction(nil);//DBLClickComponent(o,e); + FProjectManager.ShowEditor(); + e.skip := true; + end if cd = VK_ESCAPE then return select_parent(); c := e.char; if not((c in array("X","V","C","Z")) or cd=VK_DELETE) then return ; @@ -1376,7 +1382,7 @@ type TVclDesigner = class(tvcform) end FTree.Loading := nil; end - function loadtfmtotree(p,d,node,wr,prs,obarray,inhname,first,outobjs);//当如信息 + function loadtfmtotree(p,d,node,wr,prs,obarray,inhname,first, outobjs);//当如信息 begin {** @explan(说明) 导入tfm文件 %% @@ -1609,9 +1615,12 @@ type TVclDesigner = class(tvcform) ic.Readvcon(HexFormatStrToTsl(GetTsIconBitmapInfo())); self.FormICon := ic; //文件打窗口 - FProjectFileOpener := new TSavefileADlg(self); + FProjectFileOpener := new TOpenFileADlg(self); + FProjectFilesave := new TSavefileADlg(self); FProjectFileOpener.filter := array("tvcl工程":"*.tpj"); + FProjectFilesave.filter := array("tvcl工程":"*.tpj"); FProjectFileOpener.parent := self; + FProjectFilesave.parent := self; FProjectManager.FTslEditer.setdbugruncall(thisfunction(debugproject)); //设置调试回调 FProjectManager.newmenu.parent := ffilemenu;// FProjectManager.goformmenu.parent := fviewmenu;// @@ -1729,6 +1738,7 @@ EB43A8AA7C90DAF18A0686290EA76BBE8743AF0DD966D8F5347F12A789A415120 A9CF93B033F9EA579B5AA7EC4E00000000049454E44AE42608200"; end FProjectFileOpener; + FProjectFilesave; end diff --git a/editor-install.exe b/editor-install.exe index ea288fd..b5f2d45 100644 Binary files a/editor-install.exe and b/editor-install.exe differ diff --git a/funcext/tvclib/t_children_sizer.tsf b/funcext/tvclib/t_children_sizer.tsf index e9499ea..7089a0b 100644 --- a/funcext/tvclib/t_children_sizer.tsf +++ b/funcext/tvclib/t_children_sizer.tsf @@ -42,7 +42,7 @@ type t_children_sizer = class() fowner.BoundsRect := bds; end p := fowner.parent; - if p and p.autosize then p.AdjustSize();//处理传到 + if p and p.autosize then p.AdjustSize();//处理传到 fautosizing := false; end function getsizerinfo(); //获取信息 @@ -152,6 +152,7 @@ type t_children_sizer = class() cidx := 0; ridx++; end + wi := 0;hi:=0; ctl.GetPreferredSize(wi,hi); if flayout=1 then r[ridx,cidx] := array(ctl,0,0,wi,hi); diff --git a/funcext/tvclib/tcontrol.tsf b/funcext/tvclib/tcontrol.tsf index 4e835d1..1016f95 100644 --- a/funcext/tvclib/tcontrol.tsf +++ b/funcext/tvclib/tcontrol.tsf @@ -1495,10 +1495,11 @@ type tcontrol = class(tcomponent) fautosizing := true; sf := self(true); if (sf is class(TWinControl)) and sf.WsPopUp then return ; - if Parent then + p := Parent; + if p then begin - if Parent.autosize then Parent.AdjustSize(); - else if Align<>alNone then Parent.DoControlAlign(); + if p.autosize then p.AdjustSize(); + else if Align<>alNone then p.DoControlAlign(); end fautosizing := false; //excludestate(FControlFlags,cfAutoSizeNeeded); diff --git a/funcext/tvclib/tslvcl.tsf b/funcext/tvclib/tslvcl.tsf index 2df18e8..6a0320f 100644 --- a/funcext/tvclib/tslvcl.tsf +++ b/funcext/tvclib/tslvcl.tsf @@ -4181,493 +4181,34 @@ type tprogressbar = class(tcustomprogressbar) inherited; end end -type tmonthcalendar = class(TCustomControl) +type tmonthcalendar =class(tcustommonthcalendar) {** @explan(说明)月历控件 - 该控件的函数可能的返回值： - array等期望的数据/1：成功。 - -1：一般是函数参数格式不正确。 - nil：该项属性在控件种类正确、窗口未创建、无默认值的情况下未设置过或被重置过。 - 0：失败，可能的原因： - 1.参数格式正确但不适用于控件的当前状态，如对多选月历设置当前选择项时项数超过其最大多选项数限制。 - 2.控件类型错误，如对单选月历调用设置其最大多选项数限制的函数。 - 3.要求控件创建后才可调用的函数在控件创建之前被调用。 - 4.未知错误。 - **} +**} function create(aowner); begin - inherited; - //TodayButton := false; + inherited; end - function AfterConstruction();override; - begin - inherited; - width := 213; - height := 175; - FCalender := new tVirtualCalender(); - FCalender.ExecuteCommand("memymd",date()); - FCalender.Left := 1; - FCalender.top := 1; - FCalender.host := self(true); - end - function paint();override; - begin - if FCalender then FCalender.paint(); - end - function MouseUp(o,e);override; - begin - inherited; - if e.skip then return ; - if not FCalender then return ; - if e.button()= mbLeft then - begin - r := FCalender.ExecuteCommand("mestatebypos",e.pos); - if r then return ; - r := FCalender.ExecuteCommand("megetincpos",e.pos); - if r then return FCalender.ExecuteCommand("meminc",r); - std := FCalender.ExecuteCommand("mestate"); - r := FCalender.ExecuteCommand("meselbypos",e.pos); - if std=3 or r="today" then - begin - if FonSelect then - CallMessgeFunction(FonSelect,self(true),new tuieventbase(0,0,0,0)); - end - end - end - function getCurrentSelection();begin - {** - @explan(说明)获取当前选择的日期，该函数仅能用于单选的月历控件%% - @return(array/integer/nil)array:成功;0:失败;nil:未设置过此项。 - array(2019,2,1) - **} - if FCalender then - begin - r := FCalender.ExecuteCommand("meymd"); - decodedate(r,y,m,d); - return array(y,m,d); - end - return 0; - end - function setCurrentSelection(y,m,d); - begin - {** - @explan(说明)设置当前选择日期，该函数仅能用于单选的月历控件%% - @param(y)(integer)年%% - @param(m)(integer)月%% - @param(d)(integer)日%% - @return(integer)1:成功;0:失败;-1:出错%% - **} - if ifnumber(y) and ifnumber(m) or ifnumber(d) then - begin - dt := encodedate(y,m,d); - if FCalender then - begin - FCalender.ExecuteCommand("meymd",dt); - return 1; - end - end - end - function GetPreferredSize(w,h);override; - begin - if FCalender then - begin - FCalender.GetPreferredSize(w,h); - w+=1; - h+=1; - end - end - function DoDatechanged(); - begin - if FonSelectChange then - CallMessgeFunction(FonSelectChange,self(true),new tuieventbase(0,0,0,0)); - end - function recycling();override; - begin - FCalender.recycling(); - inherited; - FCalender := nil; - FonSelect := nil; - FonSelectChange := nil; - end - published - property onSelectChange read FonSelectChange write FonSelectChange; - property TodayButton:bool read getnoTodayButton write setNoTodayButton; - property onSelect:eventhandler read FonSelect write FonSelect; - property onSelChanged:eventhandler read FonSelectChange write FonSelectChange; - {** - @param(todayButton)(bool)月历显示“今日”按钮（默认开启）%% - @param(onselchanged)(function[tmonthcalendar,tuieventbase])选择日期改变%% - **} - - private - function setNoTodayButton(v); - begin - if FCalender then return FCalender.ExecuteCommand("metodaybutton",v); - end - function getnoTodayButton(); - begin - if FCalender then return FCalender.ExecuteCommand("metodaybutton"); - end - private - FCalender; - FMousedownState; - [weakref]FonSelect; - [weakref]FonSelectChange; end - -type tdatetimepicker = class(tthreeEntry) +type tdatetimepicker = class(tcustomdatetimepicker) {** @explan(说明) 日期选择控件 %% **} function create(aowner); begin inherited; - caption:="Date/TimePicker"; - FCalender := new tmonthcalendar(self); - FCalender.autosize := true; - FCalender.border := true; - FCalender.WsPopUp := true; - FCalender.parent := self; - FCalender.Visible := false; - //FScreenRect := _wapi.GetScreenRect(); - decodedate(date(),y,m,d); - setDate(y,m,d); - FCalender.onSelect := function(o,e)begin - FCalender.Visible := false; - d := FCalender.getCurrentSelection(); - setDate(d[0],d[1],d[2]); - end - FCalender.OnActivate := function(o,e)begin - if e.wparam=0 then - begin - FCalender.Visible := false; - end - end - end - function btnclicked(p);override; - begin - rec := BtnRect; - if pointinrect(p,rec) then - begin - ShowDropDown(true); - return true; - end end - - function ExecuteCommand(cmd,p);override; - begin - case cmd of - "dtchanged": - begin - es := entrys; - if p = es[2] then //日 - begin - pn := getenumber(p); - y := getenumber(es[0]); - m := getenumber(es[1]); - if pn<1 then p.text := inttostr(getmonthdates(y,m)); - else - if pn>28 and pn>getmonthdates(y,m) then - begin - p.text := "1"; - end - end else - if p = es[1] then //月 - begin - y := getenumber(es[0]); - m := getenumber(es[1]); - bm := m; - if m>12 then - begin - m := 1; - end else - if m<1 then m := 12; - if bm<>m then - begin - p.text := inttostr(m); - end - d := getenumber(es[2]); - if d<1 then es[2].text := "1"; - else - if d>28 then - begin - ct := getmonthdates(y,m); - if d>ct then es[2].text := inttostr(ct); - end - end else - if p = es[0] then //年 - begin - y := getenumber(p); - m := getenumber(es[1]); - d := getenumber(es[2]); - if dt>28 then - begin - ct := getmonthdates(y,m); - if d>ct then es[2].text := inttostr(ct); - end - end - if Fonselectchange then - calldatafunction(Fonselectchange,self(true),new tuieventbase(0,0,0,0)); - end - "dtadate": - begin - es := entrys; - if ifarray(p) and ifnumber(p[0]) and ifnumber(p[1]) and ifnumber(p[2]) then - begin - dt := encodedate(p[0],p[1],p[2]); - decodedate(dt,y,m,d); - es[0].text := inttostr(y); - es[1].text := inttostr(m); - es[2].text := inttostr(d); - if Fonselectchange then - calldatafunction(Fonselectchange,self(true),new tuieventbase(0,0,0,0)); - end else - begin - y := strtointdef(es[0].text,2021); - m := strtointdef(es[1].text,1); - d := strtointdef(es[2].text,1); - return array(y,m,d); - end - - end - - end - end - function ShowDropDown(f);virtual; - begin - {** - @explan(说明) 设置弹出框的显示区域 %% - **} - if not(FCalender ) then return ; - nv := ifnil(f)?true:(f?true:false); - if FCalender.Visible = nv then return FCalender.show(0); - rc := ClientRect; - nrc := ClientToScreen(rc[0],rc[3]); - p2 := clienttoscreen(rc[0],rc[1]+FCalender.height); - src := _wapi.GetScreenRect(nrc); - if (src[3]59 then - begin - p.text := "0"; - es[1].inc(); - end - end else - if es[1] = p then - begin - t := p.text; - ti := strtointdef(t,0); - if ti<0 then - begin - p.text := "59"; - es[0].dec(); - end else - if ti>59 then - begin - p.text := "0"; - es[0].inc(); - end - end else - if es[0] = p then - begin - t := p.text; - ti := strtointdef(t,0); - if ti<0 then p.text := "24"; - else if ti>24 then p.text := "0"; - end - if Fonselectchange then - calldatafunction(Fonselectchange,self(true),new tuieventbase(0,0,0,0)); - end - end - end - function PaintBtn();override; - begin - if FRectUp then - begin - dc := Canvas; - dc.Draw("framecontrol",array(FRectUp[0:1],FRectUp[2:3]),DFC_SCROLL,DFCS_SCROLLUP); - dc.Draw("framecontrol",array(FRectDown[0:1],FRectDown[2:3]),DFC_SCROLL,DFCS_SCROLLDOWN); - end - end - function btnClicked(p);virtual; - begin - if pointinrect(p,FRectUp) then - begin - for i,v in entrys do - begin - if v.HasFocus then - begin - v.inc(); - return 1; - end - end - - end else - if pointinrect(p,FRectDown) then - begin - for i,v in entrys do - begin - if v.HasFocus then - begin - v.dec(); - return 1; - end - end - - end - end - function getTime();override;begin - {** - @explan(说明)获取控件当前选择的时间%% - @return(array)%% - **} - return ExecuteCommand("dtatime"); - end - function setTime(h,m,s);override;begin - {** - @explan(说明)设置控件当前选择的时间%% - @param(h)(integer)时，24小时制%% - @param(m)(integer)分%% - @param(s)(integer)秒%% - **} - return ExecuteCommand("dtatime",array(h,m,s)); - end - function recycling();override; +type ttimepicker = class(tcustomtimepicker) +{** + @explan(说明) 时间选择控件 %% +**} + function create(AOwner); begin inherited; end - published - property onselectchange read Fonselectchange write Fonselectchange; - property onselchanged:eventhandler read Fonselectchange write Fonselectchange; - { - @param(onselchanged)(function[ttimepicker,tuieventbase])选择日期改变%% - } - protected - function calcCtls();override; - begin - inherited; - rec := BtnRect; - FRectUp := array(rec[0],rec[1],rec[2],integer(rec[1]+rec[3]/2)); - FRectDown := array(rec[0],integer(rec[1]+rec[3]/2),rec[2],rec[3]); - end - private - function getEntryWidth(i);virtual; - begin - return 2; - end - function getSym(i);virtual; - begin - return ":"; - end - FRectUp; - FRectDown; - [weakref]Fonselectchange; -end +end + type tipaddr = class(tcustomipaddr) {** @explan(说明) ip控件 %% @@ -4858,6 +4399,7 @@ type TDragImageList=class(TCustomImageList) property Dragging:Boolean read FDragging; property ImageIndex read FImageIndex write FImageIndex; end +//////////gdi对象////////////////////////////////////// type TImage = class(tcustomimage) function create(); begin @@ -4865,7 +4407,6 @@ type TImage = class(tcustomimage) end end type TBitmap = class(tcustombitmap) - function create();override; begin inherited; @@ -4875,8 +4416,7 @@ type TIcon = class(tcustomicon) function create();override; begin inherited; - end - + end end type tcursor = class(tcustomcursor) function create();override; @@ -4884,28 +4424,25 @@ type tcursor = class(tcustomcursor) inherited; end end - type TFont = class(tcustomfont) function create();override; begin inherited; end end - type tpen = class(tcustompen) function create();override; begin inherited; end - end - type TBrush = class(tcustombrush) function create();override; begin inherited; end end +/////////////////////////////////////// type TCanvas = class(TCustomcanvas) function create();override; begin @@ -4921,10 +4458,7 @@ type TTimer = class(TCustomTimer) inherited; end end - //******action 相关***************************************** - - type TAction=class(TCustomAction) {** @explan(说明) action / command 类 对外接口,参考 TCustomAction 类 %% @@ -4941,7 +4475,6 @@ type tactionlist =class(TCustomactionlist) end end - //***************************** type TMessageboxADlg = class(TcustommsgADlg) {** @@ -4979,7 +4512,6 @@ type TSavefileADlg = class(tcustomfsdlg) begin inherited; end - end type TOpenFileADlg=class(tcustomfsdlg) {** @@ -6054,17 +5586,13 @@ type TTipMessageButton = class(TcustomTipMessageButton) begin inherited; end -end - - - +end type TInPutQuerys = class(TcustomInPutQuerys) function create(AOwner); begin inherited; end end - implementation ///////////////tmf文件转换/////////////////////// type Ttfm2Component = class(TTmfParser) @@ -7017,7 +6545,6 @@ begin end end end - end function initlib(); begin @@ -7028,7 +6555,7 @@ begin end Initialization - initlib(); +initlib(); Finalization end. diff --git a/funcext/tvclib/twincontrol.tsf b/funcext/tvclib/twincontrol.tsf index 1169a22..80b3e4b 100644 --- a/funcext/tvclib/twincontrol.tsf +++ b/funcext/tvclib/twincontrol.tsf @@ -2640,17 +2640,24 @@ type TWinControl = class(tcontrol) crec := ClientRect; dw := (brec[2]-brec[0])-(crec[2]-crec[0]); dh := (brec[3]-brec[1])-(crec[3]-crec[1]); + dh1 := crec[1]; + dh2 := dh-dh1; + dw1 := crec[0]; + dw2 := dw-dw1; cs := fchildsizing; if autosize and cs.layout>0 then begin - dh += cs.topbottomspacing; - dw += cs.leftrightspacing; + dh1 += cs.topbottomspacing; + dw1 += cs.leftrightspacing; + dh2 += cs.topbottomspacing; + dw2 += cs.leftrightspacing; end cts := Controls; w := 0; h := 0; aw := 0; ah := 0; + cc := 0; for i := 0 to ControlCount-1 do begin it := cts[i]; @@ -2658,6 +2665,51 @@ type TWinControl = class(tcontrol) if not it.Visible then continue; if (it is class(TWinControl)) and it.WsPopUp then continue; ita := it.Align; + case ita of + alNone: + begin + ibrc := it.BoundsRect; + w := max(ibrc[2],w); + h := max(ibrc[3],h); + end + alLeft,alRight: + begin + it.GetPreferredSize(wi,hi); + aw+=wi; + ah := max(ah,hi); + end + alTop,alBottom: + begin + it.GetPreferredSize(wi,hi); + ah += hi; + aw := max(wi,aw); + end + alClient: + begin + if cc<1 then + begin + //cc++; + if it.autosize then + begin + it.GetPreferredSize(wi,hi); + ah += hi; + aw += wi; + end else + begin + try + bs := it.UnAlignBounds; + except + end; + if bs then + begin + ah :=max(ah, bs[3]-bs[1]); + aw :=max(aw,(bs[2]-bs[0])); + end + end + end + end + end; + { if ita=alNone then begin ibrc := it.BoundsRect; @@ -2682,15 +2734,14 @@ type TWinControl = class(tcontrol) begin ah += bs[3]-bs[1]; aw +=(bs[2]-bs[0]); - end - - end + end + end} + end w := max(w,aw); h := max(h,ah); - w+=dw; - h+=dh; - + w+=dw2; + h+=dh2; end procedure DoControlAlign({rect});override; begin @@ -2793,7 +2844,7 @@ type TWinControl = class(tcontrol) @param(msg)(integer)消息号 %% @param(wparam)(integer)wparam %% @param(lparam)(integer)lparam %% - @param(param)(bool) true 采用post false 采用send %% + @param(f)(bool) true 采用post false 采用send %% @return(pointer) **} diff --git a/funcext/tvclib/utslmemo.tsf b/funcext/tvclib/utslmemo.tsf index 983b631..79f42e9 100644 --- a/funcext/tvclib/utslmemo.tsf +++ b/funcext/tvclib/utslmemo.tsf @@ -1645,8 +1645,8 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) // fy :=(FirstLine-FTopLine)* fTextHeight; ly :=(LastLine-FTopLine+1)* fTextHeight; r := ClientRect; - if lyr[3]then return; + if ly<(r[1]-2) then return; + if fy>(r[3]+2) then return; r[0]:= FGutter.Width; r[1]:= max(0,fy); r[3]:= min(r[3],ly); diff --git a/funcext/tvclib/utslvclgdi.tsf b/funcext/tvclib/utslvclgdi.tsf index 5caf37d..2a6f27d 100644 --- a/funcext/tvclib/utslvclgdi.tsf +++ b/funcext/tvclib/utslvclgdi.tsf @@ -1873,6 +1873,7 @@ type TCustomImageList=class(tcomponent) end function setsize(sz); begin + if ifnumber(sz) and sz>0 then return setsize(array(sz,sz)); if not(ifarray(sz) ) then return ; w := sz[0]; h := sz[1]; @@ -3143,6 +3144,7 @@ type TcustomCanvas = class(TSLUIBASE) @param(TextMetric)(ttagTEXTMETRICA) 文本样式信息 %% **} end + type tcustommemcanvas = class(tcustomcanvas) {** @explan(说明) 内存画布，支持保存png文件 %% @@ -3264,7 +3266,52 @@ type TControlCanvs=class(TcustomCanvas) FClipRect; end implementation - +{type tcustommetacanvas = class(tcustomcanvas) + function create(fn,w,h); + begin + inherited create(); + folddc := _wapi.GetDC(0); + get_w_h(w,h,wo,ho); + fcurhdc := _wapi.CreateEnhMetaFileA(folddc,fn,array(0,0,wo*26,ho*26),0); + fsaveid := _wapi.SaveDC(fcurhdc); + _wapi.SetGraphicsMode(fcurhdc,2); + handle := fcurhdc; + end + function destroy();override; + begin + _wapi.ReleaseDC(0,folddc); + _wapi.RestoreDC(fcurhdc,fsaveid); + _wapi.CloseEnhMetaFile(fcurhdc); + //_wapi.DeleteObject(fimg); + handle := 0; + inherited; + end + function save_wmf(fn); //保存png + begin + _wapi.CloseEnhMetaFile(fimg); + end + property width read FWidth; + property height read fheight; + private + function get_w_h(w,h,wo,ho); + begin + if w>0 then wo := int(w); + else + wo := _wapi.GetDeviceCaps(folddc,8); + if h>0 then ho := int(w); + else ho := _wapi.GetDeviceCaps(folddc,10); + FWidth := 400;//wo; + fheight := 400;//ho; + end + private + fsaveid; + FWidth; + fheight; + fimg; + foimg; + fcurhdc; + folddc; +end} ///////////////////////////////// type TResourcescache=class {** diff --git a/funcext/tvclib/utslvclpage.tsf b/funcext/tvclib/utslvclpage.tsf index 2c2e203..5a11b4f 100644 --- a/funcext/tvclib/utslvclpage.tsf +++ b/funcext/tvclib/utslvclpage.tsf @@ -22,7 +22,7 @@ type tcustomtabsheet = class(TCustomControl) // function AdjustSize();override; begin class(tcontrol).AdjustSize(); - end + end function paint();override; //设计器模式下绘制网格 begin drawdesigninggrid(); @@ -790,6 +790,30 @@ type tcustompagecontrol = class(tcustomtabcontrol) end end public + function GetPreferredSize(w,h);override; + begin + len := ftabitems.length(); + if len<1 then + begin + w := width; + h := height; + return ; + end + w := 100; + h := 100; + for i:= 0 to len-1 do + begin + FTabItems[i].PageSheet.GetPreferredSize(wi,hi); + w := max(w,wi); + h := max(h,hi); + end + rc := ClientRect; + bc := BoundsRect; + dh := bc[3]-bc[1]-(rc[3]-rc[1]); + dw := bc[2]-bc[0]-(rc[2]-rc[0]); + w := w+dw; + h := h+dh; + end function checknewchild(achild);override;//检查child begin r := inherited; diff --git a/funcext/tvclib/utslvclstdctl.tsf b/funcext/tvclib/utslvclstdctl.tsf index f11cc2e..0e8b7a2 100644 --- a/funcext/tvclib/utslvclstdctl.tsf +++ b/funcext/tvclib/utslvclstdctl.tsf @@ -879,8 +879,8 @@ type teditable=class(TSLUIBASE) // FHost := nil; if host is class(TWinControl)then begin - SetFont(host.font); FHost := host; + SetFont(host.font); end else begin if ohost then ohost.InvalidateRect(GetEntryRect(),false); @@ -1305,7 +1305,7 @@ type teditable=class(TSLUIBASE) // end end rc := GetEntryRect(); - if LineWrap then + if FLineWrap then begin if(FFontWidth * (len+1))>(rc[2]-rc[0])then return; end @@ -2965,104 +2965,6 @@ type tcustompassword = class(tcustomedit) end type tthreeEntry=class(TCustomControl) - private - type tpickerEditer=class(teditable) - function Create(); - begin - inherited; - border := false; - end - function valuemodify(); - begin - //修改日期 - if host then Host.ExecuteCommand("dtchanged",self); - end - fprev; - fnext; - protected - function doonsetfocus();override; - begin - ExecuteCommand("ecselall"); - end - function doonkillfocus();override; - begin - valuemodify(); - ExecuteCommand("ecclcsel"); - end - public - function GetEntryRect();override; - begin - r := ClientRect; - if not ifarray(r)then return array(0,0,0,0); - return r; - end - function WMCHAR(o,e);override; - begin - case e.char of - "0" to "9":return inherited; - end; - case e.CharCode of - VK_DELETE,VK_BACK:inherited; - end; - end - function WMKEYDOWN(o,e);override; - begin - case e.CharCode of - 13: - begin - return valuemodify(); - end - VK_LEFT: - begin - return GoToPrev(); - end - VK_RIGHT: - begin - return gotonext(); - end - VK_UP: - begin - return inc(); - end - VK_DOWN: - begin - return dec(); - end - end - inherited; - end - function inc(); - begin - s := text; - text := inttostr(strtointdef(s,0)+1); - valuemodify(); - end - function dec(); - begin - s := text; - text := inttostr(strtointdef(s,0)-1); - valuemodify(); - end - private - function gotonext(); - begin - valuemodify(); - if fnext then - begin - KillFocus(); - fnext.SetFocus(); - end - end - function GoToPrev(); - begin - valuemodify(); - if fprev then - begin - KillFocus(); - fprev.SetFocus(); - end - end - end public function create(aowner); begin @@ -3089,9 +2991,9 @@ type tthreeEntry=class(TCustomControl) begin FEntrys[i].fnext := FEntrys[(i+1)mod 3]; FEntrys[(i+1)mod 3].Fprev := FEntrys[i]; - end - calcCtls(); + end FEntrys :: mcell.host := self(true); + calcCtls(); end function GetPreferredSize(w,h);override; begin @@ -3102,6 +3004,11 @@ type tthreeEntry=class(TCustomControl) w := ftw*11+fth; h := fth+4; end + function WMSize(o,e);override; + begin + calcCtls(); + inherited; + end function paint();override; begin for i,v in FEntrys do @@ -3114,34 +3021,24 @@ type tthreeEntry=class(TCustomControl) if not ifarray(v)then continue; dc.drawtext(v["sym"],v["rec"],DT_CENTER .| DT_VCENTER .| DT_SINGLELINE); end + rec := ClientRect; + h := rec[3]-rec[1]; + FBtnRect := array(max(0,integer(rec[2]-min(25,h))),rec[1],rec[2]-1,rec[3]-1); PaintBtn(); end function PaintBtn();virtual; - begin - if FBtnRect then - begin - dc := Canvas; - dc.Draw("framecontrol",array(FBtnRect[0:1],FBtnRect[2:3]),DFC_SCROLL,DFCS_SCROLLDOWN); - end + begin + dc := Canvas; + dc.Draw("framecontrol",array(FBtnRect[0:1],FBtnRect[2:3]),DFC_SCROLL,DFCS_SCROLLDOWN); end function AdjustSize();override; begin if csLoading in ComponentState then return ; - if autosizing then return ; - if not HandleAllocated() then return ; - calcCtls(); + if autosizing then return ; + calcCtls(); class(TWinControl).AdjustSize(); - end - {function WMSize(o,e):LM_SIZE;virtual; - begin - - end - function DoWMSIZE(o,e);override; - begin - calcCtls(); InvalidateRect(nil,false); - inherited; - end} + end function dosetfocus(o,e);override; begin if csDesigning in ComponentState then return; @@ -3258,7 +3155,7 @@ type tthreeEntry=class(TCustomControl) begin FFontWidth := ft.width; for i,v in FEntrys do v.Font := ft; - //calcCtls(); + //calcCtls(); inherited; end end @@ -3266,9 +3163,6 @@ type tthreeEntry=class(TCustomControl) function calcCtls();virtual; begin rec := ClientRect; - h := rec[3]-rec[1]; - wd := rec[2]-rec[0]; - FBtnRect := array(max(0,integer(rec[2]-min(25,h))),rec[1],rec[2]-1,rec[3]-1); x := rec[0]+1; FSymInfo := array(); for i,v in FEntrys do @@ -3283,7 +3177,7 @@ type tthreeEntry=class(TCustomControl) FSymInfo[i,"sym"]:= getSym(i); FSymInfo[i,"rec"]:= rc; x := nx; - end + end end property BtnRect Read FBtnRect; property entrys read FEntrys; @@ -6490,11 +6384,17 @@ type TCustomSpinEdit = class(TCustomControl) begin class(tcontrol).GetPreferredSize(w,h); if ongetpreferredsize then return ; + ft := Font; + if not ft then return ; + h := ft.Height+4; bs := BoundsRect; cs := ClientRect; dh := (bs[3]-bs[1])-(cs[3]-cs[1]); h+=dh; - w := Width; + dw := (bs[2]-bs[2])-(cs[2]-cs[2]); + + w := (max(length(tostn(FMinValue)),length(tostn(FMaxValue)))+2)*ft.Width+FUDwidth; + w+=dw; end function paint();override; begin @@ -6618,7 +6518,7 @@ type tcustomgroupbox=class(TCustomControl) end function GetPreferredSize(w,h);override; begin - inherited; + return inherited; br := BoundsRect; cr := ClientRect; dh := (br[3]-br[1])-(cr[3]-cr[1])-8; @@ -6636,15 +6536,8 @@ type tcustomgroupbox=class(TCustomControl) end end private - function calc_rec(); - begin - - - end ftwidth; ftheight; - frecplus ; - fspacewidth; FtextPosition; end type tcustomprogressbar=class(TCustomControl) @@ -7637,6 +7530,483 @@ type tcustomprocess = class(tcomponent) // static fproces; static fpends; end +type tcustomtimepicker = class(tthreeEntry) + function create(aowner); + begin + inherited; + caption := "timepicker"; + width := 120; + ExecuteCommand("dttime",now()); + end + function ExecuteCommand(cmd,p);override; + begin + case cmd of + "dttime": + begin + if ifnumber(p) then + begin + decodedatetime(p,y,mt,d,h,m,s,ms); + ExecuteCommand("dtatime",array(h,m,s)); + + end else + begin + r := ExecuteCommand("dtatime"); + r2 := encodedatetime(2021,1,1,r[0],r[1],r[2],0); + if ifarray(r) then + begin + return frac(r2); + end + end + end + "dtatime": + begin + es := entrys; + if ifarray(p) and ifnumber(p[0]) and ifnumber(p[1]) and ifnumber(p[1]) then + begin + es[0].text := inttostr(p[0]); + es[1].text := inttostr(p[1]); + es[2].text := inttostr(p[2]); + ExecuteCommand("dtchanged",es[2]); + end else + begin + r := array(); + for i,v in es do r[i] := strtointdef(v.text,0); + return r; + end + end + "dtchanged": + begin + es := entrys; + if es[2]=p then + begin + t := p.text; + ti := strtointdef(t,0); + if ti<0 then + begin + p.text := "59"; + es[1].dec(); + end else + if ti>59 then + begin + p.text := "0"; + es[1].inc(); + end + end else + if es[1] = p then + begin + t := p.text; + ti := strtointdef(t,0); + if ti<0 then + begin + p.text := "59"; + es[0].dec(); + end else + if ti>59 then + begin + p.text := "0"; + es[0].inc(); + end + end else + if es[0] = p then + begin + t := p.text; + ti := strtointdef(t,0); + if ti<0 then p.text := "24"; + else if ti>24 then p.text := "0"; + end + if Fonselectchange then + calldatafunction(Fonselectchange,self(true),new tuieventbase(0,0,0,0)); + end + end + end + function PaintBtn();override; + begin + rec := BtnRect; + FRectUp := array(rec[0],rec[1],rec[2],integer(rec[1]+rec[3]/2)); + FRectDown := array(rec[0],integer(rec[1]+rec[3]/2),rec[2],rec[3]); + dc := Canvas; + dc.Draw("framecontrol",array(FRectUp[0:1],FRectUp[2:3]),DFC_SCROLL,DFCS_SCROLLUP); + dc.Draw("framecontrol",array(FRectDown[0:1],FRectDown[2:3]),DFC_SCROLL,DFCS_SCROLLDOWN); + end + function btnClicked(p);virtual; + begin + if pointinrect(p,FRectUp) then + begin + for i,v in entrys do + begin + if v.HasFocus then + begin + v.inc(); + return 1; + end + end + + end else + if pointinrect(p,FRectDown) then + begin + for i,v in entrys do + begin + if v.HasFocus then + begin + v.dec(); + return 1; + end + end + + end + end + function getTime();override;begin + {** + @explan(说明)获取控件当前选择的时间%% + @return(array)%% + **} + return ExecuteCommand("dtatime"); + end + function setTime(h,m,s);override;begin + {** + @explan(说明)设置控件当前选择的时间%% + @param(h)(integer)时，24小时制%% + @param(m)(integer)分%% + @param(s)(integer)秒%% + **} + return ExecuteCommand("dtatime",array(h,m,s)); + end + function recycling();override; + begin + inherited; + end + published + property onselectchange read Fonselectchange write Fonselectchange; + property onselchanged:eventhandler read Fonselectchange write Fonselectchange; + { + @param(onselchanged)(function[ttimepicker,tuieventbase])选择日期改变%% + } + private + function getEntryWidth(i);virtual; + begin + return 2; + end + function getSym(i);virtual; + begin + return ":"; + end + FRectUp; + FRectDown; + [weakref]Fonselectchange; +end +type tcustomdatetimepicker = class(tthreeEntry) +{** + @explan(说明) 日期选择控件 %% +**} + function create(aowner); + begin + inherited; + caption:="Date/TimePicker"; + FCalender := new tcustommonthcalendar(self); + FCalender.autosize := true; + FCalender.border := true; + FCalender.WsPopUp := true; + FCalender.parent := self; + FCalender.Visible := false; + //FScreenRect := _wapi.GetScreenRect(); + decodedate(date(),y,m,d); + setDate(y,m,d); + FCalender.onSelect := function(o,e)begin + FCalender.Visible := false; + d := FCalender.getCurrentSelection(); + setDate(d[0],d[1],d[2]); + end + FCalender.OnActivate := function(o,e)begin + if e.wparam=0 then + begin + FCalender.Visible := false; + end + end + end + function btnclicked(p);override; + begin + rec := BtnRect; + if pointinrect(p,rec) then + begin + ShowDropDown(true); + return true; + end + end + function ExecuteCommand(cmd,p);override; + begin + case cmd of + "dtchanged": + begin + es := entrys; + if p = es[2] then //日 + begin + pn := getenumber(p); + y := getenumber(es[0]); + m := getenumber(es[1]); + if pn<1 then p.text := inttostr(getmonthdates(y,m)); + else + if pn>28 and pn>getmonthdates(y,m) then + begin + p.text := "1"; + end + end else + if p = es[1] then //月 + begin + y := getenumber(es[0]); + m := getenumber(es[1]); + bm := m; + if m>12 then + begin + m := 1; + end else + if m<1 then m := 12; + if bm<>m then + begin + p.text := inttostr(m); + end + d := getenumber(es[2]); + if d<1 then es[2].text := "1"; + else + if d>28 then + begin + ct := getmonthdates(y,m); + if d>ct then es[2].text := inttostr(ct); + end + end else + if p = es[0] then //年 + begin + y := getenumber(p); + m := getenumber(es[1]); + d := getenumber(es[2]); + if dt>28 then + begin + ct := getmonthdates(y,m); + if d>ct then es[2].text := inttostr(ct); + end + end + if Fonselectchange then + calldatafunction(Fonselectchange,self(true),new tuieventbase(0,0,0,0)); + end + "dtadate": + begin + es := entrys; + if ifarray(p) and ifnumber(p[0]) and ifnumber(p[1]) and ifnumber(p[2]) then + begin + dt := encodedate(p[0],p[1],p[2]); + decodedate(dt,y,m,d); + es[0].text := inttostr(y); + es[1].text := inttostr(m); + es[2].text := inttostr(d); + if Fonselectchange then + calldatafunction(Fonselectchange,self(true),new tuieventbase(0,0,0,0)); + end else + begin + y := strtointdef(es[0].text,2021); + m := strtointdef(es[1].text,1); + d := strtointdef(es[2].text,1); + return array(y,m,d); + end + + end + + end + end + function ShowDropDown(f);virtual; + begin + {** + @explan(说明) 设置弹出框的显示区域 %% + **} + if not(FCalender ) then return ; + nv := ifnil(f)?true:(f?true:false); + if FCalender.Visible = nv then return FCalender.show(0); + rc := ClientRect; + nrc := ClientToScreen(rc[0],rc[3]); + p2 := clienttoscreen(rc[0],rc[1]+FCalender.height); + src := _wapi.GetScreenRect(nrc); + if (src[3]0 and ifnumber(xg.color) then begin set_lineinfo_to_canvas(cvs,xg); - //y1 := p_top; - //y2 := p_top+p_height; for i,v in faxes_objects[0].executecommand("get_tics_value") do begin if vfzoom_box[0,1] then continue; @@ -1564,6 +1578,7 @@ type tg_axes = class(tg_base) // xcd[ii++] := vi; vi+=stp; end + xcd[ii] := vi; end axi.tics_coord := xcd; end @@ -1998,26 +2013,31 @@ type tg_axes = class(tg_base) // return faxes_objects[idx]; end end - function gs_axes_bounds(idx,v); + function set_squred(v); begin - if ifarray(v) and ifnumber(v[0]) and ifnumber(v[1]) then + if not tg_boolen_value(v,nv) then return ; + if nv<>fsqured then begin - if idx in array(0,1,2,3) then + fsqured := nv; + prop_changed("axes_bounds",idx); + end + end + function set_axes_bounds(v); + begin + if ifarray(v) and ifnumber(v[0]) and ifnumber(v[1]) and v[2]>v[0] and v[3]>v[1] then + begin + if faxes_bounds<>v then begin - faxes_bounds[idx] := array(v[0],v[1]); + faxes_bounds := v; f_changed .|=c_g_paint_rect ; - prop_changed("axes_bounds",idx); + prop_changed("axes_bounds",idx); end - end else //get - begin - if idx in array(0,1,2,3) then return faxes_bounds[idx]; - return faxes_bounds; - end + end end function gs_data_bounds(vidx,v); begin idx := tg_get_true_idx(vidx); - if v=-1 then + if (v=-1) or (v=tgc_off) then begin if idx in array(0,1,2) then begin @@ -2071,21 +2091,19 @@ type tg_axes = class(tg_base) // return faxes_reverse; end end - function gs_margins(idx,v); //空白 + function gs_margins(v); //空白 begin - if ifnumber(v) then + if ifarray(v) then begin - if idx in array(0,1,2,3) then + if v<>fmargins and v[0]>0 and v[1]>0 and v[2]>0 and v[3]>0 and (v[0]+v[2])<1 and (v[1]+v[3])<1 then begin - fmargins[idx] := v; + fmargins := v; f_changed .|= c_g_paint_rect; - prop_changed("margins",idx); - end - end else //get - begin - if idx in array(0,1,2,3) then return fmargins[idx]; - return fmargins; - end + prop_changed("margins",idx); + end + return ; + end + return fmargins; end function gs_sub_ticks(vidx,v); //小刻度线 begin @@ -2323,22 +2341,33 @@ type tg_axes = class(tg_base) // end type tg_canvas = class(TcustomCanvas) //画布对象 uses utslvclgdi; - function create(h); + function create(h,fg); begin inherited create(); + ffigure := fg; FCvsHandle := h; Handle := h; faxesrgn := new TRGNPOLY();//new TRGNRECT(); + ffigurergn := new TRGNRECT();//new TRGNRECT(); + ffigurergn.rect := fg.rect(); faxesrgntemp := new TRGNPOLY();//new TRGNRECT(); + //ffigurergn. end - function axesclip(); + function axesclip(); //裁剪坐标系范围 begin if faxesrgn then begin _wapi.SelectClipRgn(FCvsHandle,faxesrgn.Handle); //裁剪区域 end end - function clip_rgn(pts);//裁剪区域 + function figureclip(); //裁剪figure区域 + begin + if ffigurergn then + begin + _wapi.SelectClipRgn(FCvsHandle,ffigurergn.Handle); //裁剪figure + end + end + function clip_rgn(pts);//裁剪指定区域 begin faxesrgntemp.points := pts; h := faxesrgntemp.Handle; @@ -2351,16 +2380,22 @@ type tg_canvas = class(TcustomCanvas) // function destroy(); begin Handle := 0; - faxesrgn := nil; + faxesrgn := nil; + ffigurergn := nil; + faxesrgntemp :=nil; end - property axesvector read faxesvector write set_clip_vector; - property axesrec read FaxesRec write set_clip_rect; + property figure:tg_figure read ffigure; //绘制区域 + property axesvector read faxesvector write set_clip_vector; //坐标系区域 + property axesrec read FaxesRec write set_clip_rect; //坐标系矩形区域 private FaxesRec; faxesvector; FCvsHandle; faxesrgn; + ffigurergn; faxesrgntemp; + ffigurerect; + [weakref]ffigure; private function set_clip_rect(rec); begin @@ -2407,6 +2442,17 @@ type tg_axis_main = class(tg_axis) // end private [weakref] faxes; + function getfontinfo();override; + begin + if faxes and (ParentFont=tgc_on) then + begin + r := faxes.fontinfo; + r.flinker := self(true); + return r; + end + ffontinfo.flinker := self(true); + return ffontinfo; + end end type tg_label_axis = class(tg_base) //坐标轴标签 public @@ -2694,6 +2740,7 @@ type tg_axis = class(tg_base) // function draw_axis(cvs,subtks); begin pw := lineinfo.width; + set_lineinfo_to_canvas(cvs); tksize := pw+fticksize; tic_space := 3; tksizesub := fsubticksize+pw; @@ -3026,8 +3073,9 @@ type tg_text = class(tg_base) begin if (visible<>tgc_on) then return ; if not fdata then return ; + if not ftext then return ; if not zoom_to_xyz(fdata[0],fdata[1],fdata[2],x,y) then return ; - if clip_state=tgc_on then + if clip_state=tgc_on or ((p:=parent) and p.clip_state=tgc_on) then begin bx := axes.zoom_box; vj := fdata; @@ -3049,10 +3097,10 @@ type tg_text = class(tg_base) rgn_points_trans(Frgnpoints,-ffont_angle); x := 0; y := 0; - end - set_lineinfo_to_canvas(cvs); + end if line_mode=tgc_on then begin + set_lineinfo_to_canvas(cvs); rc := array(x,y,x+w,y+h); cvs.draw_rect().rect(rc).draw(); end @@ -3112,6 +3160,7 @@ type tg_text = class(tg_base) function set_text(v); begin tx := array(); + if ifstring(v) and v then return set_text(array(v)); if not ifarray(v) then return ; for i,vi in v do begin @@ -3181,45 +3230,7 @@ type tg_label =class(tg_base) // end txtw := length(ftext)*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; + modify_text_pos(x_,y_,txtw,txth,ftextalign);//修正位置 rec := array(x_,y_,x_+txtw,y_+txth); flabel_rgn := rec_to_points(rec)[0:3]; if ffont_angle<>0 then @@ -4126,211 +4137,177 @@ type tg_Polyline = class(tg_graph) // end end end -type tg_line_info = class(tg_const) //线型信息 +type tg_gdi = class(tg_const) //gdi对象基类 + function create(awner); + begin + fpdata := array(); + FOwner := awner; + end + function clone();//克隆信息 + begin + r := createobject(self(true).Classinfo(1),nil); + r.fpdata := fpdata; + return r; + end + property info read fpdata write set_pdatas; //数据信息 + [weakref]flinker; + protected + function check_prop(idx,v);virtual;//检查数据 + begin + return true; + end + function set_pdatas(d); //设置数据 + begin + if flinker then + begin + flinker.ParentFont := false; + if flinker<>FOwner then + begin + ft := flinker.fontinfo; + ft.info := d; + return ; + end + end + { + if (flinker and flinker<>FOwner) then + begin + flinker.ParentFont := false; + ft := flinker.fontinfo; + ft.info := d; + return ; + end } + for i,v in d do + begin + if fpdata[i]<>v and check_prop(i,v) then + begin + cg := true; + fpdata[i] := v; + end + end + if cg then + begin + pdata_changed(); + end + end + function pdata_changed();virtual; //数据改变 + begin + if fonwer then fonwer.invalidate(); + end + function get_pdata(idx);//获取单个字段 + begin + return fpdata[idx]; + end + function set_pdata(idx,v);//设置单个值 + begin + set_pdatas(array(idx:v)); + end + fpdata; //数据 + private + [weakref]FOwner; +end +type tg_line_info = class(tg_gdi) //线型信息 function create(awer); begin - fcolor := 0; - FWidth := 1; - FStyle := tgc_PS_SOLID; - fbkcolor := nil; - fonwer := awer; + inherited; + fpdata := array("color":0,"size":1,"style":tgc_PS_SOLID,"bkcolor":nil); end - function clone(); + property style index "style" read get_pdata write set_pdata; + property width index "size" read get_pdata write set_pdata; + property size index "size" read get_pdata write set_pdata; + property color index "color" read get_pdata write set_pdata; + property bkcolor index "bkcolor" read get_pdata write set_pdata; + protected + function check_prop(idx,v);override;//检查数据 begin - r := new tg_line_info(); - r.style := fstyle; - r.width := FWidth; - r.size := FWidth; - r.color := fcolor; - r.bkcolor := fbkcolor; - return r; + case idx of + "size": + begin + return ifnumber(v) and v>=0; + end + "style","color": + begin + return ifnumber(v); + end + "bkcolor": + begin + return ifnumber(v) or ifnil(v); + end + end + return false; end - property style index "style" read FStyle write setpropid; - property width index "width" read FWidth write setpropid; - property size index "size" read FWidth write setpropid; - property color index "color" read fcolor write setpropid; - property bkcolor index "bkcolor" read fbkcolor write setpropid; - private - fwidth; - fcolor; - FStyle; - fbkcolor; - function setpropid(id,v); - begin - case id of - "style": - begin - if FStyle<>v and ifnumber(v) then - begin - FStyle := v; - if fonwer then fonwer.invalidate(); - end - end - "width","size": - begin - if FWidth<>v and ifnumber(v) and (v>=0) then - begin - FWidth := v; - if fonwer then fonwer.invalidate(); - end - end - "color": - begin - if fcolor<>v and ifnumber(v) then - begin - fcolor := v; - if fonwer then fonwer.invalidate(); - end - end - "bkcolor": - begin - if fbkcolor<>v and (ifnumber(v) or ifnil(v)) then //设置颜色 - begin - fbkcolor := v; - if fonwer then fonwer.invalidate(); - end - end - end; - end - [weakref]fonwer; end -type tg_font_info = class(tg_const) //字体信息 +type tg_font_info = class(tg_gdi) //字体信息 function create(awner); begin - fstyle := nil; - fsize := 7; - fforeground := 0; - fbackground := nil; - fonwer := awner; + inherited; + fpdata := array("style":nil,"size":7,"color":0,"bkcolor":nil); end - function clone(); + property style index "style" read get_pdata write set_pdata; + property size index "size" read get_pdata write set_pdata; + property color index "color" read get_pdata write set_pdata; + property bkcolor index "bkcolor" read get_pdata write set_pdata; + protected + function check_prop(idx,v);override;//检查数据 begin - r := new tg_font_info(); - r.style := fstyle; - r.size := fsize; - r.color := fforeground; - r.bkcolor := fbackground; - return r; - end - property style index "style" read fstyle write setpropid; - property size index "size" read fsize write setpropid; - property color index "color" read fforeground write setpropid; - property bkcolor index "bkcolor" read fbackground write setpropid; - private - fstyle; - fsize; - fsize_unit; - fforeground; - fbackground; - [weakref]fonwer; - function setpropid(id,v); - begin - case id of - "style": - begin - if FStyle<>v and ifnumber(v) then - begin - FStyle := v; - if fonwer then fonwer.invalidate(); - end - end + case idx of "size": begin - if fsize<>v and ifnumber(v) and (v>5) then - begin - fsize := v; - if fonwer then fonwer.invalidate(); - end - end - "color": + return ifnumber(v) and v>5; + end + "style": begin - if fforeground<>v and ifnumber(v) then - begin - fforeground := v; - if fonwer then fonwer.invalidate(); - end + return ifnumber(v); + end + "color": + begin + return ifnumber(v) or (v=tgc_complementary_color); end "bkcolor": begin - if fbackground<>v and (ifnumber(v) or ifnil(v)) then - begin - fbackground := v; - if fonwer then fonwer.invalidate(); - end - end - - end; - end + return ifnumber(v) or ifnil(v); + end + end + return false; + end end -type tg_mark_info = class(tg_const) //标记信息 +type tg_mark_info = class(tg_gdi) //标记信息 function create(awner); begin - fstyle := tgc_mks_dot; - fsize := 0; - fsize_unit := tgc_mk_point; - fforeground := 0; - fbackground := 0xffffff; - fonwer := awner; + inherited; + fpdata := array("style":tgc_mks_dot,"size":0,"size_unit":tgc_mk_point,"color":0,"bkcolor":0xffffff); end - function clone(); + property style index "style" read get_pdata write set_pdata; + property size index "size" read get_pdata write set_pdata; + property size_unit read get_pdata write set_pdata; + property color index "color" read get_pdata write set_pdata; + property bkcolor index "bkcolor" read get_pdata write set_pdata; + protected + function check_prop(idx,v);override;//检查数据 begin - r := new tg_mark_info(); - r.Style := fstyle; - r.size := fsize; - r.size_unit := fsize_unit; - r.color := fforeground; - r.bkcolor := fbackground; - return r; - end - property style index "style" read fstyle write setpropid; - property size index "size" read fsize write setpropid; - property size_unit read fsize_unit write fsize_unit; - property color index "color" read fforeground write setpropid; - property bkcolor index "bkcolor" read fbackground write setpropid; - private - fstyle; - fsize; - fsize_unit; - fforeground; - fbackground; - [weakref]fonwer; - function setpropid(id,v); - begin - case id of - "style": + case idx of + "size_unit": begin - if FStyle<>v and ifnumber(v) then - begin - FStyle := v; - if fonwer then fonwer.invalidate(); - end + return (tgc_mk_tabulated=v or tgc_mk_point=v); end "size": begin - if fsize<>v and ifnumber(v) then - begin - fsize := v; - if fonwer then fonwer.invalidate(); - end + return ifnumber(v) and v>=0; end + "style": + begin + return (v and ifstring(v)); + end "color": begin - if fforeground<>v and ifnumber(v) then - begin - fforeground := v; - if fonwer then fonwer.invalidate(); - end + return ifnumber(v); end "bkcolor": begin - if fbackground<>v and (ifnumber(v) or ifnil(v)) then - begin - fbackground := v; - if fonwer then fonwer.invalidate(); - end - end - end; - end + return ifnumber(v) or ifnil(v); + end + end + return false; + end end type tg_evet_conainter = class(tg_const) //带消息的绘图基类 function create(); @@ -4369,6 +4346,7 @@ type tg_base = class(TNode,tg_evet_conainter) // fenabled := tgc_on; fline_mode := tgc_off; fmark_mode := tgc_off; + fParentFont := tgc_on; flineinfo := new tg_line_info(self(true)); fmarkinfo := new tg_mark_info(self(true)); ffontinfo := new tg_font_info(self(true)); @@ -4425,24 +4403,26 @@ type tg_base = class(TNode,tg_evet_conainter) // else li := lineinfo; cl := li.color; - cvs.pen.style := li.style; + bcl := li.bkcolor; + cp := cvs.pen; + cp.style := li.style; if ifnumber(cl) then begin - cvs.pen.color := cl; + cp.color := cl; end else begin - cvs.pen.Style := tgc_BS_NULL; + cp.Style := tgc_BS_NULL; end - cvs.pen.width := li.width; - bcl := li.bkcolor; + cp.width := li.width; + cb := cvs.brush; if ifnumber(bcl) then begin - cvs.brush.color := bcl; - cvs.brush.Style := tgc_BS_SOLID; + cb.color := bcl; + cb.Style := tgc_BS_SOLID; end else begin - cvs.brush.Style := tgc_BS_NULL; + cb.Style := tgc_BS_NULL; end end function set_fontinfo_to_canvas(cvs,info); //设置字体信息到画布 @@ -4450,10 +4430,19 @@ type tg_base = class(TNode,tg_evet_conainter) // if info is class(tg_font_info) then fi := info; else fi := fontinfo; - cvs.font.color := fi.color; - cvs.font.bkcolor := fi.bkcolor; - cvs.font.width := fi.size; - cvs.font.height := fi.size*2; + cf := cvs.font; + if ifnil(fi.bkcolor) then cf.bkmode := 1; + else cf.bkmode := 2; + bc := fi.bkcolor; + cf.bkcolor := bc; + if fi.color =tgc_complementary_color then + begin + if ifnil(bc) then cf.color := 0; + else + cf.color := calc_complementary_color(bc); + end else cf.color := fi.color; + cf.width := fi.size; + cf.height := fi.size*2; end function dispatchEvent(evt); //分发 begin @@ -4496,7 +4485,8 @@ type tg_base = class(TNode,tg_evet_conainter) // property enabled read fenabled write setenabled; property lineinfo read flineinfo; property markinfo read fmarkinfo; - property fontinfo read ffontinfo; + property fontinfo read getfontinfo; + property ParentFont read fParentFont write setParentFont; property change_locked read fchange_locked write fchange_locked; property onhit_at read fonhit_at write fonhit_at; public @@ -4533,6 +4523,8 @@ type tg_base = class(TNode,tg_evet_conainter) // end return r; end + protected + ffontinfo; private [weakref]fonhit_at; fclip_state; @@ -4542,8 +4534,29 @@ type tg_base = class(TNode,tg_evet_conainter) // fenabled; flineinfo; fmarkinfo; - ffontinfo; + fchange_locked; + fParentFont; + function getfontinfo();virtual; + begin + p := parent; + if p and (fParentFont=tgc_on) then + begin + r := p.fontinfo; + r.flinker := self(true); + return r; + end + ffontinfo.flinker := self(true); + return ffontinfo; + end + function setParentFont(v); + begin + if tg_boolen_value(v,nv) and nv <>fParentFont then + begin + fParentFont := nv; + prop_changed("parentfont",nv); + end + end function set_clip_state(v); begin if tg_boolen_value(v,nv) and (nv<>fclip_state) then @@ -4620,20 +4633,22 @@ type tg_const = class() static const tgc_mks_triangle_up = "triangle_up"; static const tgc_mks_triangle_down = "triangle_down"; static const tgc_mks_triangle_left = "triangle_left"; - static const tgc_mks_triangle_right = "triangle_right"; + static const tgc_mks_triangle_right = "triangle_right"; + ///////////点类型///////////////////////////////////////////// static const tgc_mk_tabulated = "tabulated"; static const tgc_mk_point = "point"; /////////////////数据提示类型//////////////////////////////////// static const tgc_DT_always = "always"; static const tgc_DT_mouseclick = "mouseclick"; static const tgc_DT_mouseover = "mouseover"; - ////////////画笔画刷类型///////////////////////////////// + ////////////线类型///////////////////////////////// static const tgc_PS_SOLID=0x0; static const tgc_PS_DASH=0x1; static const tgc_PS_DOT=0x2; static const tgc_PS_DASHDOT=0x3; static const tgc_PS_DASHDOTDOT=0x4; static const tgc_PS_NULL=0x5 ; + /////////////填充类型//////////////// static const tgc_BS_NULL=1; static const tgc_BS_SOLID=0; @@ -4674,6 +4689,9 @@ type tg_const = class() static const cmd_figure_changed = "figure_changed"; static const cmd_data_changed = "data_changed"; static const cmd_node_add_in = "node_add_in"; + ///////////////////////////////////////////////////////// + static const tgc_complementary_color = "complementary_color"; //采用补色 + //////////////////////////////// end type tg_evt =class() //消息 @@ -4796,12 +4814,12 @@ type tevent_item = class() ename; [weakref]efunc; end -type tevent_list = class() +type tevent_list = class() //消息对象列表 function create(); begin FItems := array(); end - function add(n,f); + function add(n,f); //添加 begin if not(ifstring(n) and n) then return 0; if not ifobj(f) then return 0; @@ -4812,7 +4830,7 @@ type tevent_list = class() FItems[length(FItems)] := new tevent_item(n,f); return true; end - function remove(n,f); + function remove(n,f);//移除 begin idx := -1; for i,v in FItems do @@ -4829,7 +4847,7 @@ type tevent_list = class() remove(n,f); end end - function dispatch(e); + function dispatch(e);//分发 begin for i,it in FItems do begin @@ -4891,19 +4909,19 @@ begin _x := x*cos(ag)+y*sin(ag); _y := -x*sin(ag)+y*cos(ag); end -function graph_paint_lines(cvs,pls,xys,cls,ifo); +function graph_paint_lines(cvs,pls,xys,cls,ifo);//绘制线 begin return paint_lines(cvs,pls,xys,cls,ifo); end -function graph_paint_points(mk,dc,xys); +function graph_paint_points(mk,dc,xys);//绘制点 begin return paint_marks(mk,dc,xys); end -function graph_paint_boolen_value(n,v); +function graph_paint_boolen_value(n,v);//布尔类型格式化 begin return tg_boolen_value(n,v); end -function graph_paint_rec_to_points(rec); +function graph_paint_rec_to_points(rec);//将rect转换为点数组 begin return rec_to_points(rec); end @@ -5247,7 +5265,7 @@ begin end return d; end -function modify_text_pos(x_,y_,txtw,txth,al); +function modify_text_pos(x_,y_,txtw,txth,al);//修正对齐位置 begin case al of 2: @@ -5424,7 +5442,7 @@ begin pts[i] := array(x+px,y+py); end end -function tg_get_true_idx(idx); +function tg_get_true_idx(idx);//坐标规范化 begin nidx := idx; case idx of @@ -5433,6 +5451,11 @@ begin "z","Z": nidx := 2; end ; return nidx; +end +/////////////////////////////////////// +function calc_complementary_color(c);//补色计算 +begin + return rgb((255-GetRValue(c)),(255-GetgValue(c)),(255-GetbValue(c))); end //////////////////////////////////////// initialization diff --git a/funcext/tvclib/utvclgraphicsext.tsf b/funcext/tvclib/utvclgraphicsext.tsf index e534afe..061faff 100644 --- a/funcext/tvclib/utvclgraphicsext.tsf +++ b/funcext/tvclib/utvclgraphicsext.tsf @@ -482,7 +482,7 @@ type tg_Polycandlestick = class(tg_graph) //k end function get_data_bounds();override; //边界 begin - fdata_bounds[0,1] := length(fgraph_data); + //fdata_bounds[0,1] := length(fgraph_data); return fdata_bounds; end function paint(cvs);override; //绘制 @@ -579,11 +579,10 @@ type tg_Polycandlestick = class(tg_graph) //k 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); + fdata_bounds[0,1] := length(d); + fdata_bounds[1,0] := minvalue(d[:,4]); + fdata_bounds[1,1] := maxvalue(d[:,3]); inherited; end end @@ -740,11 +739,11 @@ type tg_Polyboxplot = class(tg_graph) // function get_legend_size(w,h);virtual; //?????????? begin mk := markinfo; - h := fontinfo.size+4; + h := fontinfo.size*2+4; w := 100; if mark_mode=tgc_on then begin - h := max(10,mk.size+4); + h := max(h,mk.size+4); w := 5*h; end end @@ -806,16 +805,18 @@ end type tg_Polypie = class(tg_graph) //饼图 function create(pms); begin + ftexts := array(); + fshow_text := 1; + pie_radian := array(); inherited; clip_state := tgc_on; - fcolormap := array(0xc67054, 0x75cc91, 0x58c8fa, 0x6666ee, 0xdec073, 0x72a23b, 0x5284fc, 0xb4609a, 0xcc7cea); + fcolormap := get_default_color_list(); 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; //?????? + function get_data_bounds();override; // begin return fdata_bounds; end @@ -825,7 +826,6 @@ type tg_Polypie = class(tg_graph) // 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 @@ -844,26 +844,13 @@ type tg_Polypie = class(tg_graph) // 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(); + prominentidx := 1;// + prominentrate := 0; // 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 @@ -872,11 +859,9 @@ type tg_Polypie = class(tg_graph) // 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); + pie_data := 1+get_rose_lines(v[0],v[1],i=prominentidx,prominentrate, v[3]); 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 ; @@ -884,13 +869,17 @@ type tg_Polypie = class(tg_graph) // 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)); + paint_pie(cvs,xys,array("line_mode":line_mode,"color":item_color,"bkcolor":item_color,"xy0":ys)); fpei_parts_data[i] := xys; end end function executecommand(cmd,p);override; begin case cmd of + "get_texts": + begin + return ftexts; + end "hit_part": begin for i,v in fpei_parts_data do @@ -899,54 +888,54 @@ type tg_Polypie = class(tg_graph) // 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; //?????????? + function get_legend_size(w,h);override; //获取图例大小 begin + if not pie_radian then return inherited; sz := fontinfo.size; - h := (sz+6)*max(1,length(pie_radian))+5; + h := (sz*2+6)*max(1,length(pie_radian))+5; w := 0; ws := 5; - for i,v in fgraph_data do + for i,v in pie_radian do begin - si :=v["name"]; + si :=v[2]; if ifstring(si) then ws := max((length(si))*sz,ws); end w +=ws; w +=35; end - function paint_legend(cvs,rec);override; //??????? + 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 + h := fontinfo.size*2+6;// + ((h-fontinfo.size)/2); + y0 := rec[1]+h; + for i,v in pie_radian 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)); + xys := array((rec[0]+2,y0+i*h-3),(rec[0]+25,y0+i*h-3),(rec[0]+25,y0-h+6+i*h),(rec[0]+2,y0-h+6+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)); + cvs.textout(v[2],array(rec[0]+30,y0+(i-1)*h+3)); 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" ?????? + property color_map read fcolormap write set_colormap;//颜色地图 + property pie_type read fpie_type write set_pie_type;//类型 + property show_text read fshow_text write set_show_text; private + ftexts; + fshow_text; pie_radian; fpei_parts_data; fdata_bounds; fpie_type; fforeground; fbackground; - fsection_info; fcolormap; protected - function set_graph_data(d);override; //???????? + function set_graph_data(d);override; //设置数据 begin if d<>fgraph_data then begin @@ -955,9 +944,26 @@ type tg_Polypie = class(tg_graph) // fdata_bounds[0,1] := 2; fdata_bounds[1,1] := 2; inherited; - end + data_process(); + end end private + function set_pie_type(v); + begin + if v<>fpie_type and ( v in array("pie","rose","ring")) then + begin + fpie_type := v; + data_process(); + end + end + function set_show_text(v); + begin + if v<>fshow_text and (v in array(0,1,2,3)) then + begin + fshow_text := v; + data_process(); + end + end function set_colormap(v); begin if ifarray(v) and v<>fcolormap then @@ -965,53 +971,88 @@ type tg_Polypie = class(tg_graph) // fcolormap := v; end end - function IsPointInPieSection(opt); + function data_process(); // 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 + total := 0; + total_value_list := array(); + for i,v in fgraph_data do begin - segments[i][0] := currentAngle; - segments[i][1] := currentAngle + (v['value'] / total) * 2 * pi(); - currentAngle := segments[i][1]; + total := total + v['value']; + total_value_list[i] := v['value']; end - return segments; + maxt := maxvalue(total_value_list); + currentAngle := 0; + pie_radian := array(); + for i,v in ftexts do //清空 + begin + v.parent := false; + end + ftexts := array(); + for i,v in fgraph_data do + begin + pie_radian[i][0] := currentAngle; + rs := v['value'] / total; + pie_radian[i][1] := currentAngle + (rs) * 2 * pi(); + sri := format("%3f",rs*100)+"%"; + pie_radian[i][2] := mult_str(" ",7-length(sri))$sri$" "$v["name"]; + pie_radian[i][3] := v['value']/maxt; + pie_radian[i][4] := currentAngle + rs * pi(); + pie_radian[i][5] := (rs) * 2 * pi(); + carg := currentAngle + rs * pi(); + currentAngle := pie_radian[i][1]; + gtx := new tg_text(); + gtx.parent := self; + gtx.clip_state :=false; + case pie_type of + "rose": + begin + gtx.data := 1+array(sin(pie_radian[i][4])*pie_radian[i][3],cos(pie_radian[i][4])*pie_radian[i][3]); + end + "ring": + begin + gtx.data := 1+array(sin(pie_radian[i][4])*0.7,cos(pie_radian[i][4])*0.7); + end else + begin + gtx.data := 1+array(sin(pie_radian[i][4]),cos(pie_radian[i][4]))*0.8; + end + end ; + if carg<(pi()/4) then + begin + gtx.textalign := 8; + end else + if carg<(pi()*3/4) then + begin + gtx.textalign := 4; + end else + if carg<(pi()*5/4) then + begin + gtx.textalign := 2; + end else + if carg<(pi()*7/4) then + begin + gtx.textalign := 6; + end else gtx.textalign := 8; + case fshow_text of + 1: + begin + gtx.text := array(sri); + end + 2: + begin + gtx.text := array(v["name"]); + end + 3: + begin + gtx.text := array(pie_radian[i][2]); + end + else + begin + gtx.text := array(); + end + end; + ftexts[i] := gtx; + end + end function get_pie_lines(arg1,arg2,prominent,prominentrate); //????????????? begin @@ -1020,7 +1061,7 @@ type tg_Polypie = class(tg_graph) // r := array(); r[0] := array(0,0); idx := 1; - for i:= arg1+(prominent?stp:0) to arg2-(prominent?stp:0) step stp do + for i:= arg1 to arg2 step stp do begin r[idx++] := array(sin(i),cos(i)); end @@ -1033,34 +1074,7 @@ type tg_Polypie = class(tg_graph) // 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; // 返回包围区域内的所有点 + return r*0.8; end function get_rose_lines(arg1,arg2,prominent,prominentrate,proportion); //??????????????? begin @@ -1069,9 +1083,9 @@ type tg_Polypie = class(tg_graph) // r := array(); r[0] := array(0,0); idx := 1; - for i:= arg1+(prominent?stp:0) to arg2-(prominent?stp:0) step stp do + for i:= arg1 to arg2 step stp do begin - r[idx++] := array(sin(i)*proportion,cos(i)*proportion); + r[idx++] := array(sin(i),cos(i)); end r[idx] :=array(0,0); if prominent then @@ -1082,7 +1096,7 @@ type tg_Polypie = class(tg_graph) // r[i]+=rx; end end - return r; + return r*proportion; end end type tg_Polyradar = class(tg_graph) //雷达图 @@ -1091,7 +1105,7 @@ type tg_Polyradar = class(tg_graph) // findicator_texts := array(); inherited; clip_state := tgc_on; - fcolormap := array(0xc67054, 0x75cc91, 0x58c8fa, 0x6666ee, 0xdec073, 0x72a23b, 0x5284fc, 0xb4609a, 0xcc7cea); + fcolormap := get_default_color_list(); line_mode := tgc_on; mark_mode := tgc_off; fdata_bounds := array((0,1),(0,1),(0,1)); @@ -1161,7 +1175,7 @@ type tg_Polyradar = class(tg_graph) // function get_legend_size(w,h);override; //图例大小 begin sz := fontinfo.size; - h := (sz+6)*max(1,length(fgraph_data))+5; + h := (sz*2+6)*max(1,length(fgraph_data))+5; w := 0; ws := 5; for i,v in fgraph_data do @@ -1176,7 +1190,7 @@ type tg_Polyradar = class(tg_graph) // begin set_lineinfo_to_canvas(cvs); set_fontinfo_to_canvas(cvs); - h := fontinfo.size+6;// + ((h-fontinfo.size)/2); + h := fontinfo.size*2+6;// + ((h-fontinfo.size)/2); y0 := rec[1]+h; for i,v in fgraph_data do begin @@ -1537,20 +1551,32 @@ type tg_Polytree = class(tg_graph) // 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)); + TreeY := Tree.Y; + TreeX := Tree.X; + tndj := Tree.GetNodeByIndex(j); + Treejy := tndj.Y; + Treejx := tndj.x; + try2 := (TreeY + Treejy) / 2; _data := array( + (TreeY, TreeX), + (try2, TreeX), + (try2, Treejx), + (Treejy, Treejx) + ); + {_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; + fline_points_in_canvas := xys; + set_lineinfo_to_canvas(cvs); 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 @@ -1582,8 +1608,8 @@ type tg_Polytree = class(tg_graph) // 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; + //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 @@ -1622,7 +1648,7 @@ type tg_Polytree = class(tg_graph) // end else begin gtx := new tg_text(); - gtx.clip_state := tgc_on; + gtx.clip_state := tgc_off; gtx.parent := self; gtx.text := array(n); gtx.data := array(Tree.Y, Tree.X); @@ -1641,11 +1667,12 @@ type tg_Polytree = class(tg_graph) // 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)); + ndj := Tree.GetNodeByIndex(j); + //fdata_bounds[0,0] := 0; + //fdata_bounds[1,0] := 0; + fdata_bounds[0,1] := Max(fdata_bounds[0,1],ndj.Y); + fdata_bounds[1,1] := Max(fdata_bounds[1,1],ndj.X); + find_data_bounds(ndj); end end end @@ -1657,7 +1684,7 @@ type tg_Polysunburst = class(tg_graph) // inherited; ftext_container := array(); clip_state := tgc_on; - fcolormap := array(0xc67054, 0x75cc91, 0x58c8fa, 0x6666ee, 0xdec073, 0x72a23b, 0x5284fc, 0xb4609a, 0xcc7cea); + fcolormap := get_default_color_list(); line_mode := tgc_on; mark_mode := tgc_off; fbar_width := 0; @@ -1692,8 +1719,6 @@ type tg_Polysunburst = class(tg_graph) // 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 @@ -1710,13 +1735,14 @@ type tg_Polysunburst = class(tg_graph) // angle := startAngle; _r3 := r1 + (r2 - r1); _r4 := r2 + (r2 - r1); - if ifarray(node['children']) then + ndc := node['children']; + if ndc and ifarray(ndc) then begin - for i := 0 to length(node['children'])-1 do + for i := 0 to length(ndc)-1 do begin childStartAngle := angle; xys := array(); - _portion := CalculateTotalValue(node['children'][i]) / totalValue; + _portion := CalculateTotalValue(ndc[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 @@ -1726,44 +1752,42 @@ type tg_Polysunburst = class(tg_graph) // zoom_to_xyz(v[0],0,0,x,y) ; end fline_points_in_canvas := xys; - its := node['children'][i]['itemstyle']['color']; + its := ndc[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); + CalculateCoordinates(_portion * x1, y1, _r3, _r4, childStartAngle, childEndAngle, ndc[i], cvs, bx); angle := childEndAngle; end; end end; function CalculateTotalValue(node); //设置数据 begin - if node = nil then - return 0; + 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 + ndc := node['children']; + if ifarray(ndc) and ndc then begin - for i := 0 to length(node['children'])-1 do + for i := 0 to length(ndc)-1 do begin - totalValue := totalValue + CalculateTotalValue(node['children'][i]); + totalValue := totalValue + CalculateTotalValue(ndc[i]); end; end return max(pv,totalValue); - node['value'] := totalValue; - return node['value']; end; function getTreeDepth(node); //获取深度 begin - if node['children'] = nil then + ndc := node['children']; + if not(ifarray(ndc) and ndc) then begin return 0; end _deep := 0; - for i := 0 to length(node['children'])-1 do + for i := 0 to length(ndc)-1 do begin - _deep := Max(_deep, getTreeDepth(node['children'][i])); + _deep := Max(_deep, getTreeDepth(ndc[i])); end return _deep + 1; end @@ -1841,28 +1865,37 @@ type tg_Polysunburst = class(tg_graph) // totalValue := CalculateTotalValue(node); angle := startAngle; _r3 := r1 + (r2 - r1); - _r4 := r2 + (r2 - r1); + _r4 := r2 + (r2 - r1); + textct := length(ftext_container)>0; 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 + if textct then + begin gtx.font_angle := ((startAngle + endAngle) / 2) - pi()/2; + text_data := fcenter+get_pie_ring_center(startAngle,endAngle,r1,r2,0,0); + end else + begin + gtx.textalign := 5; + text_data := fcenter+get_pie_ring_center(startAngle,endAngle,r1/2,r2,0,0); + end + gtx.data := text_data; gtx.parent := self; - gtx.text := array(node['name']); - gtx.data := text_data; + gtx.text := array(node['name']); ftext_container[length(ftext_container)] := gtx; - end - if ifarray(node['children']) then + end + ndc := node['children']; + if ifarray(ndc) and ndc then begin - for i := 0 to length(node['children'])-1 do + for i := 0 to length(ndc)-1 do begin childStartAngle := angle; - _portion := CalculateTotalValue(node['children'][i]) / totalValue; + _portion := CalculateTotalValue(ndc[i]) / totalValue; childEndAngle := angle +_portion * 2 * pi() * x1; - CalculateTextCoordinates(_portion * x1, y1, _r3, _r4, childStartAngle, childEndAngle, node['children'][i]); + CalculateTextCoordinates(_portion * x1, y1, _r3, _r4, childStartAngle, childEndAngle, ndc[i]); angle := childEndAngle; end; end @@ -1889,12 +1922,16 @@ type tg_tree_node = class(TNode) 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; + ndc := tree['children']; + if ifarray(ndc) and ndc then + begin + for i,v in ndc do + begin + it := new tg_tree_node(v,self,depth+1, i+1) ; + it.parent := self; + AppendNode(it); + //self(true).fChildren := it; + end end X := -1; Y := Depth; @@ -2012,14 +2049,14 @@ begin 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; // ??????????? + 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.lineto(ifo["wick_y",i,0]); // cvs.moveto(lower_wick_start); - cvs.lineto(ifo["wick_y",i,1]); // ?????10??????????????????????????? + cvs.lineto(ifo["wick_y",i,1]); // end else begin cvs.moveto(array(ifo["xy0",i,0],ifo["xy0",i,1])); @@ -2028,7 +2065,7 @@ begin end ifo["barrgn"] := barrgn; end -function paint_boxplot(cvs,pls,xys,cls,ifo); //?????? +function paint_boxplot(cvs,pls,xys,cls,ifo); // begin o := static new tg_const(); b_w_x := integer(ifo["bar_width"][0]/2); @@ -2088,28 +2125,35 @@ 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.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.startpoint(xys[0]); + tree.addpoints(xys); + //tree.addpoints(array(xys[1])); + //tree.addpoints(array(xys[2])); + //tree.addpoints(array(xys[3])); tree.draw(); end - - +function mult_str(s,n); +begin + r := s; + for i := 2 to n do //exp + begin + r+=s; + end + return r; +end +function get_default_color_list(); //获取默认的颜色列表 +begin + //return array(0xc67054, 0x75cc91, 0x58c8fa, 0x6666ee, 0xdec073, 0x72a23b, 0x5284fc, 0xb4609a, 0xcc7cea); + return array(0x00CED1,0xFA8072,0x00BFFF,0xFFFFE0,0xF0FFFF,0xFDF5E6,0xFAF0E6,0xFF8C00,0xC0C0C0,0x008B8B,0xE6E6FA,0xF5DEB3,0xE9967A,0xFF00FF,0x9400D3,0x00FF00,0xDC143C,0xFF4500,0xD8BFD8,0x6B8E23,0x1E90FF,0x708090,0x00FA9A,0xFAEBD7,0xADD8E6,0x8B4513,0xFFFAFA,0x8A2BE2,0x4169E1,0x000080,0xF0FFF0,0x191970,0xF4A460,0xFFDEAD,0x0000CD,0xF5FFFA,0x8B0000,0xFF7F50,0xBA55D3,0x7CFC00,0xFFE4C4,0xDCDCDC,0x87CEEB,0x696969,0x808080,0xFF1493,0x48D1CC,0xFFF0F5,0x00008B,0xDDA0DD,0xFFA07A,0x4682B4,0xFFDAB9,0x6495ED,0xFFC0CB,0x008000,0xADFF2F,0xBDB76B,0x66CDAA,0xEE82EE,0xFFFF00,0x556B2F,0xFFB6C1,0x20B2AA,0xDB7093,0xFFFAF0,0xB22222,0x6A5ACD,0xFF6347,0x778899,0xFAFAD2,0x800080,0x00FFFF,0x006400,0x8FBC8F,0xFFFFFF,0x40E0D0,0xFFD700,0x00FF7F,0xF8F8FF,0xA0522D,0x87CEFA,0xDEB887,0x000000,0x0000FF,0xD2691E,0xFF00FF,0xF5F5F5,0xFFF5EE,0x98FB98,0xFFF8DC,0xF0F8FF,0x800000,0xBC8F8F,0x8B008B,0xD3D3D3,0x9ACD32,0xA9A9A9,0xFF69B4,0xAFEEEE,0xB8860B,0xD2B48C,0xF5F5DC,0x5F9EA0,0x228B22,0x2F4F4F,0xA52A2A,0x7FFFD4,0x90EE90,0x7B68EE,0xB0C4DE,0xF08080,0x32CD32,0x483D8B,0x9370DB,0xCD5C5C,0xDA70D6,0x808000,0x008080,0xFFE4B5,0xC71585,0x9932CC,0xFFEBCD,0xE0FFFF,0x00FFFF,0x4B0082,0xEEE8AA,0xFFE4E1,0xFFEFD5,0xDAA520,0x2E8B57,0xF0E68C,0x7FFF00,0xB0E0E6,0xFFFFF0,0xFFA500,0xFF0000,0xCD853F,0x3CB371,0xFFFACD); +end initialization finalization end. diff --git a/funcext/tvclib/uwindowsinterface.tsf b/funcext/tvclib/uwindowsinterface.tsf index e9fc9a1..d9beb87 100644 --- a/funcext/tvclib/uwindowsinterface.tsf +++ b/funcext/tvclib/uwindowsinterface.tsf @@ -523,6 +523,9 @@ type twindowsapi = class() If the function succeeds, the return value is the handle to a memory DC. If the function fails, the return value is NULL. } + function CreateEnhMetaFileA(hdc:pointer;fn:string;lprc:array of integer;lpdesc:pointer):pointer;stdcall;external "Gdi32.dll" name "CreateEnhMetaFileA"; + function CloseEnhMetaFile(hdc:pointer):pointer;stdcall;external "Gdi32.dll" name "CloseEnhMetaFile"; + function DeleteEnhMetaFile(hdc:pointer):integer;stdcall;external "Gdi32.dll" name "DeleteEnhMetaFile"; function CreateCompatibleDC(hdc :pointer):pointer;stdcall;external "Gdi32.dll" name "CreateCompatibleDC"; { https://msdn.microsoft.com/query/dev14.query?appId=Dev14IDEF1&l=ZH-CN&k=k(WINGDI%2FGetTextColor);k(GetTextColor);k(DevLang-C%2B%2B);k(TargetOS-Windows)&rd=true diff --git a/tsleditor.exe b/tsleditor.exe index 3dfe329..a7a3a70 100644 Binary files a/tsleditor.exe and b/tsleditor.exe differ diff --git a/tslvcltool.exe b/tslvcltool.exe index 42fdb15..e2f01b0 100644 Binary files a/tslvcltool.exe and b/tslvcltool.exe differ