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

11
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,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

17
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);
@ -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 idx<length(ps) do
begin
psi := ps[idx];
if lowercase(psi)="-libpath" then
if lowercase(psi)="-libpath" then //屏蔽此处，让debug和运行的参数保持一致
begin
idx += 2;
pdir :=ps[idx+1];
idx += 2;
continue;
end
pms += " "+tostn(psi);

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.

3
funcext/tvclib/t_children_sizer.tsf
View File

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

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

505
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;
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]<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
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.

69
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;
@ -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)
**}

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

26
funcext/tvclib/utslvclpage.tsf
View File

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

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

663
funcext/tvclib/utvclgraphics.tsf
View File

File diff suppressed because it is too large Load Diff

426
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);
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.

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.