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

更新界面库

This commit is contained in:
liujianjun 2025-01-10 11:31:34 +08:00
parent 0177f8d9c9
commit dc518d066b
18 changed files with 1039 additions and 404 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
designer/udesignerproject.tsf
View File

@ -197,6 +197,7 @@ end
end end
type TProjectView = class(TVCForm) //工程文件浏览 type TProjectView = class(TVCForm) //工程文件浏览
private private
fseltimer;
FAddtoolbtn; FAddtoolbtn;
FTreePopUpMenu; FTreePopUpMenu;
//**************目录树筛选功能*********************************** //**************目录树筛选功能***********************************
@ -229,7 +230,8 @@ type TProjectView = class(TVCForm) //
public public
function FilterKillFocus(o,e); function FilterKillFocus(o,e);
begin begin
if FFilterList.visible then FFilterList.visible := false; fseltimer.timeout(thisfunction(seltimerdo),500);
//if FFilterList.visible then FFilterList.visible := false;
end end
function FilterChanged(o,e); function FilterChanged(o,e);
begin begin
@ -251,21 +253,38 @@ type TProjectView = class(TVCForm) //
end end
FFilterList.visible := false; FFilterList.visible := false;
end end
function FilterKeyDown(o,e); function filterselect();
begin
cc := e.CharCode;
if cc=13 then
begin begin
if FFilterList.visible then if FFilterList.visible then
begin begin
FFilterList.visible := false; FFilterList.visible := false;
o.text := ""; FFilter.text := "";
idx := FFilterList.getCurrentSelection(); idx := FFilterList.getCurrentSelection();
if idx >= 0 then if idx >= 0 then
begin begin
FTree.SetSel(FFilterNodes[idx]); FTree.SetSel(FFilterNodes[idx]);
end end
end end
end
function Filterclksel();
begin
if FFilterList.visible then
begin
FFilterList.visible := false;
FFilter.text := "";
idx := FFilterList.getCurrentSelection();
if idx >= 0 then
begin
FTree.SetSel(FFilterNodes[idx]);
end
end
end
function FilterKeyDown(o,e);
begin
cc := e.CharCode;
if cc=13 then
begin
filterselect();
end else end else
if cc =VK_DOWN then if cc =VK_DOWN then
begin begin
@ -300,11 +319,17 @@ type TProjectView = class(TVCForm) //
end end
else e.skip := true; else e.skip := true;
end end
function seltimerdo(o,e);
begin
if FFilterList.visible then FFilterList.visible := false;
end
//**************目录树筛选功能*********************************** //**************目录树筛选功能***********************************
//////////////////构造函数////////////////////////////// //////////////////构造函数//////////////////////////////
function Create(AOwner);override; function Create(AOwner);override;
begin begin
inherited; inherited;
fseltimer := new TTimer(self);
//
minmaxbox := false; minmaxbox := false;
FDesigner := AOwner; FDesigner := AOwner;
//visible := false; //visible := false;
@ -397,6 +422,7 @@ type TProjectView = class(TVCForm) //
FFilter.OnChange := thisfunction(FilterChanged); FFilter.OnChange := thisfunction(FilterChanged);
FFilter.onSetFocus := thisfunction(FilterChanged); FFilter.onSetFocus := thisfunction(FilterChanged);
FFilter.onKillFocus := thisfunction(FilterKillFocus); FFilter.onKillFocus := thisfunction(FilterKillFocus);
FFilterList.onmouseup := thisfunction(Filterclksel);
//************************************************************ //************************************************************
FTree := new TFileTree(self); FTree := new TFileTree(self);
FTree.Align := alClient; FTree.Align := alClient;

4
designer/utslcodeeditor.tsf
View File

@ -499,7 +499,9 @@ type TPage=class(TCustomControl) //
FLines := 1; FLines := 1;
if not FPageitems then return ; if not FPageitems then return ;
li := 0; li := 0;
cw := Font.Width; ft := font;
if ft then cw := ft.Width;
else cw := 10;
r := class(TCustomControl).ClientRect; r := class(TCustomControl).ClientRect;
x := 0; x := 0;
xct := 0; xct := 0;

47
designer/utslvcldcomponents.tsf
View File

