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

更新界面库

This commit is contained in:
liujianjun 2025-01-17 15:52:54 +08:00
parent dc518d066b
commit 1e37d94f22
15 changed files with 750 additions and 94 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
designer/utslvcldcomponents.tsf
View File

@ -84,6 +84,7 @@ type TDComponent = class()
reindex(fdcomponentobjects,array(n:nil));
end
private
Fexcludepropertys;
fisiherted;
finheritedparent;
static fdcomponentobjects;
@ -99,6 +100,23 @@ type TDComponent = class()
FMenus; //菜单
FBitmap;
FImgs;
function setexclude(r);
begin
//if r = Fexcludepropertys then return ;
Fexcludepropertys := array();
if ifarray(r) then
begin
for i,v in r do
begin
Fexcludepropertys[v] := nil;
end
end
end
function excludepro(r);
begin
if ifarray(r) and Fexcludepropertys then reindex(r,Fexcludepropertys);
return r;
end
function SetImgs(id);
begin
FImgs := id;
@ -502,6 +520,7 @@ type TDComponent = class()
{**
@explan(说明) 构造控件的构造函数 %%
**}
Fexludepropertys := array();
fiscontainerdcmp := true;
feventnametable := array();
@ -720,7 +739,7 @@ type TDComponent = class()
{**
@explan(说明)获得所有的属性%%
**}
if FCwnd then return FCwnd.GetPublishProperties();
if FCwnd then return excludepro(FCwnd.GetPublishProperties());
return array();
end
function GetPublishEvents();virtual;
@ -728,7 +747,7 @@ type TDComponent = class()
{**
@explan(说明)获得改变事件回调属性%%
**}
if FCwnd then return FCwnd.GetPublishEvents();
if FCwnd then return excludepro(FCwnd.GetPublishEvents());
end
function DefaultAlign();virtual;
begin
@ -920,6 +939,7 @@ format("
published
property isinherited read fisiherted write fisiherted;//为继承做准备
property inheritedparent read finheritedparent write finheritedparent;
property excludepropertys read Fexcludepropertys write setexclude;
end
type TDRootComponent = class(TDComponent)
{**
@ -1430,7 +1450,7 @@ type TImageListWindow = class(TDVirutalWindow)
inherited;
width := 30;
height := 30;
WindowFileds := array("left","top");
WindowFileds := array("left","top","width","height");
BindComp := new TControlImageList(self);;
end
function bitmapinfo();override;
@ -1471,7 +1491,8 @@ type TDImageList = class(TDRootComponent)
function GetPublishProperties();override;
begin
r := inherited;
return r[ array("name","top","left","images","imgwidth","imgheight")];
r := r[ array("name","top","left","images","imgwidth","imgheight")];
return r;
end
end
@ -1483,6 +1504,7 @@ type TGraphicLabelWindow = class(TDVirutalWindow)
function paint();override;
begin
bd := BindComp;
if not bd then return ;
cvs := canvas;
//if not bd.ParentFont then cvs.Font := bd.Font;
bd.canvas.Handle := cvs.Handle;
@ -2686,6 +2708,7 @@ C6D53F7109130000000049454E44AE42608200";
function Create(AOwner);override;
begin
inherited;
excludepropertys := array("childsizing");
//fiscontainerdcmp := false;
fiscontainerdcmp := true;
DefaultEvent := array(
@ -2746,6 +2769,7 @@ E488B2001B40B7405A5A1A9E8A406C10A0AA0514E5036C00DD0210387EFC3818C
function Create(AOwner);override;
begin
inherited;
excludepropertys := array("childsizing");
fiscontainerdcmp := false;
end
@ -2773,6 +2797,7 @@ type TDListView = class(TDComponent)
function Create(AOwner);override;
begin
inherited;
excludepropertys := array("childsizing");
//fiscontainerdcmp := false;
fiscontainerdcmp := true;
DefaultEvent := array(
@ -2813,6 +2838,7 @@ type TDgridctl = class(TDComponent)
function Create(AOwner);override;
begin
inherited;
excludepropertys := array("childsizing");
//fiscontainerdcmp := false;
fiscontainerdcmp := true;
DefaultEvent := array(
@ -2908,6 +2934,7 @@ B79C4E2791BEA18DE3CDAFF35DC1ABB811A4313F8234790B1E92B200F80266B31
function Create(AOwner);override;
begin
inherited;
excludepropertys := array("childsizing");
end
function IsContainer();override;
begin
@ -2960,6 +2987,7 @@ A5183913CA16C9848495A52E9D4E97F11C21C73721A9904C28B506B19AD21D177
function Create(AOwner);override;
begin
inherited;
excludepropertys := array("childsizing");
fiscontainerdcmp := false;
DefaultEvent := array(
"event":"onchange",
@ -3005,6 +3033,7 @@ BA4550A2FFFB6007C0044475BEF4A7043C50000000049454E44AE42608200";
function Create(AOwner);override;
begin
inherited;
excludepropertys := array("childsizing");
fiscontainerdcmp := false;
end
end
@ -3033,6 +3062,7 @@ BFC6105000000097048597300000EC300000EC301C76FA8640000008849444154
function Create(AOwner);override;
begin
inherited;
excludepropertys := array("childsizing");
fiscontainerdcmp := false;
end
end
@ -3099,6 +3129,7 @@ A42634335A12184DD45698410A1F50D8D0DD5E47F855A066327F40486508A2174
function Create(AOwner);override;
begin
inherited;
excludepropertys := array("childsizing");
fiscontainerdcmp := false;
DefaultEvent := array(
"event":"onselchanged",
@ -3145,6 +3176,7 @@ BCB8280732E6AADD3E00CE841A5BF62EFB2DFFB200463003DE804ADFB76078D5C
function Create(AOwner);override;
begin
inherited;
excludepropertys := array("childsizing");
fiscontainerdcmp := false;
end
end
@ -3188,6 +3220,7 @@ EDF9EF57072C160BF782E4A2E405B610EB5DAEF3F95CBDD15809027E2148CCD78
function Create(AOwner);override;
begin
inherited;
excludepropertys := array("childsizing");
fiscontainerdcmp := false;
end
end
@ -3233,6 +3266,7 @@ DA2D4A7078702C0989D708A6187EC0900CBE88895B1CEB82500F4D91D87929C31
function Create(AOwner);override;
begin
inherited;
excludepropertys := array("childsizing");
fiscontainerdcmp := false;
end
@ -3304,6 +3338,7 @@ type TDListBox=class(TDComponent)
end
function Create(AOwner);override;begin
inherited;
excludepropertys := array("childsizing");
fiscontainerdcmp := false;
DefaultEvent := array(
"event":"onselchanged",
@ -3363,6 +3398,7 @@ type TDColorBox=class(TDComponent)
function Create(AOwner);override;begin
inherited;
excludepropertys := array("childsizing");
fiscontainerdcmp := false;
end
function bitmapinfo();override;begin
@ -3392,6 +3428,7 @@ type TDCalendar=class(TDComponent)
end
function Create(AOwner);override;begin
inherited;
excludepropertys := array("childsizing");
fiscontainerdcmp := false;
end
function GetPublishEvents();override;begin
@ -3428,6 +3465,7 @@ type TDProgressBar=class(TDComponent)
end
function Create(AOwner);override;begin
inherited;
excludepropertys := array("childsizing");
fiscontainerdcmp := false;
end
function bitmapinfo();override;begin
@ -3464,6 +3502,7 @@ type TDCheckBtn=class(TDComponent)
end
function Create(AOwner);override;begin
inherited;
excludepropertys := array("childsizing");
fiscontainerdcmp := false;
DefaultEvent := array(
"event":"onclick",
@ -3540,6 +3579,7 @@ type TDTimePicker=class(TDComponent)
end
function Create(AOwner);override;begin
inherited;
excludepropertys := array("childsizing");
fiscontainerdcmp := false;
end
function bitmapinfo();override;begin
@ -3712,6 +3752,7 @@ type TDPairSplitterSide = class(TDComponent)
function Create(AOwner);override;
begin
inherited;
excludepropertys := array("childsizing");
end
end
type TDPairSplitter = class(TDComponent)
@ -3762,6 +3803,7 @@ BFC6105000000097048597300000EC300000EC301C76FA864000000C849444154
function Create(AOwner);override;
begin
inherited;
excludepropertys := array("autosize");
end
function ComponentCreater(tnode,owner);override;
begin
@ -3826,6 +3868,7 @@ type TDTabSheet = class(TDComponent)
function Create(AOwner);override;
begin
inherited;
excludepropertys := array("autosize");
end
end
type TDPage = class(TDComponent)
@ -3877,6 +3920,7 @@ FCE218FD50E80000000049454E44AE42608200";
function Create(AOwner);override;
begin
inherited;
excludepropertys := array("childsizing");
end
end
type TDtabctl = class(TDComponent)

169
designer/utslvcldpropertytypes.tsf
View File

@ -3,7 +3,7 @@ interface
{**
@explan(说明) 设计器属性编辑库,继承该库,定义属性编辑类 %%
**}
uses utslvclauxiliary,utslvclbase,utslvclgdi,uvcpropertytypespersistence,tslvcl,utslvcldcomponents,UTslSynMemo;
uses utslvclauxiliary,utslvclbase,utslvclgdi,uvcpropertytypespersistence,tslvcl,utslvcldcomponents,UTslSynMemo,utslvclstdctl;
function registereditpropertytodesigner(cls);
type TGCellRender = class(TSLUIBASE) //属性编辑器单元格对象基类
{**
@ -1553,7 +1553,9 @@ type TGridCellNaturalEdit = class(TGridPropertyRender,TPropertyNatural)
FEdit.OnChanged := thisfunction(Ched);
end
FEdit.SetBoundsRect(rec);//FEdit.SetBoundsRect(FGrid.clienttoscreen(rec[0],rec[1]) union FGrid.clienttoscreen(rec[2],rec[3]));
FEdit.text := numbertotext(d["value"]);
nv := numbertotext(d["value"]);
FEdit.text := nv;
flastvalue := nv;
FEdit.parent := grid;
FEdit.SetFocus();
FEdit.visible := true;
@ -1761,6 +1763,52 @@ type TGridCellColorEdit = class(TGridCellEditWithButton,TPropertyColor)
if FColorChoose.visible then FColorChoose.EndModal(0);
end
end
type TGridCellchildsizingEdit = class(TGridCellEditWithButton,TPropertychildsizing)
{**
@explan(说明) childsizing edit
**}
private
Fcpok ;
fszinfo;
public
function create(AOwner);override;
begin
inherited;
FRbuttonWidth := 20;
end
function ButtonClick(grid,e,d);override;
begin
Fcpok := true;
if not(fszinfo) then
begin
fszinfo := new tcszinfo(grid);//TColorChooseADlg(grid);
fszinfo.Parent := grid;
end
fszinfo.setinfo(d["value"]);
rec := GetPopRect(0);
fszinfo.top := rec[1];
fszinfo.left := rec[2]-400;
if fszinfo.showmodal() and Fcpok then
begin
grid.CellChanged(e.iitem,e.isubitem,"value",fszinfo.getinfo());
end
end
function CellDrawLabel(dc,rect,d);override;
begin
{**
@explan(说明) 绘制格子 %%
**}
//dc.brush.color := d["value"];
//dc.fillrect(rect);
dc.DrawText(EditType(),rect,DT_VCENTER);
end
function CellLeave();override;
begin
Fcpok := false;
inherited;
if fszinfo.visible then fszinfo.EndModal(0);
end
end
type TGridCellDirectoryEdit = class(TGridCellEditWithButton,TPropertyDirectory)
{**
@explan(说明) color edit
@ -4547,7 +4595,121 @@ type TListStatusEdit2 = class(TListStatusEdit)
begin
return txt;
end
end
type tcszinfo = class(tcustomcontrol)
function create(aowner);
begin
inherited;
visible := false;
border := true;
color := clMenuBar;
wscaption := true;
WsPopUp := true;
onclose := thisfunction(cancelclk);
Caption := "子控件布局";
fctls := array();
idx := 0;
lbs := array("layout","controlsperline","horizontalspacing","verticalspacing","leftrightspacing","topbottomspacing","");
for i,v in lbs do
begin
lb := new TcustomLabel(self);
lb.Caption := v;
lb.TextAlign := AL9_TOPRIGHT;
if i = 6 then
begin
btn := new tancelok();
btn.fok.onclick := thisfunction(okclk);
btn.fcancel.onclick := thisfunction(cancelclk);
end else
if i = 0 then
begin
btn := new TcustomComboBox(self);
btn.Items := array("none","LeftToRightThenTopToBottom");
btn.ItemIndex := 0;
end else
begin
btn := new tedit(self);
btn.Width := 150;
end
fctls[idx++] := lb;
fctls[idx++] := btn;
end
for i,v in fctls do v.parent := self;
childsizing := array("layout":1,"controlsperline":2,"horizontalspacing":5,"verticalspacing":5,"leftrightspacing":5,"topbottomspacing":5);
autosize := true;
end
function cancelclk();
begin
EndModal(0);
end
function okclk();
begin
EndModal(1);
end
function getinfo();
begin
r := array();
for i,v in array("layout","controlsperline","horizontalspacing","verticalspacing","leftrightspacing","topbottomspacing") do
begin
if i=0 then
begin
r[v] := fctls[1].ItemIndex;
end else
begin
idx := i*2+1;
r[v] := strtointdef(fctls[idx].text,0);
end
end
return r;
end
function setinfo(r);
begin
if ifobj(r) then return setinfo(r.getsizerinfo());
for i,v in array("layout","controlsperline","horizontalspacing","verticalspacing","leftrightspacing","topbottomspacing") do
begin
vi := r[v];
if i=0 then
begin
if vi in array(0,1) then fctls[1].ItemIndex := vi;
end else
begin
if vi>=0 then
begin
idx := i*2+1;
fctls[idx].text := inttostr(vi);
end
end
end
end
fctls;
end
type tancelok = class(tcustomcontrol)
function create(aowner);
begin
inherited;
Parentcolor := true;
fok := new tbtn(self);
fcancel := new tbtn(self);
fok.caption := "确 定";
fcancel.caption := "取 消";
fok.Left := 0;
fok.border := true;
fcancel.border := true;
fok.top := 0;
fcancel.top := 0;
fok.autosize := true;
fcancel.autosize := true;
fok.parent := self;
fcancel.parent := self;
autosize := true;
end
function doControlALign();
begin
r := ClientRect;
fcancel.Left := r[2]-fcancel.Width;
end
fcancel;
fok;
end
type t_colorbox = class(tcustomcontrol)
function create(AOwner);
@ -4754,6 +4916,7 @@ begin
class(TGridCellBoolEdit),
class(TGridCelllazyBoolEdit),
class(TGridCellColorEdit),
class(TGridCellchildsizingEdit),
class(TGridCellDirectoryEdit),
class(TGridCellFileNameEdit),
class(TGridCellNaturalEdit),

BIN
editor-install.exe
View File

Binary file not shown.

276
funcext/tvclib/t_children_sizer.tsf Normal file
View File

@ -0,0 +1,276 @@
type t_children_sizer = class()
{**
@explan(说明) 子控件布局器 %%
@param(layout)(bool) 是否布局 %%
@param(controlsperline)(integer) 每行控件数 %%
@param(horizontalspacing)(integer) 水平间距 %%
@param(verticalspacing)(integer) 垂直间距 %%
@param(leftrightspacing)(integer) 左右间距 %%
@param(topbottomspacing)(integer) 上下间距 %%
**}
//TControlChildrenLayout
//static const cclNone =0;
//static const cclLeftToRightThenTopToBottom = 1; // if BiDiMode <> bdLeftToRight then it becomes RightToLeft
//static const cclTopToBottomThenLeftToRight = 2;
function create(aowner);
begin
fowner := aowner;
fcontrolsperline := 1;
flayout := 0;
fhorizontalspacing := 10;
fverticalspacing := 10;
ftopbottomspacing := 5;
fleftrightspacing := 20;
fautosizing := 0;
end
function AdjustSize(); //调整
begin
if flayout=0 then return ;
if fautosizing then return ;
fautosizing := true;
faownercls := fowner.ClientRect;
dolayoutctls(w,h);
if fowner.autosize then
begin
bds := fowner.BoundsRect;
cls := faownercls;
dw := (bds[2]-bds[0])-(cls[2]-cls[0]);
dh := (bds[3]-bds[1])-(cls[3]-cls[1]);
bds[2] := bds[0]+w+dw;
bds[3] := bds[1]+h+dh;
fowner.BoundsRect := bds;
end
fautosizing := false;
end
function getsizerinfo();
begin
r := array();
r["layout"] := flayout;
r["controlsperline"] := fcontrolsperline;
r["horizontalspacing"] := fhorizontalspacing;
r["verticalspacing"] := fverticalspacing;
r["topbottomspacing"] := ftopbottomspacing;
r["leftrightspacing"] := fleftrightspacing;
return r;
end
function setsizerinfo(v);
begin
if not(ifarray(v) and v) then return ;
flg := false;
for i,vi in v do
begin
case i of
"layout" :
begin
if vi<>flayout and(vi=0 or vi=1) then
begin
flayout := vi;
if vi then flg := true;
end
end
"controlsperline":
begin
if vi<>fcontrolsperline and vi>0 then
begin
fcontrolsperline := vi;
flg := true;
end
end
"horizontalspacing":
begin
if vi<>fhorizontalspacing and vi>0 then
begin
fhorizontalspacing := vi;
flg := true;
end
end
"verticalspacing":
begin
if vi<>fverticalspacing and vi>0 then
begin
fverticalspacing := vi;
flg := true;
end
end
"topbottomspacing":
begin
if vi<>ftopbottomspacing and vi>0 then
begin
ftopbottomspacing := vi;
flg := true;
end
end
"leftrightspacing":
begin
if vi<>fleftrightspacing and vi>0 then
begin
fleftrightspacing := vi;
flg := true;
end
end
end;
end
if flg then
begin
AdjustSize();
end
end
property layout read flayout write setlayout;
property controlsperline read fcontrolsperline write setcontrolsperline;
property horizontalspacing read fhorizontalspacing write sethorizontalspacing;
property verticalspacing read fverticalspacing write setverticalspacing;
property leftrightspacing read fleftrightspacing write setleftrightspacing;
property topbottomspacing read ftopbottomspacing write settopbottomspacing;
property autosizing read fautosizing;
private
function getwndclass();
begin
return class(TWinControl);
end
function dolayoutctls(w,h);
begin
ctls := fowner.Controls;
r := array();
ridx := 0;
cidx := 0;
ccount := 0;
for i :=0 to fowner.ControlCount-1 do
begin
ctl := ctls[i];
if not ctl then continue;
if not ctl.Visible then continue;
if (ctl is getwndclass()) and ctl.WsPopUp then continue;
if cidx>=fcontrolsperline then
begin
ccount := fcontrolsperline;
cidx := 0;
ridx++;
end
ctl.GetPreferredSize(wi,hi);
r[ridx,cidx] := array(ctl,0,0,wi,hi);
cidx++;
end
ccount := max(ccount,cidx);
wsz := zeros(ccount);
hsz := zeros(ridx+1);
for i := 0 to length(r)-1 do
begin
for j := 0 to length(r[i])-1 do
//for j := 0 to ccount-1 do
begin
hsz[i] := max(hsz[i],r[i,j,4]);
wsz[j] := max(wsz[j],r[i,j,3]);
end
end
py := ftopbottomspacing+faownercls[1];
lr := length(r)-1;
for i := 0 to lr do
begin
px := fleftrightspacing+faownercls[0];
for j := 0 to ccount-1 do
begin
vij := r[i,j];
if not vij then continue;
vij[1] := px;
vij[2] := py;
vij[3] := px+wsz[j];
vij[4] := py+hsz[i];
r[i,j] := vij;
px+=wsz[j];
if j<ccount-1 then
px+=fverticalspacing;
end
py+=hsz[i];
if i<lr then py+=horizontalspacing;
w := max(w,px);
end
w +=fleftrightspacing;
py += ftopbottomspacing;
h := py;
for i := 0 to length(r)-1 do
begin
for j := 0 to ccount-1 do
begin
vi := r[i,j];
if not vi then continue;
vi[0].BoundsRect := vi[1:4];
end
end
w-=faownercls[0];
h-=faownercls[1];
return ;
end
function setleftrightspacing(v);
begin
nv := integer(v);
if nv<>fleftrightspacing then
begin
fleftrightspacing := nv;
dolayout();
end
end
function settopbottomspacing(v);
begin
nv := integer(v);
if nv<>ftopbottomspacing then
begin
ftopbottomspacing := nv;
dolayout();
end
end
function sethorizontalspacing(v);
begin
nv := integer(v);
if nv<>fhorizontalspacing then
begin
fhorizontalspacing := nv;
dolayout();
end
end
function setverticalspacing(v);
begin
nv := integer(v);
if nv<>fverticalspacing then
begin
fverticalspacing := nv;
dolayout();
end
end
function setlayout(v);
begin
if v<>flayout and v in array(0,1) then
begin
flayout := v;
if v<>0 then
begin
dolayout();
end
end
end
function setcontrolsperline(v);
begin
nv := integer(v);
if nv>0 and fcontrolsperline<>nv then
begin
fcontrolsperline := nv;
dolayout();
end
end
function dolayout();
begin
AdjustSize();
end
private
[weakref] fowner;
fautosizing;
flayout;
fcontrolsperline;
fhorizontalspacing;
fverticalspacing;
fleftrightspacing;
ftopbottomspacing;
faownercls;
end

39
funcext/tvclib/tcontrol.tsf
View File

@ -184,7 +184,7 @@ type tcontrol = class(tcomponent)
nv := v?true:false;
if nv=fautosize then return ;
fautosize := nv;
if nv then AdjustSize();
if nv and NoRecycled() then AdjustSize();
end
procedure SetAnchors(Value);virtual;
begin
@ -204,8 +204,17 @@ type tcontrol = class(tcomponent)
nv := v?true:false;
if FParentFont <> nv then
begin
ft1 := Font;
if ft1 then ft1 := ft1.fontinfo();
FParentFont := nv;
nft := Font;
ft2 := nft;
if ft2 then ft2 := ft2.fontinfo();
if ft1 and ft2 and (ft1<>ft2) then
begin
r2 := nft.changedkeys((ft2 .<> ft1));
FontChanged();
end
return 1;
end
end
@ -244,7 +253,6 @@ type tcontrol = class(tcomponent)
begin
return FEnabled;
end
procedure SetLeft(Value:Integer); //type_tcontrol
begin
if Value>-5000000 and Value<5000000 and Value <> FLeft then SetBounds(Value,FTop,FWidth,FHeight);
@ -378,6 +386,7 @@ type tcontrol = class(tcomponent)
FFont.copyfont(v);
end
end
function SetBorder(v);virtual;
begin
FBorder := v?true:false;
@ -515,7 +524,7 @@ type tcontrol = class(tcomponent)
{**
@explan(说明) 子控件删除 %%
**}
AdjustSize();
end
function operatectrl(actrl,op); //控件操作通知
begin
@ -530,6 +539,7 @@ type tcontrol = class(tcomponent)
ControlDeleted(actrl);
//if (actrl.Align<>alNone) and (aparent is class(TWincontrol)) then aparent.DoControlAlign();
ifop := true;
if NoRecycled() then AdjustSize();
end
end else
if op=opInsert then
@ -542,6 +552,7 @@ type tcontrol = class(tcomponent)
ft := font;
if ft then fts := ft.fontinfo();
ft := actrl.Font;
nft := ft;
if ft then ftc := ft.fontinfo();
setft := (fts and ftc and (fts <> ftc));
end
@ -551,6 +562,7 @@ type tcontrol = class(tcomponent)
ControlAppended(wkactl);
if setft then
begin
nft.changedkeys((fts .<> ftc));
wkactl.FontChanged();
end
ifop := true;
@ -706,7 +718,12 @@ type tcontrol = class(tcomponent)
//if parent then parent.FontChanged(Sender);
e := new tuieventbase();
CallMessgeFunction(fonfontchanged,self(true),e);
AdjustSize();
ft := Font;
if ft then
begin
ks := ft.changedkeys();
if ks["width"] or ks["height"] then AdjustSize();
end
end
function GetClientRect();virtual; // //type_tcontrol visual size of client area
begin
@ -991,16 +1008,26 @@ type tcontrol = class(tcomponent)
end
function WMMove(o,e):LM_MOVE;virtual;
begin
if not NoRecycled() then return ;
CallMessgeFunction(OnMove,o,e);
if Align=alNone then AdjustSize();
if (o is class(TWinControl)) and o.WsPopUp then return ;
if (Align=alNone) then
begin
p := Parent ;
if p and p.childsizing.layout=1 then return p.AdjustSize();
AdjustSize();
end
end
function DoWMSIZE(o,e);virtual;
begin
end
function WMSize(o,e):LM_SIZE;virtual;
begin
if not NoRecycled() then return ;
CallMessgeFunction(OnSize,o,e);
DoWMSIZE(o,e);
p := Parent ;
if p and p.childsizing.layout=1 then return p.AdjustSize();
AdjustSize();
end
function CMCursorChanged(o,e):CM_CURSORCHANGED;virtual;
@ -1460,6 +1487,8 @@ type tcontrol = class(tcomponent)
return ;
end
fautosizing := true;
sf := self(true);
if (sf is class(TWinControl)) and sf.WsPopUp then return ;
if Parent then
begin
if Parent.autosize then Parent.AdjustSize();

7
funcext/tvclib/tslvcl.tsf
View File

@ -4269,7 +4269,12 @@ type tmonthcalendar = class(TCustomControl)
end
function GetPreferredSize(w,h);override;
begin
if FCalender then FCalender.GetPreferredSize(w,h);
if FCalender then
begin
FCalender.GetPreferredSize(w,h);
w+=1;
h+=1;
end
end
function DoDatechanged();
begin

80
funcext/tvclib/twincontrol.tsf
View File

@ -26,6 +26,7 @@ type TWinControl = class(tcontrol)
//FTtageDrawItem; //已经移除
FWMNCHITTEST;
FImageList;
fchildsizing;
//FTRACKMOUSEEVENT;
FHandle:HWND; //窗口句柄
private //窗口相关
@ -208,6 +209,10 @@ type TWinControl = class(tcontrol)
if HandleAllocated()then RecreateWnd();
end
end
function setchildsizing(v);
begin
fchildsizing.setsizerinfo(v);
end
function GetWsSysMenu();virtual;
begin
return FWsSysMenu;
@ -927,6 +932,23 @@ type TWinControl = class(tcontrol)
end else
_wapi.GetClientRect(self.Handle,ret);
end
{$ifdef linuxgtk}
n := 0;
if WSDlgModalFrame or WSSizebox then
begin
n := 2;
end else
if Border then n := 1;
if n then //´¦ÀígtkµÄÇé¿ö
begin
ret[0]+=n;
ret[1]+=n;
ret[2]-=n;
ret[3]-=n;
if ret[3]<ret[1] then ret[3] := ret[1];
if ret[2]<ret[0] then ret[2] := ret[0];
end
{$endif}
return ret;
end
function GetClientRect();override;
@ -935,7 +957,8 @@ type TWinControl = class(tcontrol)
@explan(说明)获得客户区大小 %%
@return(array of integer) 客户区矩形 %%
**}
return getwndclientrect();
r := getwndclientrect();
return r;
end
#!begin //消息
function DoCNALIGN(o,e);override;
@ -1918,6 +1941,7 @@ type TWinControl = class(tcontrol)
function create(aowner);override; //type_twinctrol
begin
inherited;
fchildsizing := new t_children_sizer(self(true));
//fbordercolor := rgb(190,190,190);
AfterConstruction();
if foncreated then
@ -2564,17 +2588,30 @@ type TWinControl = class(tcontrol)
end;
function AdjustSize();override;
begin
if autosizing then
begin
return ;
end
if not HandleAllocated() then return ;
if IsUpDating() then
begin
return ;
end
cs := childsizing;
if cs and cs.layout=1 then return cs.AdjustSize();
if autosize then
begin
a := Align ;
if a<>alClient then
begin
GetPreferredSize(w,h);
if a=alNone then
begin
b := BoundsRect;
b[2] := b[0]+w;
b[3] := b[1]+h;
a := Align ;
if a=alNone then
BoundsRect := b;
else
end else
if a=alLeft or a=alRight then
begin
width := w;
@ -2584,6 +2621,7 @@ type TWinControl = class(tcontrol)
height := h;
end
end
end
if WsPopUp then return ;
inherited;
end
@ -2604,19 +2642,33 @@ type TWinControl = class(tcontrol)
if not it then continue;
if not it.Visible then continue;
if (it is class(TWinControl)) and it.WsPopUp then continue;
if it.Align=alNone then
ita := it.Align;
if ita=alNone then
begin
ibrc := it.BoundsRect;
w := max(ibrc[2],w);
h := max(ibrc[3],h);
end else
if (it.Align=alLeft or it.alRight )then
if (ita=alLeft or ita=alRight )then
begin
aw+=it.width;
end else
if( it.Align=alTop or it.alBottom )then
if( ita=alTop or ita = alBottom )then
begin
ah+=it.height;
end else
if(ita=alClient) then
begin
try
bs := it.UnAlignBounds;
except
end;
if bs then
begin
ah += bs[3]-bs[1];
aw +=(bs[2]-bs[0]);
end
end
end
w := max(w,aw);
@ -2630,18 +2682,11 @@ type TWinControl = class(tcontrol)
@explan(说明) 控件对齐 %%
**}
if not HandleAllocated()then exit;
cs := childsizing;
if cs and cs.layout=1 then return ;
if not ifarray(rect)then
begin
rect := ClientRect;
{$ifdef linuxgtk}
if Border or WSSizebox or WSDlgModalFrame then //´¦ÀígtkµÄÇé¿ö
begin
rect[0]+=1;
rect[1]+=1;
rect[2]-=1;
rect[3]-=1;
end
{$endif}
end
e := new TMALIGN(CN_ALIGN,0,0,0);
E.left := rect[0];
@ -2665,6 +2710,8 @@ type TWinControl = class(tcontrol)
@explan(说明) 控件锚定调整 %%
**}
if not HandleAllocated()then exit;
cs := childsizing;
if cs and cs.layout=1 then return ;
e := new TMANCHOR(CN_ANCHOR,0,0,0);
c := ClientRect;
for i := 0 to ControlCount-1 do
@ -2802,6 +2849,7 @@ type TWinControl = class(tcontrol)
property oncreated:eventhandler read foncreated write foncreated;
property ActiveControl read getactivecontrol write setactivecontrol;
property Active read factivated;//是否获活动窗口
property childsizing:tchildsizing read fchildsizing write setchildsizing;
private //模态相关
property Modaling read FModaling;
{**

26
funcext/tvclib/ugtkinterface.tsf
View File

@ -1018,7 +1018,7 @@ type tsgtkapi = class(tgtkapis)
if not v0 then continue;
vl := length(v0);
xx := v[2];
yy := v[1];
yy := v[1]-2;
if fillbk then
begin
cairo_move_to(hdc,xx,yy);
@ -1700,7 +1700,7 @@ type tsgtkapi = class(tgtkapis)
ry := (b-t)/2;
cairo_scale(dc,1,ry/rx);
cairo_applay_pen_style(dc);
cairo_move_to(dc,0,0);
cairo_move_to(dc,rx,0);
cairo_arc(dc, 0, 0, rx, 0, 2 * pi());
cairo_set_brush_color(dc);
cairo_fill_preserve(dc);
@ -2036,13 +2036,13 @@ type tsgtkapi = class(tgtkapis)
rx := (r-l)/2;
ry := (b-t)/2;
cairo_scale(dc,1,ry/rx);
cairo_arc(dc, 0, 0, rx, 0, 2 * 3.14);
cairo_move_to(dc,rx,0);
cairo_arc(dc, 0, 0, rx, 0, 2 * 3.1415926);
cairo_stroke_preserve(dc);
cairo_set_source_rgb(dc,1,1,1);
cairo_fill(dc);
cairo_set_line_width(dc,1);
cairo_arc(dc, 0, 0, max(rx-5,3), 0, 2 * 3.14);
cairo_arc(dc, 0, 0, max(rx-5,3), 0, 2 * 3.1415926);
cairo_set_source_rgb(dc,100/255,100/255,100/255);
cairo_fill(dc);
cairo_restore(dc);
@ -2064,8 +2064,8 @@ type tsgtkapi = class(tgtkapis)
rx := (r-l)/2;
ry := (b-t)/2;
cairo_scale(dc,1,ry/rx);
cairo_arc(dc, 0, 0, rx, 0, 2 * 3.14);
cairo_move_to(dc,rx,0);
cairo_arc(dc, 0, 0, rx, 0, 2 * 3.1415926);
cairo_stroke_preserve(dc);
cairo_set_source_rgb(dc,1,1,1);
cairo_fill(dc);
@ -8392,18 +8392,18 @@ type tgtk_ctl_scroll_window = class(tgtk_ctl_object)
begin
_wapi.gtk_object_set_data(cr,"alpha",nil);
_wapi.cairo_set_dash(cr,array(4.0,0.0),2,0);
if (FExdwstyle .& _const.WS_EX_DLGMODALFRAME)= _const.WS_EX_DLGMODALFRAME then
if ((FExdwstyle .& _const.WS_EX_DLGMODALFRAME)= _const.WS_EX_DLGMODALFRAME) or ((FExdwstyle .& _const.WS_SIZEBOX)= _const.WS_SIZEBOX) then
begin
_wapi.cairo_set_source_rgb(cr, 220, 220, 220);
_wapi.cairo_set_line_width (cr, 1.5);
_wapi.cairo_rectangle(cr,0,0,r[2]-1,r[3]-1);
_wapi.cairo_set_source_rgb(cr, 0.8, 0.8, 0.8);
_wapi.cairo_set_line_width (cr, 2);
_wapi.cairo_rectangle(cr,0.5,0.5,r[2]-0.5,r[3]-0.5);
_wapi.cairo_stroke(cr);
end
if (Fdwstyle .& _const.WS_BORDER)= _const.WS_BORDER then
begin
_wapi.cairo_set_source_rgb(cr, 210, 210, 210);
_wapi.cairo_set_source_rgb(cr, 0.1, 0.1, 0.1);
_wapi.cairo_set_line_width(cr, 0.5);
_wapi.cairo_rectangle(cr,1,1,r[2]-1,r[3]-1);
_wapi.cairo_rectangle(cr,0,0,r[2]-0.25,r[3]-0.25);
_wapi.cairo_stroke(cr);
end
CallTslVclProc(_const.WM_NCPAINT,0,cr); //ťćÖĆ

12
funcext/tvclib/utslvclcoolbar.tsf
View File

@ -175,15 +175,21 @@ type tcustomcoolbar=class(tcustomcontrol)
else h := Height;
w := Width;
end
function AdjustSize();override;
begin
inherited;
doControlALign();
end
function doControlALign();override;//µ÷ÕûλÖÃ
begin
if not HandleAllocated() then return ;
//InvalidateRect(nil,false);
mwid := 10;
swid := 10;
y := 0;
rhs := fcoolbands.getrowheights();
bal := Align;
if fdoaligncount<5 and autosize and ( bal =alTop or bal=alBottom) then
{bal := Align;
if fdoaligncount<50 and autosize and ( bal =alTop or bal=alBottom) then
begin
rc := ClientRect;
nh := sum(rhs);
@ -198,7 +204,7 @@ type tcustomcoolbar=class(tcustomcontrol)
fdoaligncount++;
return ;
end
end
end }
fdoaligncount := 0;
fsizelocker := true;
for i,v in fcoolbands.data2 do

27
funcext/tvclib/utslvclgdi.tsf
View File

@ -134,6 +134,7 @@ type Tcustomfont = class(tgdi)
FColor;
FBKColor;
FBkmode;
fchangedkeys;
static LOGSTRUCT;
static LOGSTRUCTarray;
class function sinit();override;
@ -372,6 +373,7 @@ type Tcustomfont = class(tgdi)
end
function create();override;
begin
fchangedkeys := array();
inherited;
fdwfacename := array( "新宋体","宋体","Courier New");
fheight := 15;
@ -404,16 +406,6 @@ type Tcustomfont = class(tgdi)
**}
if not(f is class(Tcustomfont))then exit;
return SetValues(f.fontinfo());
val := array();
for i,v in LOGSTRUCTarray do
begin
v0 := v[0];
fvi := invoke(f,v0);
val[v0]:= fvi;
end
val["color"]:= f.color;
val["bkcolor"]:= f.bkcolor;
return SetValues(val);
end
function SetValues(vs);virtual;
begin
@ -421,6 +413,7 @@ type Tcustomfont = class(tgdi)
@explan(说明) 通过数组设置字体属性 %%
@param(vs)(array)字体信息数据 %%
**}
fchangedkeys := array();
if not ifarray(vs)then exit;
for i,v in LOGSTRUCTarray do
begin
@ -443,6 +436,7 @@ type Tcustomfont = class(tgdi)
if (ovi <> vsv) then
begin
invoke(self,"f"+v0,1,vsv);
fchangedkeys[v0] := true;
cg := true;
end
end
@ -451,6 +445,7 @@ type Tcustomfont = class(tgdi)
if ifnumber(vsc) and (FColor<>vsc) then
begin
cg := true;
fchangedkeys["color"] := true;
SetColor(vsc);
end
if cg then Onchange();
@ -478,6 +473,18 @@ type Tcustomfont = class(tgdi)
property Color read FColor write SetColor;
property bkColor read FBKColor Write SetBkColor;
property bkmode read FBkmode Write SetBkMode;
function changedkeys(ks);
begin
if ifarray(ks) then
begin
fchangedkeys := array();
for i,v in ks do
begin
if v then fchangedkeys[i] := v;
end
end
return fchangedkeys;
end
end
type TFontControl=class(Tcustomfont)
{**

28
funcext/tvclib/utslvclpage.tsf
View File

@ -78,7 +78,8 @@ type tcustomtabcontrol = class(TCustomControl)
FPrevid := FCurrentid;
FCurrentid := id;
InsureIdxVisible(id);
InvalidateRect(nil,false);
//InvalidateRect(nil,false);
//DoControlAlign();
DoControlAlign();
if FOnSelChanged then
begin
@ -124,8 +125,9 @@ type tcustomtabcontrol = class(TCustomControl)
FCurrentid--;
end
FPrevid := -1;
CalcTabs();
InvalidateRect(nil,false);
DoControlAlign();
//CalcTabs();
//InvalidateRect(nil,false);
end
function CreateTableItem(cp);
begin
@ -286,7 +288,7 @@ type tcustomtabcontrol = class(TCustomControl)
if not(v in array(alTop,alBottom,alLeft,alRight)) then exit;
FTabPosition := v;
DoControlAlign();
InvalidateRect(nil,false);
//InvalidateRect(nil,false);
end
function GetTabCount();
begin
@ -395,8 +397,8 @@ type tcustomtabcontrol = class(TCustomControl)
if FScrollBtnRect and FirstViewIndex>0 then
begin
FirstViewIndex-- ;
CalcTabs();
InvalidateRect(nil,false);
DoControlAlign();//CalcTabs();
//InvalidateRect(nil,false);
end
end
function scrollnext(); //¹ö¶¯µ½ÉÏÒ»¸ö
@ -415,8 +417,9 @@ type tcustomtabcontrol = class(TCustomControl)
end
end ;
FirstViewIndex++ ;
CalcTabs();
InvalidateRect(nil,false);
//CalcTabs();
//InvalidateRect(nil,false);
DoControlAlign();
end
end
@ -600,6 +603,7 @@ type tcustomtabcontrol = class(TCustomControl)
function DoControlAlign();override;//µ÷ÕûλÖÃ
begin
CalcTabs();
InvalidateRect(nil,false);
end
function SetTabText(i,Value);
begin
@ -613,7 +617,7 @@ type tcustomtabcontrol = class(TCustomControl)
begin
it.Caption := Value;
DoControlAlign();
InvalidateRect(nil,false);
//InvalidateRect(nil,false);
end
end
function SetTabIndex(AIndex,AIndexnew);
@ -636,8 +640,8 @@ type tcustomtabcontrol = class(TCustomControl)
begin
FCurrentid := AIndex;
end
CalcTabs();
InvalidateRect(nil,false);
DoControlAlign();//CalcTabs();
//InvalidateRect(nil,false);
end
end
function Recycling();override;
@ -688,6 +692,7 @@ type tcustomtabcontrol = class(TCustomControl)
function set_tabs(r);
begin
if not ifarray(r) then return ;
if not NoRecycled() then return ;
rs := array();
for i,v in r do
begin
@ -721,6 +726,7 @@ type tcustomtabcontrol = class(TCustomControl)
end
function settabheight(h);
begin
if not NoRecycled() then return ;
if ownerdraw and ( h>=0) and FTabHeight<>h then
begin
FTabHeight := h;

41
funcext/tvclib/utslvclstdctl.tsf
View File

@ -570,7 +570,7 @@ type tcustombtn = class(TCustomControl) //
inherited;
if bs = caption then return ;
//if autosize then return set_Preferre_size();
AdjustSize();
if NoRecycled() then AdjustSize();
//InvalidateRect(nil,false);
end
function PaintMouseDown();virtual; //°´Ï»æÖÆ
@ -2300,7 +2300,7 @@ type tVirtualCalender=class(TSLUIBASE)
x := 7 * FCellWidth-25;
FIncRect := array(x,2,x+20,22);
FYearRect := array(30,2,30+FCellWidth*3.5-20,FCellHeight);
FMonthRect := array(FYearRect[2]+5,2,x-20,FCellHeight);
FMonthRect := array(FYearRect[2]+5,2,x-5,FCellHeight);
end
if FHasToday then
begin
@ -2561,11 +2561,12 @@ type TcustomLabel = class(TGraphicControl)
begin
inherited;
//if autosize then set_Preferre_size();
AdjustSize();
if NoRecycled() then AdjustSize();
end
end
function AdjustSize();override;
begin
if autosizing then return ;
if autosize then
set_Preferre_size();
inherited;
@ -3117,6 +3118,7 @@ type tthreeEntry=class(TCustomControl)
end
function AdjustSize();override;
begin
if autosizing then return ;
if not HandleAllocated() then return ;
calcCtls();
class(TWinControl).AdjustSize();
@ -5244,7 +5246,7 @@ type TcustomToolBar=class(TCustomControl)
bi := FButtons[i];
ct +=bi.Visible;
end
w := max(ct,1)*imgw;
w := max(ct,1)*(imgw+1);
h := imgh;
w+=dw;
h+=dh;
@ -5555,7 +5557,7 @@ type TcustomToolBar=class(TCustomControl)
FWillModifyToolbar := false;
//DoControlAlign();
//if Parent then Parent.DoControlAlign();
AdjustSize();
if NoRecycled() then AdjustSize();
end
end
inherited;
@ -5718,6 +5720,10 @@ type TcustomToolBar=class(TCustomControl)
begin
if IsUpDating()then return;
if fmainmenu then return ;
if not NoRecycled() then return ;
CalcButtonsRect();
AdjustSize();
return ;
if Parent then
begin
Parent.DoControlAlign();
@ -5734,6 +5740,7 @@ type TcustomToolBar=class(TCustomControl)
begin
fmenubtns.push(new tcustommenubutton( fmainmenu.GetItemByIndex(i),self(true)));
end
if not NoRecycled() then return ;
CalcButtonsRect();
AdjustSize();
end
@ -6524,9 +6531,15 @@ type tcustomgroupbox=class(TCustomControl)
end
//doControlALign();
end
function AdjustSize();override;
begin
if autosizing then return ;
inherited;
doControlALign();
end
function GetClientRect();override;
begin
r := inherited;
r := getwndclientrect();
r[0]+=4;
r[1]+=ftheight+4;
r[2]-=4;
@ -6593,6 +6606,22 @@ type tcustomprogressbar=class(TCustomControl)
FbarColor:=0xD77800;
color:=0xf0f0f0;
end
function GetPreferredSize(w;h);override;
begin
ft := Font;
if ft then
begin
if Fvertical then
begin
h := Height;
w := ft.Height+2;
end else
begin
w := Width;
h := ft.Height+2;
end
end
end
function paint();override;
begin
inherited;

43
funcext/tvclib/uvcpropertytypespersistence.tsf
View File

@ -1104,6 +1104,48 @@ type TPropertyFont=class(TPropertyType) //
return TmfParser.tslasItem(d);
end
end
type TPropertychildsizing=class(TPropertyType) //×ÖÌå
function EditType();override;
begin
return "tchildsizing";
end
function FormatEdit(d,modify);override;
begin
r := inherited;
if ifobj(d)then
begin
try
r["value"]:= d.getsizerinfo();
except
end;
end
return r;
end
function TmfToNode(d);override;
begin
//echo tostn(d);
return d;
end
function LazyProperty();override;
begin
return true;
end
function FormatTMF(d);virtual;
begin
return TmfParser.tslasItem(d);
r += "< \r\n";
for i,v in d do
begin
if v>0 then
begin
r+=i$"="$v
end
end
r += ">\r\n";
return tablelines(r," ");
//
end
end
type TPropertyHotkey=class(TPropertyType) //Èȼü
function EditType();override;
begin
@ -2461,6 +2503,7 @@ begin
"tpropertydirectory",
"tpropertyfilename",
"tpropertyfont",
"tpropertychildsizing",
"tpropertyhotkey",
"tpropertybool",
"tpropertylazybool",

BIN
tsleditor.exe
View File

Binary file not shown.

BIN
tslvcltool.exe
View File

Binary file not shown.