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

更新

This commit is contained in:
liujianjun 2025-02-27 16:28:05 +08:00
parent a0717b7cd3
commit d295888137
17 changed files with 1371 additions and 1169 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
designer/utslcodeeditor.tsf
View File

@ -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,11 +2901,12 @@ 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)"];
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
begin
@ -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

13
designer/utslvcldebuger.tsf
View File

@ -85,8 +85,8 @@ type TFTSLScriptcustomMemo=class(TSYNmemoNorm)
begin
fy :=(FirstLine-TopLine) * LineHeight;
r := ClientRect;
if fy<r[1]then return;
if fy>r[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);
@ -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,8 +1356,9 @@ type TTslDebuga=class(TCustomControl)
while idx<length(ps) do
begin
psi := ps[idx];
if lowercase(psi)="-libpath" then
if lowercase(psi)="-libpath" then //屏蔽此处，让debug和运行的参数保持一致
begin
pdir :=ps[idx+1];
idx += 2;
continue;
end

20
designer/utslvcldesigner.tsf
View File

@ -452,10 +452,10 @@ type TVclDesigner = class(tvcform)
end
function CreateTpjFomFile();//新建工程
begin
FProjectFileOpener.caption := "新建";
if FProjectFileOpener.OpenDlg() then
FProjectFilesave.caption := "н¨";
if FProjectFilesave.OpenDlg() then
begin
f := FProjectFileOpener.FileName;
f := FProjectFilesave.FileName;
if parseregexpr(".tpj$",f,"",pp1,pp2,pp3)<>1 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

BIN
editor-install.exe
View File

Binary file not shown.

1
funcext/tvclib/t_children_sizer.tsf
View File

@ -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);

7
funcext/tvclib/tcontrol.tsf
View File

@ -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);

497
funcext/tvclib/tslvcl.tsf
View File

@ -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;
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]<p2[1]) then //由于缩放问题暂时屏蔽
begin
nrc := ClientToScreen(rc[0],rc[1]-FCalender.height);
end
FCalender.Left := nrc[0];
FCalender.top := nrc[1];
dt := getDate();
FCalender.setCurrentSelection(dt[0],dt[1],dt[2]);
FCalender.show();
end
function getDate();
begin
{**
@explan(说明) 获得日期 %%
@return(array) array(y,m,d) %%
**}
return ExecuteCommand("dtadate");
end
function setDate(y,m,d);
begin
{**
@explan(说明) 获得日期 %%
@param(y)(integer) 年 %%
@param(m)(integer) 月 %%
@param(d)(integer) 日 %%
**}
return ExecuteCommand("dtadate",array(y,m,d));
end
function recycling();override;
begin
inherited;
FCalender := nil;
Fonselectchange := nil;
end
published
property onselectchange:eventhandler read Fonselectchange write Fonselectchange;
property onselchanged:eventhandler read Fonselectchange write Fonselectchange;
{
@param(onselchanged)(function[tdatetimepicker,tuieventbase])选择日期改变%%
}
private
function getenumber(e);
begin
t := e.text;
ti := strtointdef(t,1);
return ti;
end
//FScreenRect;
FCalender;
[weakref]Fonselectchange;
end
type ttimepicker = 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
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
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;
@ -4876,7 +4417,6 @@ type TIcon = class(tcustomicon)
begin
inherited;
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)
{**
@ -6055,16 +5587,12 @@ type TTipMessageButton = class(TcustomTipMessageButton)
inherited;
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.

65
funcext/tvclib/twincontrol.tsf
View File

@ -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;
@ -2683,14 +2735,13 @@ type TWinControl = class(tcontrol)
ah += bs[3]-bs[1];
aw +=(bs[2]-bs[0]);
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)
**}

4
funcext/tvclib/utslmemo.tsf
View File

@ -1645,8 +1645,8 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
fy :=(FirstLine-FTopLine)* fTextHeight;
ly :=(LastLine-FTopLine+1)* fTextHeight;
r := ClientRect;
if ly<r[1]then return;
if fy>r[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);