@ -1494,6 +1494,15 @@ type TGraphicLabelWindow = class(TDVirutalWindow)
//al := BindComp.TextAlign; //al := BindComp.TextAlign;
//BindComp.CanvasDrawAlignText(self.canvas,self.ClientRect,self.caption,al); //BindComp.CanvasDrawAlignText(self.canvas,self.ClientRect,self.caption,al);
end end
function GetPreferredSize(w,h);override;
begin
bd :=BindComp;
if not bd then return ;
c := bd.Caption;
ft := Font;
w := length(c)*ft.width+2;
h := ft.height+2;
end
function SetPublish(n,v,pp);override; function SetPublish(n,v,pp);override;
begin begin
r := inherited; r := inherited;
@ -1508,7 +1517,7 @@ type TGraphicLabelWindow = class(TDVirutalWindow)
BindComp := new tlabel(self); BindComp := new tlabel(self);
width := BindComp.width; width := BindComp.width;
height := BindComp.Height; height := BindComp.Height;
WindowFileds := array("left","top","width","height","color","parentcolor","font","parentfont","border","visible","align","anchors"); WindowFileds := array("left","top","width","height","autosize","color","parentcolor","font","parentfont","border","visible","align","anchors");
end end
function DesigningSizer();override; function DesigningSizer();override;
begin begin
@ -1527,6 +1536,10 @@ type TGraphicbevelWindow = class(TDVirutalWindow)
bd.canvas.Handle := canvas.Handle; bd.canvas.Handle := canvas.Handle;
bd.paint(); bd.paint();
end end
function FontChanged(o);override;
begin
if autosize then AdjustSize();
end
function SetPublish(n,v,pp);override; function SetPublish(n,v,pp);override;
begin begin
r := inherited; r := inherited;
@ -3866,6 +3879,36 @@ FCE218FD50E80000000049454E44AE42608200";
inherited; inherited;
end end
end end
type TDtabctl = class(TDComponent)
function HitTip();override;
begin
return inherited;
end
function bitmapinfo();override;
begin
return "900200000000000000020000000200000001000000900100003C0000000000000
004000000040000000400000008000000030000000B0000004901000074797065
64617461696D6789504E470D0A1A0A0000000D494844520000003000000030080
60000005702F987000000017352474200AECE1CE90000000467414D410000B18F
0BFC6105000000097048597300000EC300000EC301C76FA864000000DE4944415
46843ED974B0A84301005E782AE3D8A37F602FEF193C1452443C274DA9179ADBC
82DA3D2585A0F872378701681880E639015555B9A22854EED7A039025207CC114
D14904B187195679EA8A9805D2D3F07D475FD55ED4ECBF302B66DCBD2EF538709
D5EEB44401EBBA66E9F7A9C3846A775AA2806559B2F47B84E1DB2A0A98E739CBB
22C3F6EFA6F3D51C0344DA61503C67134AD18300C8369C580BEEF4D2B06745D67
5A31A06D5BD38A014DD398560CB88B9E23E0CC1F19CAE497F8AE30000D03D0300
00D03D030000D03D030000D03D030000D03D030008B736F04D94E768181B63200
00000049454E44AE426082";
end
function WndClass();override;
begin
return Class(ttabcontrol);
end
function Create(AOwner);override;
begin
inherited;
end
end
function registercomponenttodesigner(cls); function registercomponenttodesigner(cls);
begin begin
{** {**
@ -3881,7 +3924,7 @@ begin
class(TDForm),class(TDPanelForm), class(TDForm),class(TDPanelForm),
class(TDPanel),class(TDGroupBox), class(TDPanel),class(TDGroupBox),
class(TDPairSplitter),class(TDPairSplitterSide), class(TDPairSplitter),class(TDPairSplitterSide),
class(TDPage),class(TDTabSheet), class(TDPage),class(TDTabSheet),class(TDtabctl),
class(TDTimer), class(TDTimer),
class(tdworkerctl), class(tdworkerctl),
class(TDImageList), class(TDImageList),

29
designer/utslvcldpropertytypes.tsf
View File

@ -1960,10 +1960,7 @@ type TGridCellhotkeyEdit = class(TGridPropertyRender,TPropertyHotkey)
end; end;
end end
type TGridCellBoolEdit = class(TGridPropertyRender,TPropertyBool) type tgridCellBoolbaseEdit = class(TGridPropertyRender)
{**
@explan(綱츠) boolcell긍서
**}
private private
FRbuttonWidth; FRbuttonWidth;
function DrawButton(dc,srca,v); function DrawButton(dc,srca,v);
@ -1992,7 +1989,8 @@ type TGridCellBoolEdit = class(TGridPropertyRender,TPropertyBool)
rec := grid.getSubItemRect(i,j); rec := grid.getSubItemRect(i,j);
if pt[0]<(rec[2]-FRbuttonWidth) then exit; if pt[0]<(rec[2]-FRbuttonWidth) then exit;
if d["class"]="bool" then dc := d["class"];
if dc="bool" or dc="lazybool" then
begin begin
grid.CellChanged(i,j,"value",not(d["value"])); grid.CellChanged(i,j,"value",not(d["value"]));
end end
@ -2013,8 +2011,24 @@ type TGridCellBoolEdit = class(TGridPropertyRender,TPropertyBool)
end end
DrawButton(dc,src,dv); DrawButton(dc,src,dv);
end end
end
type TGridCellBoolEdit = class(tgridCellBoolbaseEdit,TPropertyBool)
{**
@explan(˵Ã÷) boolcell±à¼­
**}
function create(AOwner);override;
begin
inherited;
end
end
type TGridCelllazyBoolEdit = class(tgridCellBoolbaseEdit,TPropertylazyBool)
{**
@explan(˵Ã÷) lazybool cell±à¼­
**}
function create(AOwner);override;
begin
inherited;
end
end end
@ -4738,6 +4752,7 @@ function staticinit();
begin begin
psi := (array( psi := (array(
class(TGridCellBoolEdit), class(TGridCellBoolEdit),
class(TGridCelllazyBoolEdit),
class(TGridCellColorEdit), class(TGridCellColorEdit),
class(TGridCellDirectoryEdit), class(TGridCellDirectoryEdit),
class(TGridCellFileNameEdit), class(TGridCellFileNameEdit),

BIN
editor-install.exe
View File

Binary file not shown.

3
funcext/tvclib/setprocessdpiawareness.tsf
View File

@ -4,7 +4,10 @@ begin
@explan(˵Ã÷)ÉèÖÃdpi¸ÐÖª,Ä¿Ç°½öÖ§³Öwindows @explan(˵Ã÷)ÉèÖÃdpi¸ÐÖª,Ä¿Ç°½öÖ§³Öwindows
@param(v) 0,1,2 @param(v) 0,1,2
**} **}
try //避免win7及一下版本错误
SetProcessDpiAwareness_sub(v); SetProcessDpiAwareness_sub(v);
except
end;
end end
{$ifdef linux} {$ifdef linux}
function SetProcessDpiAwareness_sub(v); function SetProcessDpiAwareness_sub(v);

97
funcext/tvclib/tcontrol.tsf
View File

@ -21,6 +21,7 @@ type tcontrol = class(tcomponent)
FAnchors; FAnchors;
fautosize; fautosize;
fautosizing;
FAnchorBounds; FAnchorBounds;
FCaption;//标题 FCaption;//标题
FCaptureMouseButtons;//鼠标样式 FCaptureMouseButtons;//鼠标样式
@ -507,13 +508,14 @@ type tcontrol = class(tcomponent)
{** {**
@explan(说明) 子控件添加 %% @explan(说明) 子控件添加 %%
**} **}
if AControl and AControl.ParentFont then AControl.FontChanged(); //if AControl and AControl.ParentFont then AControl.FontChanged();
end end
function ControlDeleted(AControl);virtual;//子控件被删除 function ControlDeleted(AControl);virtual;//子控件被删除
begin begin
{** {**
@explan(说明) 子控件删除 %% @explan(说明) 子控件删除 %%
**} **}
AdjustSize();
end end
function operatectrl(actrl,op); //控件操作通知 function operatectrl(actrl,op); //控件操作通知
begin begin
@ -534,10 +536,23 @@ type tcontrol = class(tcomponent)
begin begin
if idx=-1 then if idx=-1 then
begin begin
setft := false;
if actrl.ParentFont then
begin
ft := font;
if ft then fts := ft.fontinfo();
ft := actrl.Font;
if ft then ftc := ft.fontinfo();
setft := (fts and ftc and (fts <> ftc));
end
wkactl := makeweakref(actrl); wkactl := makeweakref(actrl);
FControls.append(wkactl); FControls.append(wkactl);
actrl.FParent := self(true); actrl.FParent := self(true);
ControlAppended(wkactl); ControlAppended(wkactl);
if setft then
begin
wkactl.FontChanged();
end
ifop := true; ifop := true;
end end
end end
@ -585,12 +600,12 @@ type tcontrol = class(tcomponent)
d := new tvclwindowpos_class(0); d := new tvclwindowpos_class(0);
if SizeChanged then if SizeChanged then
begin begin
d.cx := AWidth; d.cx := AWidth;
d.cy := AHeight; d.cy := AHeight;
D.flags := SWP_NOMOVE; D.flags := SWP_NOMOVE;
e := new tuieventbase(WM_WINDOWPOSCHANGED,0,d._getptr_); e := new tuieventbase(WM_WINDOWPOSCHANGED,0,d._getptr_);
//e := new tuieventbase(WM_SIZE,0,makeposition(AWidth,AHeight)); class(tcontrol).wndproc(e);
e := new tuieventbase(WM_SIZE,0,makeposition(AWidth,AHeight));
class(tcontrol).wndproc(e); class(tcontrol).wndproc(e);
end end
if PosChanged then if PosChanged then
@ -599,7 +614,8 @@ type tcontrol = class(tcomponent)
d.y := ATop; d.y := ATop;
d.flags := SWP_NOSIZE; d.flags := SWP_NOSIZE;
e := new tuieventbase(WM_WINDOWPOSCHANGED,0,d._getptr_); e := new tuieventbase(WM_WINDOWPOSCHANGED,0,d._getptr_);
//e := new tuieventbase(WM_MOVE,6,makeposition( ALeft,ATop)); class(tcontrol).wndproc(e);
e := new tuieventbase(WM_MOVE,6,makeposition( ALeft,ATop));
class(tcontrol).wndproc(e); class(tcontrol).wndproc(e);
end end
{if SizeChanged or PosChanged then {if SizeChanged or PosChanged then
@ -690,6 +706,7 @@ type tcontrol = class(tcomponent)
//if parent then parent.FontChanged(Sender); //if parent then parent.FontChanged(Sender);
e := new tuieventbase(); e := new tuieventbase();
CallMessgeFunction(fonfontchanged,self(true),e); CallMessgeFunction(fonfontchanged,self(true),e);
AdjustSize();
end end
function GetClientRect();virtual; // //type_tcontrol visual size of client area function GetClientRect();virtual; // //type_tcontrol visual size of client area
begin begin
@ -852,6 +869,12 @@ type tcontrol = class(tcomponent)
end ; end ;
exit; exit;
end end
if autosize then
begin
GetPreferredSize(w,h);
bds:= array(0,0,w,h);
end
else
bds := UnAlignBounds; bds := UnAlignBounds;
case Align of case Align of
alTop: alTop:
@ -969,6 +992,7 @@ type tcontrol = class(tcomponent)
function WMMove(o,e):LM_MOVE;virtual; function WMMove(o,e):LM_MOVE;virtual;
begin begin
CallMessgeFunction(OnMove,o,e); CallMessgeFunction(OnMove,o,e);
if Align=alNone then AdjustSize();
end end
function DoWMSIZE(o,e);virtual; function DoWMSIZE(o,e);virtual;
begin begin
@ -977,6 +1001,7 @@ type tcontrol = class(tcomponent)
begin begin
CallMessgeFunction(OnSize,o,e); CallMessgeFunction(OnSize,o,e);
DoWMSIZE(o,e); DoWMSIZE(o,e);
AdjustSize();
end end
function CMCursorChanged(o,e):CM_CURSORCHANGED;virtual; function CMCursorChanged(o,e):CM_CURSORCHANGED;virtual;
begin begin
@ -1228,9 +1253,17 @@ type tcontrol = class(tcomponent)
nt := 100000; nt := 100000;
if ifarray(rect)and rect[0]<nt and rect[1]<nt and rect[2]<nt and rect[3]<nt then return SetBounds(rect[0],rect[1],max(rect[2]-rect[0],0),max(0,rect[3]-rect[1])); if ifarray(rect)and rect[0]<nt and rect[1]<nt and rect[2]<nt and rect[3]<nt then return SetBounds(rect[0],rect[1],max(rect[2]-rect[0],0),max(0,rect[3]-rect[1]));
end end
procedure SetBounds(aLeft,aTop,aWidth,aHeight:integer);virtual; //type_tcontrol procedure SetBounds(aLeft,aTop,aWidth_,aHeight_:integer);virtual; //type_tcontrol
begin begin
nt := 100000; nt := 100000;
aWidth := aWidth_;
aHeight := aHeight_;
//if Align=alNone and fautosize then //´¦Àí×Ô¶¯¸Ä±ä
// begin
// GetPreferredSize(w,h);
// aWidth := w;
// aHeight := h;
//end
if aLeft<nt and aTop<nt and aWidth<nt and aHeight<nt and aWidth>0 and aHeight>0 then if aLeft<nt and aTop<nt and aWidth<nt and aHeight<nt and aWidth>0 and aHeight>0 then
begin begin
ChangeBounds(integer(ALeft),integer(ATop),integer(AWidth),integer(AHeight),false); ChangeBounds(integer(ALeft),integer(ATop),integer(AWidth),integer(AHeight),false);
@ -1333,7 +1366,7 @@ type tcontrol = class(tcomponent)
rchange .|=8; rchange .|=8;
end end
end end
if rchange then if rchange and (csDesigning in ComponentState) then
begin begin
obj := class(tUIglobalData).uigetdata("tuiapplication"); obj := class(tUIglobalData).uigetdata("tuiapplication");
if obj then if obj then
@ -1419,23 +1452,53 @@ type tcontrol = class(tcomponent)
end end
property ActionLink read FActionLink; //write FActionLink; property ActionLink read FActionLink; //write FActionLink;
public public
procedure AdjustSize;virtual; // smart calling DoAutoSize procedure AdjustSize();virtual; // smart calling DoAutoSize
begin begin
includestate(FControlFlags,cfAutoSizeNeeded); //includestate(FControlFlags,cfAutoSizeNeeded);
if fautosizing then
begin
return ;
end
fautosizing := true;
if Parent then if Parent then
begin begin
Parent.AdjustSize(); // if Parent.autosize then Parent.AdjustSize();
else if Align<>alNone then Parent.DoControlAlign();
end end
fautosizing := false;
//excludestate(FControlFlags,cfAutoSizeNeeded);
end end
function AutoSizeDelayed();virtual; function GetPreferredSize(w,h);virtual;
begin begin
ft := Font;
end if ft then
function AutoSizeDelayedHandle();virtual;
begin begin
return not(Parent); c := caption;
w := ft.Width*(max(2,length(c)))+2;
h := ft.Height+2;
end
end end
protected protected
function set_Preferre_size();
begin
rec := BoundsRect;
GetPreferredSize(w,h);
rec[2] := rec[0]+w;
rec[3] := rec[1]+h;
a := Align;
if a=alNone then
begin
BoundsRect := rec;
end else
if a=alLeft or a=alRight then
begin
Width := w;
end else
if a=alTop or a=alBottom then
begin
Height := h;
end else Width := w;
end
property UnAlignBounds read GetUnAlignBounds write SetUnAlignBounds; property UnAlignBounds read GetUnAlignBounds write SetUnAlignBounds;
{** {**
@param(Action)(taction) action对象 %% @param(Action)(taction) action对象 %%
@ -1446,9 +1509,10 @@ type tcontrol = class(tcomponent)
published published
// standard properties, which should be supported by all descendants // standard properties, which should be supported by all descendants
property Action:taction read GetAction write SetAction; property Action:taction read GetAction write SetAction;
property Anchors read FAnchors write SetAnchors; //anchors ÔÝʱÆÁ±Îanchors property Anchors:anchors read FAnchors write SetAnchors; //anchors ÔÝʱÆÁ±Îanchors
property Align:align read FAlign write SetAlign; property Align:align read FAlign write SetAlign;
property autosize read fautosize write setautosize; property autosize:lazybool read fautosize write setautosize;
property autosizing read fautosizing;
property ParentFont:bool read FParentFont write SetParentFont; property ParentFont:bool read FParentFont write SetParentFont;
property Parentcolor:bool read FParentcolor write SetParentcolor; property Parentcolor:bool read FParentcolor write SetParentcolor;
property Caption:string read GetText write SetText ; property Caption:string read GetText write SetText ;
@ -1510,6 +1574,7 @@ type tcontrol = class(tcomponent)
property BoundsRect read GetBoundsRect write SetBoundsRect; property BoundsRect read GetBoundsRect write SetBoundsRect;
property Zorder read GetZorder write SetZorder; property Zorder read GetZorder write SetZorder;
property ControlState: TControlState read FControlState write FControlState; property ControlState: TControlState read FControlState write FControlState;
property ControlFlags read fControlFlags ;
property Color:color read getcolor write SetColor;//FColor; property Color:color read getcolor write SetColor;//FColor;
property BKBitmap:tbitmap read FBKBitmap write SetBitmap; property BKBitmap:tbitmap read FBKBitmap write SetBitmap;
//property OnMouseEnter:eventhandler read FOnMouseEnter write FOnMouseEnter; //property OnMouseEnter:eventhandler read FOnMouseEnter write FOnMouseEnter;

1
funcext/tvclib/tcustomcontrol.tsf
View File

@ -41,6 +41,7 @@ type tcustomcontrol=class(TWinControl)
begin begin
fhassplitter--; fhassplitter--;
end end
inherited;
end end
public public
function Create(AOwner:TComponent);override; function Create(AOwner:TComponent);override;

14
funcext/tvclib/tslvcl.tsf
View File

@ -2786,6 +2786,15 @@ type tpagecontrol = class(tcustompagecontrol)
inherited; inherited;
end end
end end
type ttabcontrol = class(tcustomtabcontrol)
{**
@explan(说明)tab控件 %%
**}
function create(AOwner);
begin
inherited;
end
end
//¶þ·Ö¿Ø¼þ //¶þ·Ö¿Ø¼þ
type TPairSplitterSide=class(TCustomControl) type TPairSplitterSide=class(TCustomControl)
{** {**
@ -4258,6 +4267,10 @@ type tmonthcalendar = class(TCustomControl)
end end
end end
end end
function GetPreferredSize(w,h);override;
begin
if FCalender then FCalender.GetPreferredSize(w,h);
end
function DoDatechanged(); function DoDatechanged();
begin begin
if FonSelectChange then if FonSelectChange then
@ -4306,6 +4319,7 @@ type tdatetimepicker = class(tthreeEntry)
inherited; inherited;
caption:="Date/TimePicker"; caption:="Date/TimePicker";
FCalender := new tmonthcalendar(self); FCalender := new tmonthcalendar(self);
FCalender.autosize := true;
FCalender.border := true; FCalender.border := true;
FCalender.WsPopUp := true; FCalender.WsPopUp := true;
FCalender.parent := self; FCalender.parent := self;

69
funcext/tvclib/twincontrol.tsf
View File

@ -849,7 +849,6 @@ type TWinControl = class(tcontrol)
//InvalidateRect(nil,false); //InvalidateRect(nil,false);
//it.Perform(new tuieventbase(CM_PARENTFONTCHANGED,hd,1,0)); //it.Perform(new tuieventbase(CM_PARENTFONTCHANGED,hd,1,0));
end end
end end
function CMPARENTFONTCHANGED(o,e):CM_PARENTFONTCHANGED;virtual; function CMPARENTFONTCHANGED(o,e):CM_PARENTFONTCHANGED;virtual;
begin begin
@ -2352,7 +2351,7 @@ type TWinControl = class(tcontrol)
if FClientHeight <> y then if FClientHeight <> y then
begin begin
FClientHeight := y; FClientHeight := y;
//cc := true; cc := true;
end end
if true then if true then
begin begin
@ -2563,6 +2562,68 @@ type TWinControl = class(tcontrol)
end end
inherited; inherited;
end; end;
function AdjustSize();override;
begin
if not HandleAllocated() then return ;
if autosize then
begin
GetPreferredSize(w,h);
b := BoundsRect;
b[2] := b[0]+w;
b[3] := b[1]+h;
a := Align ;
if a=alNone then
BoundsRect := b;
else
if a=alLeft or a=alRight then
begin
width := w;
end else
if a=alTop or a=alBottom then
begin
height := h;
end
end
if WsPopUp then return ;
inherited;
end
function GetPreferredSize(w,h);override;
begin
brec := BoundsRect;
crec := ClientRect;
dw := (brec[2]-brec[0])-(crec[2]-crec[0]);
dh := (brec[3]-brec[1])-(crec[3]-crec[1]);
cts := Controls;
w := 0;
h := 0;
aw := 0;
ah := 0;
for i := 0 to ControlCount-1 do
begin
it := cts[i];
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
begin
ibrc := it.BoundsRect;
w := max(ibrc[2],w);
h := max(ibrc[3],h);
end else
if (it.Align=alLeft or it.alRight )then
begin
aw+=it.width;
end else
if( it.Align=alTop or it.alBottom )then
begin
ah+=it.height;
end
end
w := max(w,aw);
h := max(h,ah);
w+=dw;
h+=dh;
end
procedure DoControlAlign({rect});override; procedure DoControlAlign({rect});override;
begin begin
{** {**
@ -2709,8 +2770,8 @@ type TWinControl = class(tcontrol)
end end
published //¶ÔÍâproperty published //¶ÔÍâproperty
/////////////////////////////////////////////// ///////////////////////////////////////////////
property MinWidth:natural read FMinWidth write SetMinWidth; property MinWidth read FMinWidth write SetMinWidth; //:natural
property MinHeight:natural read FMinHeigt write SetMinHeight; property MinHeight read FMinHeigt write SetMinHeight; //:natural
//property MaxWidth:integer read FMaxWidth write SetMaxWidth; //property MaxWidth:integer read FMaxWidth write SetMaxWidth;
//property MaxHeight:integer read FMaXHeight write SetMaxHeight; //property MaxHeight:integer read FMaXHeight write SetMaxHeight;
property BorderStyle read GetBorderStyle write SetBorderStyle; property BorderStyle read GetBorderStyle write SetBorderStyle;

4
funcext/tvclib/ugtkinterface.tsf
View File

@ -540,9 +540,9 @@ type tsgtkapi = class(tgtkapis)
PosChanged := flg .& 2; PosChanged := flg .& 2;
if SizeChanged then if SizeChanged then
begin begin
vb := g_object_get_data(h,"gtk_window_vscroll_bar"); {vb := g_object_get_data(h,"gtk_window_vscroll_bar");
hb := g_object_get_data(h,"gtk_window_hscroll_bar"); hb := g_object_get_data(h,"gtk_window_hscroll_bar");
{if vb and gtk_widget_is_visible(vb) then if vb and gtk_widget_is_visible(vb) then
begin begin
d.cx := max(AWidth-10,0); d.cx := max(AWidth-10,0);
end end

36
funcext/tvclib/utslvclcoolbar.tsf
View File

@ -12,10 +12,8 @@ type tcustomcoolbar=class(tcustomcontrol)
begin begin
fcoolbands := new tcoolbarlines(); fcoolbands := new tcoolbarlines();
fbtnwidth := 20; fbtnwidth := 20;
fautosize := true;
fdoaligncount :=0; fdoaligncount :=0;
inherited; inherited;
end end
function AfterConstruction();override; function AfterConstruction();override;
begin begin
@ -42,6 +40,7 @@ type tcustomcoolbar=class(tcustomcontrol)
end end
function Notification(o,op);override; function Notification(o,op);override;
begin begin
return inherited;
if fsizelocker then return ; if fsizelocker then return ;
if (o is class(TWinControl)) and o.WsPopUp then return ; if (o is class(TWinControl)) and o.WsPopUp then return ;
if HandleAllocated() and ifarray(op) and (op["type"]="possize") then //位置大小发送变化 if HandleAllocated() and ifarray(op) and (op["type"]="possize") then //位置大小发送变化
@ -169,6 +168,13 @@ type tcustomcoolbar=class(tcustomcontrol)
end end
inherited; inherited;
end end
function GetPreferredSize(w,h);override;
begin
if fcoolbands then
h := sum( fcoolbands.getrowheights());
else h := Height;
w := Width;
end
function doControlALign();override;//调整位置 function doControlALign();override;//调整位置
begin begin
if not HandleAllocated() then return ; if not HandleAllocated() then return ;
@ -206,21 +212,21 @@ type tcustomcoolbar=class(tcustomcontrol)
if ctl.Visible and not((ctl is class(TWinControl)) and ctl.WsPopUp) then if ctl.Visible and not((ctl is class(TWinControl)) and ctl.WsPopUp) then
begin begin
bss[length(bss)]:= bsi; bss[length(bss)]:= bsi;
drc := array(x,y,x+mwid,y+rhs[i]); drc := array(x,y+1,x+mwid,y+rhs[i]-2);
bsi.fdragrect := drc; bsi.fdragrect := drc;
bsi.fbtnrect := drc; bsi.fbtnrect := drc;
h := ctl.Height; h := ctl.Height;
w := ctl.Width; w := ctl.Width;
x += mwid; x += mwid;
bsi.fctlrect := array(x,y,w,h); bsi.fctlrect := array(x,y+1,w,h);
dy := 0; dy := 0;
if (rhs[i]-h)>2 then if (rhs[i]-h)>2 then
begin begin
dy := integer((rhs[i]-h)/2); dy := integer((rhs[i]-h)/2);
end end
ctl.SetBounds(x,y+dy,w,h); ctl.SetBounds(x,y+dy+1,w,h);
x+=w; x+=w;
bsi.fsizerect := array(x,y,x+swid,y+rhs[i]); bsi.fsizerect := array(x,y+1,x+swid,y+rhs[i]-2);
//x+=swid; //x+=swid;
end else end else
begin begin
@ -280,12 +286,10 @@ type tcustomcoolbar=class(tcustomcontrol)
FDRageimglist := nil; FDRageimglist := nil;
end end
published published
property autosize:bool read fautosize write setautosize;
property arrange:lazystr read getarrange write setarrange; property arrange:lazystr read getarrange write setarrange;
property dragbtncolor:color read fdragbtncolor write fdragbtncolor; property dragbtncolor:color read fdragbtncolor write fdragbtncolor;
private private
fdoaligncount; fdoaligncount;
fautosize ;
fdragbtncolor; fdragbtncolor;
fsizelocker; fsizelocker;
function paintbtn(rc1); function paintbtn(rc1);
@ -388,18 +392,6 @@ type tcustomcoolbar=class(tcustomcontrol)
doControlALign(); doControlALign();
end end
end end
function setautosize(v);//×Ô¶¯µ÷Õû
begin
nv := v?true:false;
if nv<>fautosize then
begin
fautosize := v;
if nv then
begin
doControlALign();
end
end
end
function EnabledChild(f); function EnabledChild(f);
begin begin
fcoolbands.EnabledChild(f); fcoolbands.EnabledChild(f);
@ -592,11 +584,11 @@ type tcoolbarlines = class() //
h := max(h,vj["height"]); h := max(h,vj["height"]);
end end
end end
r[i] := h;// max(20,h); r[i] := h+2;// max(20,h);
end end
if (csDesigning in ComponentState) and (length(r)=1 and r[0]<2) then if (csDesigning in ComponentState) and (length(r)=1 and r[0]<2) then
begin begin
r[0] := 25; r[0] := max(25,r[0]);
end end
return r; return r;
end end

33
funcext/tvclib/utslvclgdi.tsf
View File

@ -496,7 +496,7 @@ type TFontControl=class(Tcustomfont)
function Onchange();override; function Onchange();override;
begin begin
inherited; inherited;
if FControl and not(FControl.ParentFont) then if FControl and not(FControl.parent and FControl.ParentFont) then
begin begin
FControl.FontChanged(); FControl.FontChanged();
end end
@ -1851,6 +1851,33 @@ type TCustomImageList=class(tcomponent)
FAutoDestroy := true; FAutoDestroy := true;
end end
end end
function getsize();
begin
return array(FWidth,FHeight);
end
function setsize(sz);
begin
if not(ifarray(sz) ) then return ;
w := sz[0];
h := sz[1];
if w>0 and w<>FWidth then
begin
flg := true;
FWidth := w;
end
if h>0 and h<>FHeight then
begin
flg := true;
FHeight := h;
end
if flg then
begin
FChanged := true;
DestroyHandle();
addbmps();
change();
end
end
function SetWidth(w); function SetWidth(w);
begin begin
if w>0 and w <> FWidth then if w>0 and w <> FWidth then
@ -1859,7 +1886,6 @@ type TCustomImageList=class(tcomponent)
FChanged := true; FChanged := true;
DestroyHandle(); DestroyHandle();
addbmps(); addbmps();
//if inDesigning()then
change(); change();
end end
end end
@ -1871,9 +1897,7 @@ type TCustomImageList=class(tcomponent)
FChanged := true; FChanged := true;
DestroyHandle(); DestroyHandle();
addbmps(); addbmps();
//if inDesigning()then
change(); change();
//if not inDesigning() then DestroyHandle();
end end
end end
function HandleNeeded(); function HandleNeeded();
@ -2118,6 +2142,7 @@ type TCustomImageList=class(tcomponent)
property ImageCount read FimageCount; property ImageCount read FimageCount;
property Height read FHeight write Setheight; property Height read FHeight write Setheight;
property Width read FWidth write SetWidth; property Width read FWidth write SetWidth;
property imgsize read getsize write setsize;
property imgHeight:integer read FHeight write Setheight; property imgHeight:integer read FHeight write Setheight;
property imgWidth:integer read FWidth write SetWidth; property imgWidth:integer read FWidth write SetWidth;
property OnChange read FOnChange write FOnChange; property OnChange read FOnChange write FOnChange;

610
funcext/tvclib/utslvclpage.tsf
View File

@ -19,6 +19,10 @@ type tcustomtabsheet = class(TCustomControl) //
end end
end end
public public
function AdjustSize();override;
begin
class(tcontrol).AdjustSize();
end
function paint();override; //设计器模式下绘制网格 function paint();override; //设计器模式下绘制网格
begin begin
drawdesigninggrid(); drawdesigninggrid();
@ -39,13 +43,12 @@ type tcustomtabsheet = class(TCustomControl) //
Visible := false; Visible := false;
end end
end end
type tcustompagecontrol = class(TCustomControl) type tcustomtabcontrol = class(TCustomControl)
private private
fclocker;//锁 fclocker;//锁
FirstViewIndex; //第一个展示的序号 FirstViewIndex; //第一个展示的序号
FCurrentid; //当前 FCurrentid; //当前
FPrevid; //上一个 FPrevid; //上一个
FTabItems; //
[weakref]FOnSelChanged; [weakref]FOnSelChanged;
[weakref]FOnSelChanging; //正在改变 [weakref]FOnSelChanging; //正在改变
//FOnrclick; //FOnrclick;
@ -57,42 +60,72 @@ type tcustompagecontrol = class(TCustomControl)
fnextrect; fnextrect;
FTabRects; FTabRects;
FClientarea; FClientarea;
private protected
function gettabsheetitem(idx); FTabItems; //
function setselidx(id); //选择序号
begin begin
if idx>=0 and idx<ftabitems.length() then return FTabItems[idx]; if FCurrentid= id then return ;
if isacceptsheettype(idx) then if fclocker.locked then return ;
lk := new tcountlocker(fclocker);
if id>=0 and id<FTabItems.length() then
begin begin
for i:= 0 to ftabitems.length()-1 do if FCurrentid<>-1 and fOnSelChanging then
begin begin
it := FTabItems[i]; e := new tuieventbase(0,FCurrentid,id,0); //m,w,l,h
if idx=it.PageSheet then return it; doonSelChanging(self(true),e);
if e.skip then return ;
end end
end FPrevid := FCurrentid;
end FCurrentid := id;
function gettabesheet(idx); InsureIdxVisible(id);
begin
if idx>=0 and idx<ftabitems.length() then
begin
return FTabItems[idx].PageSheet;
end
end
function getactivetabsheet();
begin
id := FCurrentid;
if id>=0 then return FTabItems[id].PageSheet;
end
function SetTabPosition(v);
begin
if FTabPosition=v then exit;
if not(v in array(alTop,alBottom,alLeft,alRight)) then exit;
FTabPosition := v;
DoControlAlign();
InvalidateRect(nil,false); InvalidateRect(nil,false);
end DoControlAlign();
function GetTabCount(); if FOnSelChanged then
begin begin
return FTabItems.length(); doonSelChange(self(true),new tuieventbase(0,FPrevid,FCurrentid,0));
end
end else
if FTabItems.length()=0 then
begin
FPrevid := -1;
FCurrentid := -1;
end
end
function RemovePageTab(id);//移除sheet
begin
if not(id>=0) then return ;
FTabItems.splice(id,1);
if id = FCurrentid then
begin
if id = 0 then
begin
if FTabItems.length()=0 then
begin
FCurrentid := -1;
FPrevid := -1;
end
end
FCurrentid := -1;
FPrevid := -1;
cid := min(max(0,id-1),FTabItems.length()-1);
if cid >=0 then
begin
return setselidx(cid);
end else
begin
if FOnSelChanged then
begin
doonSelChange(self(true),new tuieventbase(0,-1,-1,0));
end
end
end else
if id<FCurrentid then
begin
FCurrentid--;
end
FPrevid := -1;
CalcTabs();
InvalidateRect(nil,false);
end end
function CreateTableItem(cp); function CreateTableItem(cp);
begin begin
@ -102,9 +135,10 @@ type tcustompagecontrol = class(TCustomControl)
end end
function CalcTabs(); //计算区域 function CalcTabs(); //计算区域
begin begin
rec := ClientRect; //区域 rec := getwndclientrect() ;//ClientRect; //区域
fclosebtnrect := array(); fclosebtnrect := array();
ft := font; ft := font;
if not ft then return ;
fw := ft.width; fw := ft.width;
if not fownerdraw then if not fownerdraw then
begin begin
@ -125,15 +159,6 @@ type tcustompagecontrol = class(TCustomControl)
if e.lparam>=0 then FTabItemswidth[i] := e.lparam; if e.lparam>=0 then FTabItemswidth[i] := e.lparam;
end end
end end
FMaxsize := 0;
{if FTabPosition in array(alLeft,alRight) then
begin
FTabItemswidth := zeros(length(FTabItemswidth))+maxvalue(FTabItemswidth);
FMaxsize := length(FTabItemswidth)*FTabHeight;
end else
begin
FMaxsize := sum(FTabItemswidth);
end }
FMaxsize := sum(FTabItemswidth); FMaxsize := sum(FTabItemswidth);
FClientarea := rec; FClientarea := rec;
FScrollBtnRect := 0; FScrollBtnRect := 0;
@ -250,6 +275,23 @@ type tcustompagecontrol = class(TCustomControl)
end end
end end
end end
private
function gettabsheetitem(idx); virtual;
begin
if idx>=0 and idx<ftabitems.length() then return FTabItems[idx];
end
function SetTabPosition(v);
begin
if FTabPosition=v then exit;
if not(v in array(alTop,alBottom,alLeft,alRight)) then exit;
FTabPosition := v;
DoControlAlign();
InvalidateRect(nil,false);
end
function GetTabCount();
begin
return FTabItems.length();
end
function InsureIdxVisible(id); //确保可见 function InsureIdxVisible(id); //确保可见
begin begin
if FScrollBtnRect and (not FTabRects[id]) then if FScrollBtnRect and (not FTabRects[id]) then
@ -273,35 +315,7 @@ type tcustompagecontrol = class(TCustomControl)
end end
end end
end end
function setselidx(id); //选择序号
begin
if FCurrentid= id then return ;
if fclocker.locked then return ;
lk := new tcountlocker(fclocker);
if id>=0 and id<FTabItems.length() then
begin
if FCurrentid<>-1 and fOnSelChanging then
begin
e := new tuieventbase(0,FCurrentid,id,0); //m,w,l,h
doonSelChanging(self(true),e);
if e.skip then return ;
end
FPrevid := FCurrentid;
FCurrentid := id;
InsureIdxVisible(id);
InvalidateRect(nil,false);
DoControlAlign();
if FOnSelChanged then
begin
doonSelChange(self(true),new tuieventbase(0,FPrevid,FCurrentid,0));
end
end else
if FTabItems.length()=0 then
begin
FPrevid := -1;
FCurrentid := -1;
end
end
function PaintTabs();//绘制tab function PaintTabs();//绘制tab
begin begin
lk := new tcountlocker(fclocker); lk := new tcountlocker(fclocker);
@ -405,75 +419,46 @@ type tcustompagecontrol = class(TCustomControl)
InvalidateRect(nil,false); InvalidateRect(nil,false);
end end
end end
function RemovePageTab(id);//移除sheet
begin
if not(id>=0) then return ;
FTabItems.splice(id,1);
if id = FCurrentid then
begin
if id = 0 then
begin
if FTabItems.length()=0 then
begin
FCurrentid := -1;
FPrevid := -1;
end
end
FCurrentid := -1;
FPrevid := -1;
cid := min(max(0,id-1),FTabItems.length()-1);
if cid >=0 then
begin
return setselidx(cid);
end else
begin
if FOnSelChanged then
begin
doonSelChange(self(true),new tuieventbase(0,-1,-1,0));
end
end
end else
if id<FCurrentid then
begin
FCurrentid--;
end
FPrevid := -1;
CalcTabs();
InvalidateRect(nil,false);
end
function addtabitem(page);//添加sheet
begin
//if not(page is class(tcustomtabsheet)) then return -1;
for i := 0 to FTabItems.length()-1 do
begin
if FTabItems[i].PageSheet = page then return -1;
end
if page then
cp := page.Caption;
it := CreateTableItem(cp);
FTabItems.Push(it);
if FTabItems.length()>1 then
begin
if page then
begin
page.visible := false;
end
end
it.PageSheet := Page;
if FCurrentid=-1 then
begin
setselidx(0);
end else
begin
if not (page is class(TWinControl)) then CalcTabs();
InvalidateRect(nil,false);
end
end
public public
function FontChanged(o);override; function FontChanged(o);override;
begin begin
inherited;
DoControlAlign(); DoControlAlign();
inherited;
end
function GetClientRect();override;
begin
return getsheetrect();
end
function GetPreferredSize(w,h);override;
begin
ft := font;
if not ft then return ;
if not ownerdraw then
begin
FTabHeight := ft.height+7;
end
case FTabPosition of
alLeft,alRight:
begin
w := FTabHeight;
h := height;
end
alTop,alBottom:
begin
h := FTabHeight;
w := width;
end
alNone:
begin
h := FTabHeight;
w := width;
end else
begin
h := height;
w := width;
end
end
end end
function hittabat(xy); //命中 function hittabat(xy); //命中
begin begin
@ -499,12 +484,6 @@ type tcustompagecontrol = class(TCustomControl)
end end
return r; return r;
end end
function checknewchild(achild);override;//检查child
begin
r := inherited;
if isacceptsheettype( achild) then achild.Align := alNone;
return r;
end
function getsheetrect(); //获得sheet function getsheetrect(); //获得sheet
begin begin
{** {**
@ -521,10 +500,9 @@ type tcustompagecontrol = class(TCustomControl)
function create(aowner); function create(aowner);
begin begin
inherited; inherited;
FTabPosition := alTop;
fclosebtn := false; fclosebtn := false;
FTabHeight := font.height+7; FTabHeight := font.height+8;
faccepttype := array();
acceptsheettype(class(tcustomtabsheet));
end end
function AfterConstruction();override; function AfterConstruction();override;
begin begin
@ -535,30 +513,13 @@ type tcustompagecontrol = class(TCustomControl)
width := 200; width := 200;
left := 10; left := 10;
top := 10; top := 10;
FTabPosition := alTop;
FirstViewIndex := 0; FirstViewIndex := 0;
FCurrentid := -1; FCurrentid := -1;
FPrevid := -1; FPrevid := -1;
FTabItems := new tnumindexarray(); FTabItems := new tnumindexarray();
end end
function ControlAppended(AControl);override; Function SetCurSel(id); virtual; //设置当前序号
begin begin
if not isacceptsheettype(AControl) {not(AControl is class(tcustomtabsheet))} then return;
addtabitem(AControl);
end
function ControlDeleted(AControl);override;
begin
if not isacceptsheettype(AControl){ not(AControl is class(tcustomtabsheet))} then return;
id := GetPageID(AControl);
RemovePageTab(id);
//fcoolbands.deleteitem(AControl,true);
end
Function SetCurSel(id); //设置当前序号
begin
if isacceptsheettype(id) {id is class(tcustomtabsheet)} then
begin
return SetCurSel(GetPageID(id));
end
if ifnumber(id) and id>=0 then if ifnumber(id) and id>=0 then
begin begin
iid := integer(id); iid := integer(id);
@ -636,58 +597,9 @@ type tcustompagecontrol = class(TCustomControl)
if AIndex<FTabItems.length() and AIndex>0 then return FTabItems[AIndex].Caption; if AIndex<FTabItems.length() and AIndex>0 then return FTabItems[AIndex].Caption;
return r; return r;
end end
function GetPageID(page);//获得page序号
begin
{**
@explan(说明)获取page的序号 %%
**}
r := -1;
if {page is class(tcustomtabsheet)} isacceptsheettype(page) then
begin
for it := 0 to FTabItems.length()-1 do
begin
if FTabItems[it].PageSheet = page then
begin
return it;
end
end
end
return r;
end
function DoControlAlign();override;//调整位置 function DoControlAlign();override;//调整位置
begin begin
CalcTabs(); CalcTabs();
for i := 0 to FTabItems.length()-1 do
begin
pg := FTabItems[i].PageSheet;
if not pg then continue;
pg.Align := alNone;
if (pg is class(TWinControl)) and pg.WsPopUp then
begin
if i=FCurrentid then
begin
pg.show();
end
continue;
end
if i=FCurrentid then
begin
pg.Visible := true;
rc := getsheetrect();
if not rc then return ;
rc[1]+=1;
if csDesigning in ComponentState then
begin
rc[0]+=2;
rc[2]-=2;
rc[3]-=2;
end
pg.SetBoundsrect(rc);
end else
begin
pg.Visible := false;
end
end
end end
function SetTabText(i,Value); function SetTabText(i,Value);
begin begin
@ -734,6 +646,239 @@ type tcustompagecontrol = class(TCustomControl)
FOnSelChanging := nil; FOnSelChanging := nil;
FTabItems.splice(0,nil); FTabItems.splice(0,nil);
inherited; inherited;
end
{**
@param(cursel)(integer) 当前选中序号 %%
@param(TabCount)(integer) page数量 %%
@param(OnSelChange)(function[tcustompagecontrol,tuieventbase]) 标签已经切换 %%
@param(OnSelChanging)(function[tcustompagecontrol,tuieventbase]) 标签正在切换 %%
@param(Onrclcik)(function[tcustompagecontrol,tuieventbase]) 右键点击 %%
**}
published
property cursel:lazyinteger read FCurrentid write SetCurSel;
property OnSelChanged:eventhandler read FOnSelChanged write FOnSelChanged;
property OnSelChanging:eventhandler read FOnSelChanging write FOnSelChanging;
property TabCount read GetTabCount;
property tabs:Strings read get_tabs write set_tabs;
property TabPosition:tabalign read FTabPosition write SetTabPosition;
property tabsheetitem:tcustomtabitem read gettabsheetitem;
property onmeasuretabwidth:eventhandler read fonmeasuretabwidth write fonmeasuretabwidth;
property ondrawtab:eventhandler read fondrawtab write fondrawtab;
property ownerdraw:bool read fownerdraw write fownerdraw;
property tabheight:lazyinteger read FTabHeight write settabheight;
property closebtn:bool read fclosebtn write setclosebtn;
property onclosebtnclick:eventhandler read fonclosebtnclick write fonclosebtnclick;
private
fownerdraw;
fclosebtn;
fclosebtnrect;
[weakref] fondrawtab;
[weakref] fonmeasuretabwidth;
[weakref] fonclosebtnclick;
private
function get_tabs();
begin
r := array();
for i := 0 to FTabItems.length()-1 do
begin
r[i] := FTabItems[i].Caption;
end
return r ;
end
function set_tabs(r);
begin
if not ifarray(r) then return ;
rs := array();
for i,v in r do
begin
if ifstring(v) then rs[length(rs)] := v;
end
ts := get_tabs();
if ts<>rs then
begin
FTabItems.splice(0,nil);
for i,v in rs do
begin
FTabItems.Push(CreateTableItem(v));
end
AdjustSize();
FPrevid := -1;
FCurrentid := -1;
if FTabItems.length()>0 then
begin
setselidx(0);
end
end
end
function setclosebtn(v);
begin
nv := v?true:false;
if nv<>fclosebtn then
begin
fclosebtn := nv;
DoControlAlign();
end
end
function settabheight(h);
begin
if ownerdraw and ( h>=0) and FTabHeight<>h then
begin
FTabHeight := h;
AdjustSize();
end
end
end
type tcustompagecontrol = class(tcustomtabcontrol)
private
function gettabsheetitem(idx);override;
begin
if idx>=0 and idx<ftabitems.length() then return FTabItems[idx];
if isacceptsheettype(idx) then
begin
for i:= 0 to ftabitems.length()-1 do
begin
it := FTabItems[i];
if idx=it.PageSheet then return it;
end
end
end
function gettabesheet(idx);
begin
if idx>=0 and idx<ftabitems.length() then
begin
return FTabItems[idx].PageSheet;
end
end
function getactivetabsheet();
begin
id := cursel;
if id>=0 then return FTabItems[id].PageSheet;
end
function addtabitem(page);//添加sheet
begin
//if not(page is class(tcustomtabsheet)) then return -1;
for i := 0 to FTabItems.length()-1 do
begin
if FTabItems[i].PageSheet = page then return -1;
end
if page then
cp := page.Caption;
it := CreateTableItem(cp);
FTabItems.Push(it);
if FTabItems.length()>1 then
begin
if page then
begin
page.visible := false;
end
end
it.PageSheet := Page;
if cursel=-1 then
begin
setselidx(0);
end else
begin
if not (page is class(TWinControl)) then CalcTabs();
InvalidateRect(nil,false);
end
end
public
function checknewchild(achild);override;//检查child
begin
r := inherited;
if isacceptsheettype( achild) then achild.Align := alNone;
return r;
end
function create(aowner);
begin
faccepttype := array();
inherited;
acceptsheettype(class(tcustomtabsheet));
end
function ControlAppended(AControl);override;
begin
if not isacceptsheettype(AControl) {not(AControl is class(tcustomtabsheet))} then return;
addtabitem(AControl);
end
function ControlDeleted(AControl);override;
begin
if not isacceptsheettype(AControl){ not(AControl is class(tcustomtabsheet))} then return;
id := GetPageID(AControl);
RemovePageTab(id);
//fcoolbands.deleteitem(AControl,true);
end
Function SetCurSel(id);override; //设置当前序号
begin
if isacceptsheettype(id) {id is class(tcustomtabsheet)} then
begin
return SetCurSel(GetPageID(id));
end
return inherited;
end
function GetPageID(page);//获得page序号
begin
{**
@explan(说明)获取page的序号 %%
**}
r := -1;
if isacceptsheettype(page) then
begin
for it := 0 to FTabItems.length()-1 do
begin
if FTabItems[it].PageSheet = page then
begin
return it;
end
end
end
return r;
end
function DoControlAlign();override;//调整位置
begin
inherited;
for i := 0 to FTabItems.length()-1 do
begin
pg := FTabItems[i].PageSheet;
if not pg then continue;
pg.Align := alNone;
curid := cursel;
if (pg is class(TWinControl)) and pg.WsPopUp then
begin
if i=curid then
begin
pg.show();
end
continue;
end
if i=curid then
begin
//pg.Visible := true;
rc := getsheetrect();
if not rc then return ;
pg.Visible := ((rc[3]>rc[1]) and (rc[2]>rc[0]));
rc[1]+=1;
if csDesigning in ComponentState then
begin
rc[0]+=2;
rc[2]-=2;
rc[3]-=2;
end
pg.SetBoundsrect(rc);
end else
begin
pg.Visible := false;
end
end
end
function Recycling();override;
begin
FOnSelChanged := nil;
FOnSelChanging := nil;
FTabItems.splice(0,nil);
inherited;
faccepttype := array();
end end
function acceptsheettype(ty,del); function acceptsheettype(ty,del);
begin begin
@ -759,37 +904,15 @@ type tcustompagecontrol = class(TCustomControl)
return true; return true;
end end
{** {**
@param(cursel)(integer) 当前选中序号 %%
@param(activetabsheet)(tcustomtabsheet) 当前选中的页面 %% @param(activetabsheet)(tcustomtabsheet) 当前选中的页面 %%
@param(tabsheet)(tcustomtabsheet) 通过下标获得页面 %% @param(tabsheet)(tcustomtabsheet) 通过下标获得页面 %%
@param(TabCount)(integer) page数量 %%
@param(OnSelChange)(function[tcustompagecontrol,tuieventbase]) 标签已经切换 %%
@param(OnSelChanging)(function[tcustompagecontrol,tuieventbase]) 标签正在切换 %%
@param(Onrclcik)(function[tcustompagecontrol,tuieventbase]) 右键点击 %%
**} **}
published published
property activetabsheet:tcustomtabsheet read getactivetabsheet write SetCurSel; property activetabsheet:tcustomtabsheet read getactivetabsheet write SetCurSel;
property cursel:lazyinteger read FCurrentid write SetCurSel;
property OnSelChanged:eventhandler read FOnSelChanged write FOnSelChanged;
property OnSelChanging:eventhandler read FOnSelChanging write FOnSelChanging;
property TabCount read GetTabCount;
property TabPosition:tabalign read FTabPosition write SetTabPosition;
property tabsheet read gettabesheet ; property tabsheet read gettabesheet ;
property tabsheetitem:tcustomtabitem read gettabsheetitem;
property onmeasuretabwidth:eventhandler read fonmeasuretabwidth write fonmeasuretabwidth;
property ondrawtab:eventhandler read fondrawtab write fondrawtab;
property ownerdraw:bool read fownerdraw write fownerdraw;
property tabheight:lazyinteger read FTabHeight write settabheight;
property closebtn:bool read fclosebtn write setclosebtn;
property onclosebtnclick:eventhandler read fonclosebtnclick write fonclosebtnclick;
private private
fownerdraw; tabs;
faccepttype; faccepttype;
fclosebtn;
fclosebtnrect;
[weakref] fondrawtab;
[weakref] fonmeasuretabwidth;
[weakref] fonclosebtnclick;
private private
function isacceptsheettype(c); function isacceptsheettype(c);
begin begin
@ -798,23 +921,6 @@ type tcustompagecontrol = class(TCustomControl)
if c is v then return true; if c is v then return true;
end end
end end
function setclosebtn(v);
begin
nv := v?true:false;
if nv<>fclosebtn then
begin
fclosebtn := nv;
DoControlAlign();
end
end
function settabheight(h);
begin
if ownerdraw and ( h>=0) and FTabHeight<>h then
begin
FTabHeight := h;
DoControlAlign();
end
end
end end
implementation implementation
type tcustomtabitem = class() // type tcustomtabitem = class() //

355
funcext/tvclib/utslvclstdctl.tsf
View File

@ -529,6 +529,10 @@ type tcustombtn = class(TCustomControl) //
end end
end end
function GetPreferredSize(w,h);override;
begin
class(tcontrol).GetPreferredSize(w,h);
end
function FontChanged(o);override; //字体改变 function FontChanged(o);override; //字体改变
begin begin
inherited; inherited;
@ -565,7 +569,9 @@ type tcustombtn = class(TCustomControl) //
bs := caption; bs := caption;
inherited; inherited;
if bs = caption then return ; if bs = caption then return ;
InvalidateRect(nil,false); //if autosize then return set_Preferre_size();
AdjustSize();
//InvalidateRect(nil,false);
end end
function PaintMouseDown();virtual; //按下绘制 function PaintMouseDown();virtual; //按下绘制
begin begin
@ -673,6 +679,11 @@ type tcustomcheckbtn=class(tcustombtn) //checkbtn
FcheckState := e.wparam; FcheckState := e.wparam;
InvalidateRect(nil,false); InvalidateRect(nil,false);
end end
function GetPreferredSize(w,h);override;
begin
inherited;
w+=20+1;
end
published published
property checked:bool read FcheckState write setChecked; property checked:bool read FcheckState write setChecked;
property leftText:bool read FleftText write setLeftText; property leftText:bool read FleftText write setLeftText;
@ -1147,6 +1158,15 @@ type teditable=class(TSLUIBASE) //
r := getselstring(); r := getselstring();
GetCBoard().text := r; GetCBoard().text := r;
end end
function cutetoclipboard();//剪切
begin
r := getselstring();
if r then
begin
GetCBoard().text := r;
DeleteSel();
end
end
function PasteFromClipBoard();//粘贴 function PasteFromClipBoard();//粘贴
begin begin
if readonly then return; if readonly then return;
@ -1836,7 +1856,7 @@ type tVirtualCalender=class(TSLUIBASE)
begin begin
inherited; inherited;
FFont := new Tcustomfont(); FFont := new Tcustomfont();
FDateRows := 8; FDateRows := 7;
FCalenderState := 3; FCalenderState := 3;
FLeft := 0; FLeft := 0;
FTop := 0; FTop := 0;
@ -1856,9 +1876,15 @@ type tVirtualCalender=class(TSLUIBASE)
begin begin
if FHost and FHost.HandleAllocated()then if FHost and FHost.HandleAllocated()then
begin begin
FHost.InvalidateRect(rec ?: GetCalenderRect,f); FHost.InvalidateRect(rec ?: GetCalenderRect(),f);
end end
end end
function GetPreferredSize(w,h);override;
begin
calc_size_base();
w := FCellWidth *7;
h := FCellHeight*9;
end
function dodatechanged();virtual; function dodatechanged();virtual;
begin begin
if FHost and FHost.HandleAllocated()then if FHost and FHost.HandleAllocated()then
@ -2106,10 +2132,11 @@ type tVirtualCalender=class(TSLUIBASE)
if not(host and host.HandleAllocated())then return; if not(host and host.HandleAllocated())then return;
dc := host.Canvas; dc := host.Canvas;
if not(dc and dc.HandleAllocated())then return; if not(dc and dc.HandleAllocated())then return;
dc.font := font; //dc.font := array("width":7,"height":14);
CalcDateMatrx();
if FHasMonthSel then if FHasMonthSel then
begin begin
dc.brush.color := 14474440;//rgb(200,220,220); dc.brush.color := clMenuBar;//14474440;//rgb(200,220,220);
dc.fillrect(array(FLeft,FTop,FLeft+FCellWidth * 7,FTop+FMonthselheight)); dc.fillrect(array(FLeft,FTop,FLeft+FCellWidth * 7,FTop+FMonthselheight));
if FDecRect then dc.draw("framecontrol",array((FDecRect[0]+FLeft,FDecRect[1]+FTop),(FDecRect[2]+FLeft,FDecRect[3]+FTop)),DFC_SCROLL,DFCS_SCROLLLEFT); if FDecRect then dc.draw("framecontrol",array((FDecRect[0]+FLeft,FDecRect[1]+FTop),(FDecRect[2]+FLeft,FDecRect[3]+FTop)),DFC_SCROLL,DFCS_SCROLLLEFT);
if FIncRect then dc.draw("framecontrol",array((FIncRect[0]+FLeft,FIncRect[1]+FTop),(FIncRect[2]+FLeft,FIncRect[3]+FTop)),DFC_SCROLL,DFCS_SCROLLRIGHT); if FIncRect then dc.draw("framecontrol",array((FIncRect[0]+FLeft,FIncRect[1]+FTop),(FIncRect[2]+FLeft,FIncRect[3]+FTop)),DFC_SCROLL,DFCS_SCROLLRIGHT);
@ -2122,11 +2149,11 @@ type tVirtualCalender=class(TSLUIBASE)
rec[3]+= FTop; rec[3]+= FTop;
if FCalenderState=1 then if FCalenderState=1 then
begin begin
dc.brush.color := 16445680;//rgb(240,240,250); dc.brush.color := clHighlight;//16445680;//rgb(240,240,250);
dc.fillrect(rec); dc.fillrect(rec);
end end
dc.font.weight := 700; dc.font.weight := 700;
dc.drawtext(inttostr(FYear)+"Äê",rec,DT_CENTER); dc.drawtext(inttostr(FYear)+"年",rec,DT_VCENTER.|DT_RIGHT);
end end
if FMonthRect then if FMonthRect then
begin begin
@ -2137,11 +2164,11 @@ type tVirtualCalender=class(TSLUIBASE)
rec[3]+= FTop; rec[3]+= FTop;
if FCalenderState=2 then if FCalenderState=2 then
begin begin
dc.brush.color := 16445680;//rgb(240,240,250); dc.brush.color := clHighlight;//16445680;//rgb(240,240,250);
dc.fillrect(rec); dc.fillrect(rec);
end end
dc.font.weight := 700; dc.font.weight := 700;
dc.drawtext(inttostr(FMonth)+"ÔÂ",rec,DT_CENTER); dc.drawtext(inttostr(FMonth)+"月",rec,DT_VCENTER.|DT_LEFT);
end end
end end
t := FTop+(FMonthselheight * FHasMonthSel); t := FTop+(FMonthselheight * FHasMonthSel);
@ -2158,7 +2185,7 @@ type tVirtualCalender=class(TSLUIBASE)
rec[3]+= t; rec[3]+= t;
if d["sel"]then if d["sel"]then
begin begin
dc.brush.color := 6579400;//rgb(200,200,100); dc.brush.color := clHotLight ;//6579400;//rgb(200,200,100);
dc.FillRect(rec); dc.FillRect(rec);
end end
dc.drawtext(d["text"],rec,DT_CENTER .| DT_VCENTER .| DT_SINGLELINE); dc.drawtext(d["text"],rec,DT_CENTER .| DT_VCENTER .| DT_SINGLELINE);
@ -2180,7 +2207,7 @@ type tVirtualCalender=class(TSLUIBASE)
rec[3]+= t; rec[3]+= t;
if d["sel"]then if d["sel"]then
begin begin
dc.brush.color := 6579400;//rgb(200,200,100); dc.brush.color := clHotLight;//6579400;//rgb(200,200,100);
dc.FillRect(rec); dc.FillRect(rec);
end end
if i=0 then dc.font.weight := 700; if i=0 then dc.font.weight := 700;
@ -2200,7 +2227,7 @@ type tVirtualCalender=class(TSLUIBASE)
rec[2]+= FLeft; rec[2]+= FLeft;
rec[1]+= t; rec[1]+= t;
rec[3]+= t; rec[3]+= t;
dc.brush.color := 6579400;//rgb(200,200,200); dc.brush.color := clMenuBar;//6579400;//rgb(200,200,200);
dc.fillrect(rec); dc.fillrect(rec);
dc.drawtext(" today: "+datetimetostr(date()),rec,DT_LEFT); dc.drawtext(" today: "+datetimetostr(date()),rec,DT_LEFT);
end end
@ -2247,10 +2274,23 @@ type tVirtualCalender=class(TSLUIBASE)
end end
function GetCalenderRect(); function GetCalenderRect();
begin begin
calc_size_base();
return array(FLeft,FTop,FLeft+FCellWidth * 7,FTop+FHasMonthSel * FMonthselheight+FCellHeight * FDateRows+FHasToday * FTodayHeight); return array(FLeft,FTop,FLeft+FCellWidth * 7,FTop+FHasMonthSel * FMonthselheight+FCellHeight * FDateRows+FHasToday * FTodayHeight);
end end
function calc_size_base();
begin
if FHost then
begin
ft := FHost.Font;
FCellWidth := ft.Width*3;
FCellHeight := ft.Height+4;
FTodayHeight := FCellHeight;
FMonthselheight := FCellHeight;
end
end
function CalcDateMatrx(); function CalcDateMatrx();
begin begin
calc_size_base();
FDecRect := array(); FDecRect := array();
FIncRect := array(); FIncRect := array();
FTodyRect := array(); FTodyRect := array();
@ -2259,14 +2299,14 @@ type tVirtualCalender=class(TSLUIBASE)
FDecRect := array(5,2,25,22); FDecRect := array(5,2,25,22);
x := 7 * FCellWidth-25; x := 7 * FCellWidth-25;
FIncRect := array(x,2,x+20,22); FIncRect := array(x,2,x+20,22);
FYearRect := array(60,2,110,22); FYearRect := array(30,2,30+FCellWidth*3.5-20,FCellHeight);
FMonthRect := array(115,2,165,22); FMonthRect := array(FYearRect[2]+5,2,x-20,FCellHeight);
end end
if FHasToday then if FHasToday then
begin begin
x := 7 * FCellWidth; x := 7 * FCellWidth;
y := FDateRows * FCellHeight; y := FDateRows * FCellHeight;
FTodyRect := array(0,y,x,y+FTodayHeight); FTodyRect := array(0,y+1,x,y+FTodayHeight);
end end
FDateMatrix := array(); FDateMatrix := array();
if FCalenderState=3 then if FCalenderState=3 then
@ -2317,15 +2357,15 @@ type tVirtualCalender=class(TSLUIBASE)
end else end else
if FCalenderState=2 then //月选择 if FCalenderState=2 then //月选择
begin begin
cw := integer(FCellWidth * 1.5); cw := integer(FCellWidth * 1.7);
ch := integer(FCellHeight * 2); ch := integer(FCellHeight * 2);
for i := 1 to 12 do for i := 1 to 12 do
begin begin
data := array(); data := array();
divmod(i-1,4,a,b); divmod(i-1,4,a,b);
x0 := b * cw+10; x0 := b * cw+5;
x1 := x0+cw; x1 := x0+cw;
y0 := a * ch+10; y0 := a * ch+5;
y1 := y0+ch; y1 := y0+ch;
data := array(); data := array();
data["rec"]:= array(x0,y0,x1,y1); data["rec"]:= array(x0,y0,x1,y1);
@ -2337,15 +2377,15 @@ type tVirtualCalender=class(TSLUIBASE)
end else end else
if FCalenderState=1 then //年选择 if FCalenderState=1 then //年选择
begin begin
cw := integer(FCellWidth * 1.5); cw := integer(FCellWidth * 1.7);
ch :=(FCellHeight); ch :=(FCellHeight);
for i,v in((FYear-13)->(FYear+14)) do for i,v in((FYear-13)->(FYear+14)) do
begin begin
data := array(); data := array();
divmod(i,4,a,b); divmod(i,4,a,b);
x0 := b * cw+10; x0 := b * cw+5;
x1 := x0+cw; x1 := x0+cw;
y0 := a * ch+10; y0 := a * ch+5;
y1 := y0+ch; y1 := y0+ch;
data := array(); data := array();
data["rec"]:= array(x0,y0,x1,y1); data["rec"]:= array(x0,y0,x1,y1);
@ -2512,8 +2552,29 @@ type TcustomLabel = class(TGraphicControl)
end end
end end
public public
function RealSetText(s);override;
begin
{**
@explan(说明) 修改标题 %%
**}
if ifstring(s)and caption <> s then
begin
inherited;
//if autosize then set_Preferre_size();
AdjustSize();
end
end
function AdjustSize();override;
begin
if autosize then
set_Preferre_size();
inherited;
end
function FontChanged(o);override; function FontChanged(o);override;
begin begin
if autosize then
set_Preferre_size();
else
InvalidateRect(nil,false); InvalidateRect(nil,false);
end end
function paint();override; function paint();override;
@ -2592,6 +2653,20 @@ type tcustomedit=class(TCustomControl)
function Create(AOwner);override; function Create(AOwner);override;
begin begin
inherited; inherited;
feditpopmenu := new TcustomPopupmenu(self);
fcopym := new TcustomMenu(self);
fpastem := new TcustomMenu(self);
fcutm := new TcustomMenu(self);
fcopym.caption := "复制";
fpastem.caption := "粘贴";
fcutm.caption := "剪切";
fcopym.Parent := feditpopmenu;
fpastem.Parent := feditpopmenu;
fcutm.Parent := feditpopmenu;
PopupMenu := feditpopmenu;
fcopym.OnClick := thisfunction(editcopy);
fpastem.OnClick := thisfunction(editpaste);
fcutm.OnClick := thisfunction(editcute);
end end
function AfterConstruction();override; function AfterConstruction();override;
begin begin
@ -2683,6 +2758,21 @@ type tcustomedit=class(TCustomControl)
end end
inherited; inherited;
end end
function GetPreferredSize(w,h);override;
begin
w := Width;
ft := Font;
h := ft.Height+5;
end
function ContextMenu(o,e);override;
begin
if not FEditable then return ;
if PopupMenu<>feditpopmenu then return inherited;
flg := FEditable.ExecuteCommand("ecgetsel",pm)?true:false ;
fcopym.Enabled := flg;
fcutm.Enabled := flg and not(FEditable.readonly);
return inherited;
end
function keypress(o,e);override; function keypress(o,e);override;
begin begin
if csDesigning in ComponentState then return; if csDesigning in ComponentState then return;
@ -2714,8 +2804,8 @@ type tcustomedit=class(TCustomControl)
end end
function FontChanged(sender);override; function FontChanged(sender);override;
begin begin
inherited;
FEditable.font := Font; FEditable.font := Font;
inherited;
end end
function Recycling();override; function Recycling();override;
begin begin
@ -2734,7 +2824,7 @@ type tcustomedit=class(TCustomControl)
property onchanged:eventhandler read FOnChange write FOnChange; property onchanged:eventhandler read FOnChange write FOnChange;
property readonly:bool read getReadOnly write setReadOnly; property readonly:bool read getReadOnly write setReadOnly;
property limitlength:integer read getlimitlength write setLimitLength; property limitlength:integer read getlimitlength write setLimitLength;
property LineWrap:bool read getLineWrap write setLineWrap; property LineWrap read getLineWrap write setLineWrap;
property placeholder:string read getplaceholder write Setplaceholder; property placeholder:string read getplaceholder write Setplaceholder;
//property Border:bool read getBorder write SetBorder; //property Border:bool read getBorder write SetBorder;
{** {**
@ -2784,6 +2874,9 @@ type tcustomedit=class(TCustomControl)
end end
function setReadOnly(v); function setReadOnly(v);
begin begin
nv := v?true:false;
fcutm.Enabled := nv;
fpastem.Enabled := nv;
if FEditable then return FEditable.readonly := v; if FEditable then return FEditable.readonly := v;
end end
function getlimitlength(); function getlimitlength();
@ -2802,6 +2895,22 @@ type tcustomedit=class(TCustomControl)
begin begin
if FEditable then return FEditable.LineWrap := v; if FEditable then return FEditable.LineWrap := v;
end end
function editpaste();
begin
if FEditable then FEditable.ExecuteCommand("ecpaste");
end
function editcopy();
begin
if FEditable then FEditable.ExecuteCommand("eccopy");
end
function editcute();
begin
if FEditable then FEditable.ExecuteCommand("eccut");
end
feditpopmenu;
fcopym;
fpastem;
fcutm;
weakref weakref
FOnUpdate; FOnUpdate;
FOnChange; FOnChange;
@ -2947,7 +3056,6 @@ type tthreeEntry=class(TCustomControl)
function create(aowner); function create(aowner);
begin begin
inherited; inherited;
end end
function AfterConstruction();override; function AfterConstruction();override;
begin begin
@ -2974,6 +3082,17 @@ type tthreeEntry=class(TCustomControl)
calcCtls(); calcCtls();
FEntrys :: mcell.host := self(true); FEntrys :: mcell.host := self(true);
end end
function GetPreferredSize(w,h);override;
begin
ft := font;
if ft then
begin
fth := ft.Height;
ftw := ft.Width;
w := ftw*11+fth;
h := fth+4;
end
end
function paint();override; function paint();override;
begin begin
for i,v in FEntrys do for i,v in FEntrys do
@ -2995,13 +3114,23 @@ type tthreeEntry=class(TCustomControl)
dc := Canvas; dc := Canvas;
dc.Draw("framecontrol",array(FBtnRect[0:1],FBtnRect[2:3]),DFC_SCROLL,DFCS_SCROLLDOWN); dc.Draw("framecontrol",array(FBtnRect[0:1],FBtnRect[2:3]),DFC_SCROLL,DFCS_SCROLLDOWN);
end end
end
function AdjustSize();override;
begin
if not HandleAllocated() then return ;
calcCtls();
class(TWinControl).AdjustSize();
end
{function WMSize(o,e):LM_SIZE;virtual;
begin
end end
function DoWMSIZE(o,e);override; function DoWMSIZE(o,e);override;
begin begin
calcCtls(); calcCtls();
InvalidateRect(nil,false); InvalidateRect(nil,false);
inherited; inherited;
end end}
function dosetfocus(o,e);override; function dosetfocus(o,e);override;
begin begin
if csDesigning in ComponentState then return; if csDesigning in ComponentState then return;
@ -3114,9 +3243,13 @@ type tthreeEntry=class(TCustomControl)
begin begin
//改变 //改变
ft := font; ft := font;
if ft then
begin
FFontWidth := ft.width; FFontWidth := ft.width;
for i,v in FEntrys do v.Font := ft; for i,v in FEntrys do v.Font := ft;
calcCtls(); //calcCtls();
inherited;
end
end end
protected protected
function calcCtls();virtual; function calcCtls();virtual;
@ -3417,6 +3550,12 @@ type TCustomListBoxbase=class(TCustomScrollControl)
SetYpos(idx-ndx); SetYpos(idx-ndx);
end end
end end
function AdjustSize();override;
begin
if not HandleAllocated() then return ;
UpDateScrollBar();
class(TWinControl).AdjustSize();
end
function FontChanged(o);override; function FontChanged(o);override;
begin begin
ft := Font; ft := Font;
@ -3427,7 +3566,6 @@ type TCustomListBoxbase=class(TCustomScrollControl)
begin begin
FFontHeight := h; FFontHeight := h;
FFontWidth := wd; FFontWidth := wd;
UpDateScrollBar();
end end
inherited; inherited;
end end
@ -3510,6 +3648,7 @@ type TcustomListBox=class(TCustomListBoxbase)
begin begin
inherited; inherited;
FOwnerDraw := false; FOwnerDraw := false;
FListitemheigt := font.Height+4;
border := true; border := true;
FitemData := new tnumindexarray(); FitemData := new tnumindexarray();
FSelBegin :=-1; FSelBegin :=-1;
@ -3520,9 +3659,13 @@ type TcustomListBox=class(TCustomListBoxbase)
end end
function FontChanged(o);override; function FontChanged(o);override;
begin begin
if fownerdraw then return ; ft := font;
if ft then
begin
if not fownerdraw then setItemHeight( font.Height+4);
return inherited; return inherited;
end end
end
function MouseUp(o,e);override; function MouseUp(o,e);override;
begin begin
if FIsMouseDown then //已经按下过 if FIsMouseDown then //已经按下过
@ -4244,6 +4387,11 @@ type TCustomComboBoxbase=class(TCustomControl)
**} **}
return ""; return "";
end end
function GetPreferredSize(w,h);override;
begin
class(tcontrol).GetPreferredSize(w,h);
w := Width;
end
function Paint();override; function Paint();override;
begin begin
rc := ClientRect; rc := ClientRect;
@ -4630,9 +4778,11 @@ type TcustomComboBox=class(TCustomComboBoxbase)
function setMultisel(v); function setMultisel(v);
begin begin
nv := v?true:false; nv := v?true:false;
if nv<>FMultisel then if nv<>FMultisel then
begin begin
FMultisel := nv; FMultisel := nv;
if not FListBox then return ;
if FMultisel then if FMultisel then
begin begin
FListBox.Multisel := 2; FListBox.Multisel := 2;
@ -4648,6 +4798,7 @@ type TcustomComboBox=class(TCustomComboBoxbase)
if nv<>fcheckbox then if nv<>fcheckbox then
begin begin
fcheckbox := nv; fcheckbox := nv;
if FListBox then
FListBox.checkbox := nv; FListBox.checkbox := nv;
end end
end end
@ -4662,20 +4813,25 @@ type TcustomComboBox=class(TCustomComboBoxbase)
end end
function getlistitemcount();override; //获得项目 function getlistitemcount();override; //获得项目
begin begin
if FListBox then
return FListBox.ItemCount; return FListBox.ItemCount;
end end
function getlistitemheight();override; //获得项目高 function getlistitemheight();override; //获得项目高
begin begin
if FListBox then
return FListBox.ItemHeight; return FListBox.ItemHeight;
end end
function GetItemIndex();override; function GetItemIndex();override;
begin begin
//if FMultisel and (csDesigning in ComponentState) then return -1; //if FMultisel and (csDesigning in ComponentState) then return -1;
if FListBox then
return FListBox.GetCurrentSelection(); return FListBox.GetCurrentSelection();
return -1;
end end
function SetItemIndex(idx);override; function SetItemIndex(idx);override;
begin begin
//if FMultisel and (csDesigning in ComponentState) then return -1; //if FMultisel and (csDesigning in ComponentState) then return -1;
if FListBox then
return FListBox.SetCurrentSelection(idx); return FListBox.SetCurrentSelection(idx);
end end
feditischanging;//改变正在回调 feditischanging;//改变正在回调
@ -4693,6 +4849,7 @@ type TcustomComboBox=class(TCustomComboBoxbase)
FEdit; FEdit;
function setItems(d); function setItems(d);
begin begin
if FListBox then
return FListBox.SetData(d); return FListBox.SetData(d);
end end
end end
@ -5042,8 +5199,57 @@ type TcustomToolBar=class(TCustomControl)
end end
function FontChanged(o);override; function FontChanged(o);override;
begin begin
if fmainmenu then CalcButtonsRect();
inherited; inherited;
if fmainmenu then doControlALign(); end
function GetPreferredSize(w,h);override;
begin
ft := Font;
if not ft then return ;
ftw := ft.Width;
fth := ft.Height;
brec := BoundsRect;
crec := ClientRect;
dw := (brec[2]-brec[0])-(crec[2]-crec[0]);
dh := (brec[3]-brec[1])-(crec[3]-crec[1]);
if fmainmenu then
begin
w := 0;
for i:= 0 to fmenubtns.length()-1 do
begin
mu := getbtnitem(i);
if mu.Visible then
begin
s := mu.Caption;
w +=length(s)*ftw+15;
end
end
w +=dw+2;
w := max(100,w);
h := fth+2+dh;
return ;
end else
begin
imglst := ImageList; //图标
imgw := 28;
imgh := 28;
if imglst is class(TCustomImageList)then
begin
imgw := imglst.Width+4;
imgh := imglst.height+4;
end
ct := 0;
for i := 0 to FButtons.Length()-1 do //调整大小
begin
bi := FButtons[i];
ct +=bi.Visible;
end
w := max(ct,1)*imgw;
h := imgh;
w+=dw;
h+=dh;
return ;
end
end end
function MouseDown(o,e);override; function MouseDown(o,e);override;
begin begin
@ -5347,8 +5553,9 @@ type TcustomToolBar=class(TCustomControl)
if FWillModifyToolbar then if FWillModifyToolbar then
begin begin
FWillModifyToolbar := false; FWillModifyToolbar := false;
DoControlAlign(); //DoControlAlign();
if Parent then Parent.DoControlAlign(); //if Parent then Parent.DoControlAlign();
AdjustSize();
end end
end end
inherited; inherited;
@ -5409,6 +5616,11 @@ type TcustomToolBar=class(TCustomControl)
if WSSizebox or WsDlgModalFrame or Border then bw := 2; if WSSizebox or WsDlgModalFrame or Border then bw := 2;
if fmainmenu then if fmainmenu then
begin begin
ft := Font;
if ft then
begin
return ft.Height+2+bw;
end
return 40; return 40;
end end
imglst := ImageList; //图标 imglst := ImageList; //图标
@ -5523,6 +5735,7 @@ type TcustomToolBar=class(TCustomControl)
fmenubtns.push(new tcustommenubutton( fmainmenu.GetItemByIndex(i),self(true))); fmenubtns.push(new tcustommenubutton( fmainmenu.GetItemByIndex(i),self(true)));
end end
CalcButtonsRect(); CalcButtonsRect();
AdjustSize();
end end
function setmainmenu(v); //设置主菜单 function setmainmenu(v); //设置主菜单
begin begin
@ -5556,23 +5769,38 @@ type TcustomToolBar=class(TCustomControl)
FWillModifyToolbar := true; FWillModifyToolbar := true;
return; return;
end end
ft := Font;
if not ft then return ;
ftwd := ft.Width;
fth := ft.Height;
rc := ClientRect;
if fmainmenu then if fmainmenu then
begin begin
rc := ClientRect;
y := rc[1]; y := rc[1];
x := rc[0]+1; x := rc[0]+1;
fmenubtnrects := array(); fmenubtnrects := array();
rct := 0;
cct := 0;
for i:= 0 to fmenubtns.length()-1 do for i:= 0 to fmenubtns.length()-1 do
begin begin
mu := getbtnitem(i); mu := getbtnitem(i);
if mu.Visible then if mu.Visible then
begin begin
s := mu.Caption; s := mu.Caption;
wh := GetTextWidthAndHeightWidthFont(s,self.font,0);// wh //wh := GetTextWidthAndHeightWidthFont(s,self.font,0);// wh
nwh := x+wh[0]+15; //nwh := x+wh[0]+15;
fmenubtnrects[i]:= array(x,y,nwh,rc[3]); nwh := x+length(s)*ftwd+15;
if nwh>rc[2] and cct>0 then
begin
x := rc[0]+1;
nwh := x+length(s)*ftwd+15;
cct := 0;
y :=y+fth+3;
end
fmenubtnrects[i]:= array(x,y,nwh,y+fth+2);
cct++;
x:=nwh; x:=nwh;
if x>rc[2] then break; //Ö»ÓÐÒ»ÐÐ //if x>rc[2] then break; //只有一行
end else end else
begin begin
fmenubtnrects[i] := array(0,0,0,0); fmenubtnrects[i] := array(0,0,0,0);
@ -5588,7 +5816,6 @@ type TcustomToolBar=class(TCustomControl)
imgw := imglst.Width+4; imgw := imglst.Width+4;
imgh := imglst.height+4; imgh := imglst.height+4;
end end
rc := ClientRect;
FBtnRects := array(); FBtnRects := array();
x := y := 0; x := y := 0;
rct := 0; rct := 0;
@ -5792,6 +6019,11 @@ type TcustomStatusBar=class(TCustomControl)
InvalidateRect(nil,false); InvalidateRect(nil,false);
end end
end end
function GetPreferredSize(w,h);override;
begin
class(tcontrol).GetPreferredSize(w,h);
w := Width;
end
published published
property Items:statusitems read Fitems Write SetItems; property Items:statusitems read Fitems Write SetItems;
property itemtext:string read gettexti write settexti; property itemtext:string read gettexti write settexti;
@ -6185,12 +6417,22 @@ type TCustomSpinEdit = class(TCustomControl)
FEdit.MouseMove(o,e); FEdit.MouseMove(o,e);
end end
end end
function GetPreferredSize(w,h);override;
begin
class(tcontrol).GetPreferredSize(w,h);
w := Width;
end
function paint();override; function paint();override;
begin begin
FEdit.paint(); FEdit.paint();
DrawItem(CI_UP,CIS_NONE); DrawItem(CI_UP,CIS_NONE);
DrawItem(CI_DOWN,CIS_NONE); DrawItem(CI_DOWN,CIS_NONE);
end end
function FontChanged(o);override;
begin
inherited;
if FEdit then FEdit.Font := Font;
end
published published
property OnIncrease:eventhandler read FOnIncrease write FOnIncrease; property OnIncrease:eventhandler read FOnIncrease write FOnIncrease;
property OnDecrease:eventhandler read FOnDecrease write FOnDecrease; property OnDecrease:eventhandler read FOnDecrease write FOnDecrease;
@ -6272,11 +6514,15 @@ type tcustomgroupbox=class(TCustomControl)
end end
function FontChanged(o);override; function FontChanged(o);override;
begin begin
inherited;
ft := Font; ft := Font;
if ft then
begin
ftwidth := ft.Width; ftwidth := ft.Width;
ftheight := ft.Height; ftheight := ft.Height;
doControlALign(); inherited;
end
//doControlALign();
end end
function GetClientRect();override; function GetClientRect();override;
begin begin
@ -6289,6 +6535,14 @@ type tcustomgroupbox=class(TCustomControl)
if r[3]<r[1] then r[3] := r[1]; if r[3]<r[1] then r[3] := r[1];
return r; return r;
end end
function GetPreferredSize(w,h);override;
begin
inherited;
br := BoundsRect;
cr := ClientRect;
dh := (br[3]-br[1])-(cr[3]-cr[1])-8;
h-=dh;
end
published published
property textPos:AlignStyle9 read FtextPosition write setTextPosition; property textPos:AlignStyle9 read FtextPosition write setTextPosition;
private private
@ -6709,11 +6963,15 @@ type tcustomipaddr = class(TCustomControl)
function FontChanged(sender);override; function FontChanged(sender);override;
begin begin
ft := Font;
if ft then
begin
for i,v in FEditors do v.font := ft;
FFontwidth := ft.Width;
inherited; inherited;
for i,v in FEditors do v.font := font; //calcportsize();
FFontwidth := Font.Width; //InvalidateRect(nil,false);
calcportsize(); end
InvalidateRect(nil,false);
end end
function Paint();override; function Paint();override;
begin begin
@ -6828,7 +7086,14 @@ type tcustomipaddr = class(TCustomControl)
end end
inherited; inherited;
end end
function GetPreferredSize(w,h);override;
begin
ft := Font;
ftw := ft.Width;
fth := ft.Height;
w := 21*ftw+2;
h := fth+5;
end
function Recycling();override; function Recycling();override;
begin begin
FaddrChange := nil; FaddrChange := nil;
@ -6933,7 +7198,7 @@ type tcustomipaddr = class(TCustomControl)
wd+=2; wd+=2;
ewd := integer((wd-FFontwidth*(3+FHasPort)-10)/(4+FHasPort)); ewd := integer((wd-FFontwidth*(3+FHasPort)-10)/(4+FHasPort));
rc1 := rc; rc1 := rc;
rc1[1] := integer(rc1[3]/5); //rc1[1] := integer(rc1[3]/5);
rc1[0]:= (FIpe1.ClientRect)[2];; rc1[0]:= (FIpe1.ClientRect)[2];;
rc1[2] := rc1[0]+FFontwidth; rc1[2] := rc1[0]+FFontwidth;
Fsynrects[0][0] := "."; Fsynrects[0][0] := ".";

17
funcext/tvclib/uvcpropertytypespersistence.tsf
View File

@ -1139,6 +1139,18 @@ type TPropertyBool=class(TPropertyType) //bool
return d?"true":"false"; return d?"true":"false";
end end
end end
type TPropertylazyBool=class(TPropertyBool) //bool
function EditType();override;
begin
return "lazybool";
end
function LazyProperty();override;
begin
return true;
end
end
type TPropertyTypeEvent=class(TPropertyType) //ʼþº¯Êý type TPropertyTypeEvent=class(TPropertyType) //ʼþº¯Êý
function EditType();override; function EditType();override;
begin begin
@ -1819,10 +1831,14 @@ type TPropertyTabAlign=class(UniObjectMember)
type TAlign123=class type TAlign123=class
alTop; alTop;
alBottom; alBottom;
alLeft;
alRight;
function create(); function create();
begin begin
alTop := 1; alTop := 1;
alBottom := 2; alBottom := 2;
alLeft := 3;
alRight := 4;
end end
end end
function EditType();override; function EditType();override;
@ -2447,6 +2463,7 @@ begin
"tpropertyfont", "tpropertyfont",
"tpropertyhotkey", "tpropertyhotkey",
"tpropertybool", "tpropertybool",
"tpropertylazybool",
"tpropertytypeevent", "tpropertytypeevent",
"tpropertytypesyscursor", "tpropertytypesyscursor",
"tpropertyvarible", "tpropertyvarible",

BIN
tsleditor.exe
View File

Binary file not shown.

BIN
tslvcltool.exe
View File

Binary file not shown.