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

4
designer/utslcodeeditor.tsf
View File

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

47
designer/utslvcldcomponents.tsf
View File

@ -1494,6 +1494,15 @@ type TGraphicLabelWindow = class(TDVirutalWindow)
//al := BindComp.TextAlign;
//BindComp.CanvasDrawAlignText(self.canvas,self.ClientRect,self.caption,al);
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;
begin
r := inherited;
@ -1508,7 +1517,7 @@ type TGraphicLabelWindow = class(TDVirutalWindow)
BindComp := new tlabel(self);
width := BindComp.width;
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
function DesigningSizer();override;
begin
@ -1527,6 +1536,10 @@ type TGraphicbevelWindow = class(TDVirutalWindow)
bd.canvas.Handle := canvas.Handle;
bd.paint();
end
function FontChanged(o);override;
begin
if autosize then AdjustSize();
end
function SetPublish(n,v,pp);override;
begin
r := inherited;
@ -3866,6 +3879,36 @@ FCE218FD50E80000000049454E44AE42608200";
inherited;
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);
begin
{**
@ -3881,7 +3924,7 @@ begin
class(TDForm),class(TDPanelForm),
class(TDPanel),class(TDGroupBox),
class(TDPairSplitter),class(TDPairSplitterSide),
class(TDPage),class(TDTabSheet),
class(TDPage),class(TDTabSheet),class(TDtabctl),
class(TDTimer),
class(tdworkerctl),
class(TDImageList),

29
designer/utslvcldpropertytypes.tsf
View File

@ -1960,10 +1960,7 @@ type TGridCellhotkeyEdit = class(TGridPropertyRender,TPropertyHotkey)
end;
end
type TGridCellBoolEdit = class(TGridPropertyRender,TPropertyBool)
{**
@explan(綱츠) boolcell긍서
**}
type tgridCellBoolbaseEdit = class(TGridPropertyRender)
private
FRbuttonWidth;
function DrawButton(dc,srca,v);
@ -1992,7 +1989,8 @@ type TGridCellBoolEdit = class(TGridPropertyRender,TPropertyBool)
rec := grid.getSubItemRect(i,j);
if pt[0]<(rec[2]-FRbuttonWidth) then exit;
if d["class"]="bool" then
dc := d["class"];
if dc="bool" or dc="lazybool" then
begin
grid.CellChanged(i,j,"value",not(d["value"]));
end
@ -2013,8 +2011,24 @@ type TGridCellBoolEdit = class(TGridPropertyRender,TPropertyBool)
end
DrawButton(dc,src,dv);
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
@ -4738,6 +4752,7 @@ function staticinit();
begin
psi := (array(
class(TGridCellBoolEdit),
class(TGridCelllazyBoolEdit),
class(TGridCellColorEdit),
class(TGridCellDirectoryEdit),
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
@param(v) 0,1,2
**}
try //避免win7及一下版本错误
SetProcessDpiAwareness_sub(v);
except
end;
end
{$ifdef linux}
function SetProcessDpiAwareness_sub(v);

97
funcext/tvclib/tcontrol.tsf
View File

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

1
funcext/tvclib/tcustomcontrol.tsf
View File

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

14
funcext/tvclib/tslvcl.tsf
View File

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

69
funcext/tvclib/twincontrol.tsf
View File

@ -849,7 +849,6 @@ type TWinControl = class(tcontrol)
//InvalidateRect(nil,false);
//it.Perform(new tuieventbase(CM_PARENTFONTCHANGED,hd,1,0));
end
end
function CMPARENTFONTCHANGED(o,e):CM_PARENTFONTCHANGED;virtual;
begin
@ -2352,7 +2351,7 @@ type TWinControl = class(tcontrol)
if FClientHeight <> y then
begin
FClientHeight := y;
//cc := true;
cc := true;
end
if true then
begin
@ -2563,6 +2562,68 @@ type TWinControl = class(tcontrol)
end
inherited;
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;
begin
{**
@ -2709,8 +2770,8 @@ type TWinControl = class(tcontrol)
end
published //¶ÔÍâproperty
///////////////////////////////////////////////
property MinWidth:natural read FMinWidth write SetMinWidth;
property MinHeight:natural read FMinHeigt write SetMinHeight;
property MinWidth read FMinWidth write SetMinWidth; //:natural
property MinHeight read FMinHeigt write SetMinHeight; //:natural
//property MaxWidth:integer read FMaxWidth write SetMaxWidth;
//property MaxHeight:integer read FMaXHeight write SetMaxHeight;
property BorderStyle read GetBorderStyle write SetBorderStyle;

4
funcext/tvclib/ugtkinterface.tsf
View File

@ -540,9 +540,9 @@ type tsgtkapi = class(tgtkapis)
PosChanged := flg .& 2;
if SizeChanged then
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");
{if vb and gtk_widget_is_visible(vb) then
if vb and gtk_widget_is_visible(vb) then
begin
d.cx := max(AWidth-10,0);
end

36
funcext/tvclib/utslvclcoolbar.tsf
View File

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

33
funcext/tvclib/utslvclgdi.tsf
View File

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

610
funcext/tvclib/utslvclpage.tsf
View File

@ -19,6 +19,10 @@ type tcustomtabsheet = class(TCustomControl) //
end
end
public
function AdjustSize();override;
begin
class(tcontrol).AdjustSize();
end
function paint();override; //设计器模式下绘制网格
begin
drawdesigninggrid();
@ -39,13 +43,12 @@ type tcustomtabsheet = class(TCustomControl) //
Visible := false;
end
end
type tcustompagecontrol = class(TCustomControl)
type tcustomtabcontrol = class(TCustomControl)
private
fclocker;//锁
FirstViewIndex; //第一个展示的序号
FCurrentid; //当前
FPrevid; //上一个
FTabItems; //
[weakref]FOnSelChanged;
[weakref]FOnSelChanging; //正在改变
//FOnrclick;
@ -57,42 +60,72 @@ type tcustompagecontrol = class(TCustomControl)
fnextrect;
FTabRects;
FClientarea;
private
function gettabsheetitem(idx);
protected
FTabItems; //
function setselidx(id); //选择序号
begin
if idx>=0 and idx<ftabitems.length() then return FTabItems[idx];
if isacceptsheettype(idx) then
if FCurrentid= id then return ;
if fclocker.locked then return ;
lk := new tcountlocker(fclocker);
if id>=0 and id<FTabItems.length() then
begin
for i:= 0 to ftabitems.length()-1 do
if FCurrentid<>-1 and fOnSelChanging then
begin
it := FTabItems[i];
if idx=it.PageSheet then return it;
e := new tuieventbase(0,FCurrentid,id,0); //m,w,l,h
doonSelChanging(self(true),e);
if e.skip then return ;
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 := 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();
FPrevid := FCurrentid;
FCurrentid := id;
InsureIdxVisible(id);
InvalidateRect(nil,false);
end
function GetTabCount();
DoControlAlign();
if FOnSelChanged then
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
function CreateTableItem(cp);
begin
@ -102,9 +135,10 @@ type tcustompagecontrol = class(TCustomControl)
end
function CalcTabs(); //计算区域
begin
rec := ClientRect; //区域
rec := getwndclientrect() ;//ClientRect; //区域
fclosebtnrect := array();
ft := font;
if not ft then return ;
fw := ft.width;
if not fownerdraw then
begin
@ -125,15 +159,6 @@ type tcustompagecontrol = class(TCustomControl)
if e.lparam>=0 then FTabItemswidth[i] := e.lparam;
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);
FClientarea := rec;
FScrollBtnRect := 0;
@ -250,6 +275,23 @@ type tcustompagecontrol = class(TCustomControl)
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); //确保可见
begin
if FScrollBtnRect and (not FTabRects[id]) then
@ -273,35 +315,7 @@ type tcustompagecontrol = class(TCustomControl)
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
begin
lk := new tcountlocker(fclocker);
@ -405,75 +419,46 @@ type tcustompagecontrol = class(TCustomControl)
InvalidateRect(nil,false);
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
function FontChanged(o);override;
begin
inherited;
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
function hittabat(xy); //命中
begin
@ -499,12 +484,6 @@ type tcustompagecontrol = class(TCustomControl)
end
return r;
end
function checknewchild(achild);override;//检查child
begin
r := inherited;
if isacceptsheettype( achild) then achild.Align := alNone;
return r;
end
function getsheetrect(); //获得sheet
begin
{**
@ -521,10 +500,9 @@ type tcustompagecontrol = class(TCustomControl)
function create(aowner);
begin
inherited;
FTabPosition := alTop;
fclosebtn := false;
FTabHeight := font.height+7;
faccepttype := array();
acceptsheettype(class(tcustomtabsheet));
FTabHeight := font.height+8;
end
function AfterConstruction();override;
begin
@ -535,30 +513,13 @@ type tcustompagecontrol = class(TCustomControl)
width := 200;
left := 10;
top := 10;
FTabPosition := alTop;
FirstViewIndex := 0;
FCurrentid := -1;
FPrevid := -1;
FTabItems := new tnumindexarray();
end
function ControlAppended(AControl);override;
Function SetCurSel(id); virtual; //设置当前序号
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
begin
iid := integer(id);
@ -636,58 +597,9 @@ type tcustompagecontrol = class(TCustomControl)
if AIndex<FTabItems.length() and AIndex>0 then return FTabItems[AIndex].Caption;
return r;
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;//调整位置
begin
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
function SetTabText(i,Value);
begin
@ -734,6 +646,239 @@ type tcustompagecontrol = class(TCustomControl)
FOnSelChanging := nil;
FTabItems.splice(0,nil);
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
function acceptsheettype(ty,del);
begin
@ -759,37 +904,15 @@ type tcustompagecontrol = class(TCustomControl)
return true;
end
{**
@param(cursel)(integer) 当前选中序号 %%
@param(activetabsheet)(tcustomtabsheet) 当前选中的页面 %%
@param(tabsheet)(tcustomtabsheet) 通过下标获得页面 %%
@param(TabCount)(integer) page数量 %%
@param(OnSelChange)(function[tcustompagecontrol,tuieventbase]) 标签已经切换 %%
@param(OnSelChanging)(function[tcustompagecontrol,tuieventbase]) 标签正在切换 %%
@param(Onrclcik)(function[tcustompagecontrol,tuieventbase]) 右键点击 %%
**}
published
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 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;
tabs;
faccepttype;
fclosebtn;
fclosebtnrect;
[weakref] fondrawtab;
[weakref] fonmeasuretabwidth;
[weakref] fonclosebtnclick;
private
function isacceptsheettype(c);
begin
@ -798,23 +921,6 @@ type tcustompagecontrol = class(TCustomControl)
if c is v then return true;
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
implementation
type tcustomtabitem = class() //

355
funcext/tvclib/utslvclstdctl.tsf
View File

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

17
funcext/tvclib/uvcpropertytypespersistence.tsf
View File

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

BIN
tsleditor.exe
View File

Binary file not shown.

BIN
tslvcltool.exe
View File

Binary file not shown.