49
funcext/tvclib/utslvclgdi.tsf
View File

@ -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
{**

24
funcext/tvclib/utslvclpage.tsf
View File

@ -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;

721
funcext/tvclib/utslvclstdctl.tsf
View File

@ -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
@ -3090,8 +2992,8 @@ type tthreeEntry=class(TCustomControl)
FEntrys[i].fnext := FEntrys[(i+1)mod 3];
FEntrys[(i+1)mod 3].Fprev := FEntrys[i];
end
calcCtls();
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
end
function AdjustSize();override;
begin
if csLoading in ComponentState then return ;
if autosizing then return ;
if not HandleAllocated() 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;
@ -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
@ -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]<p2[1]) then //由于缩放问题暂时屏蔽
begin
nrc := ClientToScreen(rc[0],rc[1]-FCalender.height);
end
FCalender.Left := nrc[0];
FCalender.top := nrc[1];
dt := getDate();
FCalender.setCurrentSelection(dt[0],dt[1],dt[2]);
FCalender.show();
end
function getDate();
begin
{**
@explan(说明) 获得日期 %%
@return(array) array(y,m,d) %%
**}
return ExecuteCommand("dtadate");
end
function setDate(y,m,d);
begin
{**
@explan(说明) 获得日期 %%
@param(y)(integer) 年 %%
@param(m)(integer) 月 %%
@param(d)(integer) 日 %%
**}
return ExecuteCommand("dtadate",array(y,m,d));
end
function recycling();override;
begin
inherited;
FCalender := nil;
Fonselectchange := nil;
end
published
property onselectchange:eventhandler read Fonselectchange write Fonselectchange;
property onselchanged:eventhandler read Fonselectchange write Fonselectchange;
{
@param(onselchanged)(function[tdatetimepicker,tuieventbase])选择日期改变%%
}
private
function getenumber(e);
begin
t := e.text;
ti := strtointdef(t,1);
return ti;
end
//FScreenRect;
FCalender;
[weakref]Fonselectchange;
end
type tcustommonthcalendar = class(TCustomControl)
{**
@explan(说明)月历控件
该控件的函数可能的返回值：
array等期望的数据/1：成功。
-1：一般是函数参数格式不正确。
nil：该项属性在控件种类正确、窗口未创建、无默认值的情况下未设置过或被重置过。
0：失败，可能的原因：
1.参数格式正确但不适用于控件的当前状态，如对多选月历设置当前选择项时项数超过其最大多选项数限制。
2.控件类型错误，如对单选月历调用设置其最大多选项数限制的函数。
3.要求控件创建后才可调用的函数在控件创建之前被调用。
4.未知错误。
**}
function create(aowner);
begin
inherited;
//TodayButton := false;
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[tcustommonthcalendar,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
implementation
type TtoolbuttonActionLink=class(TControlActionLink)
{**
@ -7720,6 +8090,103 @@ type TTipWnd=class(TCustomControl) //tip
private
FSize;
end
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
type tedoitem = class
function create(r,s,e,t);
begin

625
funcext/tvclib/utvclgraphics.tsf
View File

@ -61,17 +61,17 @@ uses utslvclauxiliary;
title 标题 tg_label 类型
y_label y轴标签 tg_label 类型
x_label x轴标签 tg_label 类型
axises(idx) 0,1,2 分别获取对应的x，y轴 ，tg_axis 类型
axes_reverse(idx) 坐标轴是否反向，默认正向
auto_ticks(idx) 设置坐标轴刻度自动计算
axises(idx) 0,1,2 分别获取对应的x，y,z轴 ，tg_axis 类型
axes_reverse(idx) := tgc_on|tgc_off 坐标轴是否反向，默认正向
auto_ticks(idx) := tgc_on|tgc_off 设置坐标轴刻度自动计算
margins 空白，array(左上右下)，设置上下左右空白，tg_figure区域的百分比
axes_bounds(idx) 坐标系的大小 array((x,width),(y,heigt))，以margins为基准点，安百分比
data_bounds(idx) 获取或者设置数据范围 array((x0,x1),(y0,y1),(z0,z1))
zoom_box(idx) 设置显示的数据的区域 array((x0,x1),(y0,y1),(z0,z1))
axes_bounds := array(左，上，右，下) 坐标系的范围；扣除margins边界，按比例
data_bounds(idx) 获取或者设置数据范围 array((x0,x1),(y0,y1),(z0,z1)) ,设置之后 对应轴的数据显示范围不会随着数据改变改变，如果要改变 data_bounds(idx) :=tgc_off
x_location 坐标轴方向，tgc_bottom tgc_top,tgc_middle ,tgc_origin
y_location 坐标轴方向，tgc_left tgc_right,tgc_middle ,tgc_origin
box 是否有边框
grid(idx) 背景网格线属性 tg_line_info 对象，size为0的时候网格线消失
box = tgc_on | tgc_off 是否有边框
grid(idx) 背景网格线属性, tg_line_info 对象，size为0的时候网格线消失
squred :=tgc_on|tgc_off 长宽等比例，适合于饼图等
tg_axis 坐标轴，可以在坐标系中放置任意多个坐标轴
tics_direction 坐标轴方向 tgc_direct_asc(坐标轴指向的左手方向) , tgc_direct_desc
@ -218,7 +218,7 @@ type tfm = class(tvcform)
fg.Align := alClient;
//////////设置坐标轴属性////////////////////////
axs := new tg_axes();
axs.figure := fg.figure;
axs.figure := fg;
axs.title.text := "你好 plot ";
axs.title.fontinfo.size := 15;
axs.title.fontinfo.color := 0xff0000;
@ -236,8 +236,8 @@ type tfm = class(tvcform)
line.markinfo.color := 0x0000ff;
line.mark_mode := "on";
line.markinfo.size := 30;
line.markinfo.style := "pentagram";
line.polyline_style := "staircase";
line.markinfo.style := line.tgc_mks_pentagram;
line.polyline_style := line.tgc_LS_staircase;
d := array();
idx := 0;
for i:= -pi() to pi() step 0.2 do
@ -280,7 +280,7 @@ type tfm = class(tvcform)
axs.axises(1).lineinfo.color := 0x00ff00;
sf := new tg_my_surf();
sf.lineinfo.color := 0x0000ff;
sf.lineinfo.style := tgc_BS_SOLID;
sf.lineinfo.style := sf.tgc_BS_SOLID;
sf.graph_data := get_surf_data();
sf.parent := axs;
return ;
@ -608,6 +608,33 @@ type tg_picture = class(tcustommemcanvas,tg_figure_container) //
ffigure.paint_pre(self);
end
end
{
type tg_metafile = class(tcustommetacanvas,tg_figure_container) //绘图对象
uses utslvclgdi;
function create(fn,w,h);
begin
class(tcustommetacanvas).create(fn,w,h);
class(tg_figure_container).create();
frect := array(0,0,w,h);
ffigure.rec_getter := function()begin
return frect;
end
end
function save_wmf(fn);
begin
paint();
//savepng(fn);
end
private
frect;
function paint(); //绘制
begin
brush.color := 0xffffff;
FillRect(frect);
ffigure.paint_pre(self);
end
end }
//tcustommetacanvas
type tg_WinControl = class(tcustomcontrol,tg_figure_container) //绘图窗口
function create(AOwner);
begin
@ -751,7 +778,7 @@ type tg_figure = class(tg_evet_conainter) //
function paint_pre(cvs); //绘制
begin
Fpainting := true;
cvs := new tg_canvas(cvs.Handle);
cvs := new tg_canvas(cvs.Handle,self);
for i,v in faxeses.data do
begin
v.paint_pre(cvs);
@ -833,12 +860,12 @@ type tg_figure = class(tg_evet_conainter) //
fwilldelaxs := axs;
axs.figure := nil;
end
function fresh(); ///////////////////////////
function fresh(); ///刷新////////////////////////
begin
if Fpainting then return ;
if ffresh_caller then call(ffresh_caller);
end
function rect(); //////////////////////////////////
function rect(); ///获取区域///////////////////////////////
begin
r := array(0,0,200,200);
if frect_getter then r := call(frect_getter);
@ -1162,23 +1189,6 @@ type tg_axes = class(tg_base) //
end
cvs.axesunclip();
end
{function paint(cvs);override;
begin
paint_grid(cvs);
inherited;
cvs.axesunclip();
for i,v in faxes_objects do //绘制坐标
begin
v.paint(cvs);
end
modify_label_postion();
ftitle.paint(cvs);
if fbox = tgc_on then
begin
set_lineinfo_to_canvas(cvs);
paint_box(cvs);
end
end }
function axes_changed();//改变
begin
if not fFigure then return ;
@ -1188,11 +1198,18 @@ type tg_axes = class(tg_base) //
fr := fFigure.rect();
w := fr[2]-fr[0];
h := fr[3]-fr[1];
p_left := fr[0]+w*fmargins[0]+faxes_bounds[0];
p_top := fr[1]+h*fmargins[1]+faxes_bounds[1];
p_width := w*(1-fmargins[0]-fmargins[2])*faxes_bounds[2];
p_height := h*(1-fmargins[1]-fmargins[3])*faxes_bounds[3];
wa := w*(1-fmargins[0]-fmargins[2]);
ha := h*(1-fmargins[1]-fmargins[3]);
p_left := fr[0]+w*fmargins[0]+wa*faxes_bounds[0];
p_top := fr[1]+h*fmargins[1]+wa*faxes_bounds[1];
p_width := wa*(faxes_bounds[2]-faxes_bounds[0]);
p_height := ha*(faxes_bounds[3]-faxes_bounds[1]);
if fsqured=tgc_on then
begin
ts := min(p_width,p_height);
p_width := ts;
p_height := ts;
end
fcvs_bounds := array(p_left,p_top,p_left+p_width,p_top+p_height);
if (f_changed .& c_g_data_changed)=c_g_data_changed then
begin
@ -1267,6 +1284,7 @@ type tg_axes = class(tg_base) //
function create(pms);
begin
f_changed := 0;
fsqured := tgc_off;
inherited;
ftheta := 0;
falpha := 0;
@ -1308,7 +1326,6 @@ type tg_axes = class(tg_base) //
gd.Style := tgc_PS_DOT;
fgrid[i] := gd;
end
faxes_reverse := array(tgc_off,tgc_off,tgc_off);
fbox := tgc_off;
ffilled := tgc_off;
@ -1380,15 +1397,13 @@ type tg_axes = class(tg_base) //
property sub_ticks read gs_sub_ticks write gs_sub_ticks;
//上下左右空白
property margins read gs_margins write gs_margins; //空白区域
property axes_bounds read gs_axes_bounds write gs_axes_bounds; //坐标轴边界
property axes_bounds read faxes_bounds write set_axes_bounds; //坐标轴边界
property squred read fsqured write set_squred; //绘制区域是否采用等长宽，默认
property data_bounds read gs_data_bounds write gs_data_bounds; //数据边界
property zoom_box read gs_zoom_box write gs_zoom_box; //视图范围
//在窗口中的区域
//网格线
property grid read get_grid;
//grid ;//= [-1,-1]
//grid_position ;//= "background"
//grid_thickness ;//= [1,1]
@ -1445,6 +1460,7 @@ type tg_axes = class(tg_base) //
faxes_objects;
fzoom_box;
fmargins;
fsqured;
faxes_bounds ;//= [0,0,1,1]
fdata_bounds;
fdata_bounds_locked;
@ -1468,8 +1484,6 @@ type tg_axes = class(tg_base) //
if xg.width>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 v<fzoom_box[0,0] or v>fzoom_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
faxes_bounds[idx] := array(v[0],v[1]);
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 := v;
f_changed .|=c_g_paint_rect ;
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
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;
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;
@ -2352,15 +2381,21 @@ type tg_canvas = class(TcustomCanvas) //
begin
Handle := 0;
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;
@ -3050,9 +3098,9 @@ type tg_text = class(tg_base)
x := 0;
y := 0;
end
set_lineinfo_to_canvas(cvs);
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,210 +4137,176 @@ 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
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);
"style","color":
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
return ifnumber(v);
end
"bkcolor":
begin
if fbkcolor<>v and (ifnumber(v) or ifnil(v)) then //设置颜色
begin
fbkcolor := v;
if fonwer then fonwer.invalidate();
return ifnumber(v) or ifnil(v);
end
end
end;
return false;
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;
case idx of
"size":
begin
return ifnumber(v) and v>5;
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();
return ifnumber(v);
end
"color":
begin
return ifnumber(v) or (v=tgc_complementary_color);
end
"bkcolor":
begin
return ifnumber(v) or ifnil(v);
end
end
return false;
end
end
type tg_mark_info = class(tg_gdi) //标记信息
function create(awner);
begin
inherited;
fpdata := array("style":tgc_mks_dot,"size":0,"size_unit":tgc_mk_point,"color":0,"bkcolor":0xffffff);
end
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
case idx of
"size_unit":
begin
return (tgc_mk_tabulated=v or tgc_mk_point=v);
end
"size":
begin
if fsize<>v and ifnumber(v) and (v>5) then
begin
fsize := v;
if fonwer then fonwer.invalidate();
return ifnumber(v) and v>=0;
end
end
"color":
begin
if fforeground<>v and ifnumber(v) then
begin
fforeground := v;
if fonwer then fonwer.invalidate();
end
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
end
type tg_mark_info = class(tg_const) //标记信息
function create(awner);
begin
fstyle := tgc_mks_dot;
fsize := 0;
fsize_unit := tgc_mk_point;
fforeground := 0;
fbackground := 0xffffff;
fonwer := awner;
end
function clone();
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":
begin
if FStyle<>v and ifnumber(v) then
begin
FStyle := v;
if fonwer then fonwer.invalidate();
end
end
"size":
begin
if fsize<>v and ifnumber(v) then
begin
fsize := v;
if fonwer then fonwer.invalidate();
end
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();
return ifnumber(v) or ifnil(v);
end
end
end;
return false;
end
end
type tg_evet_conainter = class(tg_const) //带消息的绘图基类
@ -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
@ -4621,19 +4634,21 @@ type tg_const = class()
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_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
@ -5434,6 +5452,11 @@ begin
end ;
return nidx;
end
///////////////////////////////////////
function calc_complementary_color(c);//补色计算
begin
return rgb((255-GetRValue(c)),(255-GetgValue(c)),(255-GetbValue(c)));
end
////////////////////////////////////////
initialization
finalization

404
funcext/tvclib/utvclgraphicsext.tsf
View File

@ -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);
h := fontinfo.size*2+6;// + ((h-fontinfo.size)/2);
y0 := rec[1]+h;
for i,v in fgraph_data do
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;
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;
total := 0;
total_value_list := array();
for i,v in fgraph_data do
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];
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;
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
@ -1842,27 +1866,36 @@ type tg_Polysunburst = class(tg_graph) //
angle := startAngle;
_r3 := r1 + (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;
ftext_container[length(ftext_container)] := gtx;
end
if ifarray(node['children']) 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
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,13 +1922,17 @@ type tg_tree_node = class(TNode)
begin
class(TNode).create();
fName := tree['name'];
for i,v in tree['children'] do
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;
Thread := nil;
@ -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.

3
funcext/tvclib/uwindowsinterface.tsf
View File

@ -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

BIN
tsleditor.exe
View File

Binary file not shown.

BIN
tslvcltool.exe
View File

Binary file not shown.