paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-03 02:41:51 +02:00
Code Issues Packages Projects Releases Wiki Activity

translations: german: added lazreport maincalleditor.de.po from Joerg Braun

Browse Source 
git-svn-id: trunk@12128 -
This commit is contained in:
mattias 2007-09-22 10:06:48 +00:00
parent dd07f217c6
commit b647927885
53 changed files with 916 additions and 170 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -340,6 +340,7 @@ components/lazreport/samples/barcode/reports/codigobarras.lrf svneol=native#text
components/lazreport/samples/editor/calleditorwithpkg.lpi svneol=native#text/plain
components/lazreport/samples/editor/calleditorwithpkg.lpr svneol=native#text/pascal
components/lazreport/samples/editor/db/disco.dbf -text
components/lazreport/samples/editor/languages/maincalleditor.de.po svneol=native#text/plain
components/lazreport/samples/editor/languages/maincalleditor.es.po svneol=native#text/plain
components/lazreport/samples/editor/languages/maincalleditor.po svneol=native#text/plain
components/lazreport/samples/editor/languages/maincalleditor.ru.po svneol=native#text/plain

43
components/lazreport/samples/editor/languages/maincalleditor.de.po Normal file
View File

@ -0,0 +1,43 @@
msgid ""
msgstr ""
"MIME-Version: 1.0\n"
"Content-Type: text/plain; charset=UTF-8\n"
"Content-Transfer-Encoding: 8bit\n"
"Project-Id-Version: \n"
"POT-Creation-Date: \n"
"PO-Revision-Date: 2007-09-19 12:57+0100\n"
"Last-Translator: Joerg Braun <jb@toolbox-mag.de>\n"
"Language-Team: \n"
#: maincalleditor:cereditreport
msgid "Edit Report"
msgstr "Report bearbeiten"
#: maincalleditor:cernewreport
msgid "New report"
msgstr "Neuer Report"
#: maincalleditor:ceropenreport
msgid "Open report"
msgstr "Report öffnen"
#: maincalleditor:cerpreparefailed
msgid "PrepareReport Failed!"
msgstr "PrepareReport fehlgeschlagen!"
#: maincalleditor:cerpreviewreport
msgid "Preview report"
msgstr "Report-Vorschau"
#: maincalleditor:cerprintgrid
msgid "Print grid"
msgstr "Gitter drucken"
#: maincalleditor:cerprintreport
msgid "Print report"
msgstr "Report drucken"
#: maincalleditor:cernotimplemented
msgid "This feature is not yet implemented!"
msgstr "Diese Funktion ist noch nicht implementiert!"

11
lcl/arrow.pp
View File

@ -41,6 +41,8 @@ Type
TArrowType = (atUp, atDown, atLeft, atRight);
TShadowType = (stNone, stIn, stOut, stEtchedIn, stEtchedOut);
{ TArrow }
TArrow = class(TCustomControl)
private
FArrowType : TArrowType;
@ -52,6 +54,7 @@ Type
procedure SetProps;
protected
procedure Paint; override;
class function GetControlClassDefaultSize: TPoint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@ -97,7 +100,7 @@ begin
fCompStyle := csArrow;
fArrowType := atLeft;
fShadowType := stEtchedIn;
SetInitialBounds(0,0,10,10);
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
end;
destructor TArrow.Destroy;
@ -117,6 +120,12 @@ begin
inherited Paint;
end;
class function TArrow.GetControlClassDefaultSize: TPoint;
begin
Result.X:=10;
Result.Y:=10;
end;
procedure TArrow.InitializeWnd;
begin
inherited InitializeWnd;

2
lcl/buttons.pp
View File

@ -122,6 +122,7 @@ type
procedure InitializeWnd; override;
procedure TextChanged; override;
function IsBorderSpacingInnerBorderStored: Boolean; override;
class function GetControlClassDefaultSize: TPoint; override;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; Override;
@ -254,6 +255,7 @@ type
property MouseInControl: Boolean read FMouseInControl;
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
function GetActionLinkClass: TControlActionLinkClass; override;
class function GetControlClassDefaultSize: TPoint; override;
procedure Loaded; override;
protected
function GetGlyphSize(PaintRect: TRect): TSize; virtual;

9
lcl/calendar.pp
View File

@ -77,6 +77,7 @@ Type
procedure LMMonthChanged(var Message: TLMessage); message LM_MONTHCHANGED;
procedure LMYearChanged(var Message: TLMessage); message LM_YEARCHANGED;
procedure LMDayChanged(var Message: TLMessage); message LM_DAYCHANGED;
class function GetControlClassDefaultSize: TPoint; override;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
@ -147,7 +148,7 @@ constructor TCustomCalendar.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
fCompStyle := csCalendar;
SetInitialBounds(0,0,190,153);
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
fDisplaySettings := [dsShowHeadings, dsShowDayNames];
ControlStyle:=ControlStyle-[csTripleClicks,csQuadClicks,csAcceptsControls];
Date := FormatDateTime(ShortDateFormat,Now);
@ -307,6 +308,12 @@ begin
if Assigned(OnChange) then OnChange(self);
end;
class function TCustomCalendar.GetControlClassDefaultSize: TPoint;
begin
Result.X:=190;
Result.Y:=153;
end;
procedure TCustomCalendar.LMMonthChanged(var Message: TLMessage);
begin
if Assigned(OnMonthChanged) then OnMonthChanged(self);

9
lcl/chart.pp
View File

@ -79,6 +79,7 @@ type
procedure SetLabelPosition(const AValue: TPosLabel);
protected
procedure Paint; override;
class function GetControlClassDefaultSize: TPoint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@ -157,7 +158,7 @@ begin
FBars:=TBarChartItems.Create(Self);
FDepth:=5;
FLabelPosition:=plLeft;
SetInitialBounds(0,0,150,120);
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
end;
destructor TCustomBarChart.Destroy;
@ -366,6 +367,12 @@ begin
Canvas.Pen.Style:=psSolid;
end;
class function TCustomBarChart.GetControlClassDefaultSize: TPoint;
begin
Result.X:=150;
Result.Y:=120;
end;
procedure TCustomBarChart.Clear;
begin
FBars.Clear;

7
lcl/comctrls.pp
View File

@ -445,6 +445,7 @@ type
procedure UpdateTabImages;
procedure ImageListChange(Sender: TObject);
procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); override;
class function GetControlClassDefaultSize: TPoint; override;
procedure Paint; override;
function GetDisplayRectWithBorder: TRect; virtual;
procedure AdjustClientRect(var ARect: TRect); override;
@ -1116,6 +1117,7 @@ type
procedure ApplyChanges;
procedure InitializeWnd; override;
procedure Loaded; override;
class function GetControlClassDefaultSize: TPoint; override;
public
constructor Create(AOwner: TComponent); override;
procedure StepIt;
@ -1217,6 +1219,7 @@ type
Procedure AssociateKeyDown(Sender: TObject; var Key: Word; ShiftState : TShiftState);
procedure OnAssociateChangeBounds(Sender: TObject);
procedure DoOnResize; override;
class function GetControlClassDefaultSize: TPoint; override;
function CanChange: Boolean; dynamic;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure Click(Button: TUDBtnType); dynamic; overload;
@ -1359,6 +1362,7 @@ type
procedure CalculatePreferredSize(
var PreferredWidth, PreferredHeight: integer;
WithThemeSpace: Boolean); override;
class function GetControlClassDefaultSize: TPoint; override;
procedure Loaded; override;
procedure RefreshControl; virtual;
procedure SetToolBar(NewToolBar: TToolBar);
@ -1475,6 +1479,7 @@ type
procedure RemoveButton(Button: TToolButton);
protected
procedure AdjustClientRect(var ARect: TRect); override;
class function GetControlClassDefaultSize: TPoint; override;
function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
function CheckMenuDropdown(Button: TToolButton): Boolean; dynamic;
procedure ClickButton(Button: TToolButton); dynamic;
@ -1598,6 +1603,7 @@ type
protected
procedure ApplyChanges;
procedure DoChange(var msg); message LM_CHANGED;
class function GetControlClassDefaultSize: TPoint; override;
procedure InitializeWnd; override;
procedure Loaded; override;
public
@ -2574,6 +2580,7 @@ type
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure UpdateState;
class function GetControlClassDefaultSize: TPoint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;

12
lcl/controls.pp
View File

@ -760,7 +760,9 @@ type
cfClientHeightLoaded,
cfLastAlignedBoundsValid,
cfBoundsRectForNewParentValid,
cfBaseBoundsValid,
cfPreferredSizeValid,
cfPreferredMinSizeValid,
cfOnResizeNeeded,
cfOnChangeBoundsNeeded
);
@ -863,6 +865,8 @@ type
FParentFont: Boolean;
FParentShowHint: Boolean;
FPopupMenu: TPopupMenu;
FPreferredMinWidth: integer;// without theme space
FPreferredMinHeight: integer;// without theme space
FPreferredWidth: integer;// with theme space
FPreferredHeight: integer;// with theme space
FReadBounds: TRect;
@ -1172,6 +1176,10 @@ type
procedure GetPreferredSize(var PreferredWidth, PreferredHeight: integer;
Raw: boolean = false;
WithThemeSpace: boolean = true); virtual;
function GetDefaultWidth: integer;
function GetDefaultHeight: integer;
class function GetControlClassDefaultSize: TPoint; virtual;
function GetSidePosition(Side: TAnchorKind): integer;
procedure CNPreferredSizeChanged;
procedure InvalidatePreferredSize; virtual;
function GetAnchorsDependingOnParent(WithNormalAnchors: Boolean): TAnchors;
@ -1574,6 +1582,8 @@ type
protected
FWinControlFlags: TWinControlFlags;
procedure AdjustClientRect(var ARect: TRect); virtual;
procedure CreateControlAlignList(TheAlign: TAlign;
AlignList: TFPList; StartControl: TControl);
procedure AlignControls(AControl: TControl;
var RemainingClientRect: TRect); virtual;
function DoAlignChildControls(TheAlign: TAlign; AControl: TControl;
@ -1597,7 +1607,7 @@ type
PreferredHeight: integer;
WithThemeSpace: Boolean); override;
procedure GetChildBounds(var ChildBounds: TRect; WithBorderSpace,
FixateParentAnchors: boolean); virtual;
UsePreferredSizes: boolean); virtual;
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
function ChildClassAllowed(ChildClass: TClass): boolean; override;
procedure PaintControls(DC: HDC; First: TControl);

1
lcl/dbctrls.pp
View File

@ -870,6 +870,7 @@ type
procedure HintsChanged(Sender: TObject); virtual;
procedure ButtonClickHandler(Sender: TObject); virtual;
procedure DoOnResize; override;
class function GetControlClassDefaultSize: TPoint; override;
procedure BeginUpdateButtons; virtual;
procedure EndUpdateButtons; virtual;
public

1
lcl/dialogs.pp
View File

@ -253,6 +253,7 @@ type
function GetGlyphSize(PaintRect: TRect): TSize; override;
function DrawGlyph(ACanvas: TCanvas; const AClient: TRect; const AOffset: TPoint;
AState: TButtonState; ATransparent: Boolean; BiDiFlags: Longint): TRect; override;
class function GetControlClassDefaultSize: TPoint; override;
public
constructor Create(AnOwner: TComponent); override;
destructor Destroy; Override;

6
lcl/extctrls.pp
View File

@ -188,6 +188,7 @@ type
procedure ShowControl(APage: TControl); override;
procedure UpdateTabProperties; virtual;
function ChildClassAllowed(ChildClass: TClass): boolean; override;
class function GetControlClassDefaultSize: TPoint; override;
property ActivePageComponent: TCustomPage read GetActivePageComponent
write SetActivePageComponent;
property ActivePage: String read GetActivePage write SetActivePage
@ -356,6 +357,8 @@ type
procedure SetBrush(Value: TBrush);
procedure SetPen(Value: TPen);
procedure SetShape(Value: TShapeType);
protected
class function GetControlClassDefaultSize: TPoint; override;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
@ -494,6 +497,7 @@ type
TPaintBox = class(TGraphicControl)
protected
procedure Paint; override;
class function GetControlClassDefaultSize: TPoint; override;
public
constructor Create(AOwner: TComponent); override;
property Canvas;
@ -556,6 +560,7 @@ type
procedure CalculatePreferredSize(var PreferredWidth,
PreferredHeight: integer;
WithThemeSpace: Boolean); override;
class function GetControlClassDefaultSize: TPoint; override;
procedure DoAutoSize; override;
procedure Paint; override;
public
@ -994,6 +999,7 @@ type
procedure SetBorderWidth(const Value: TBorderWidth);
protected
procedure AdjustClientRect(var Rect: TRect); override;
class function GetControlClassDefaultSize: TPoint; override;
procedure CMParentColorChanged(var Message: TLMessage); message CM_PARENTCOLORCHANGED;
procedure Loaded; override;
procedure RealSetText(const Value: TCaption); override;

9
lcl/extdlgs.pas
View File

@ -43,6 +43,7 @@ type
protected
procedure SetPreviewFileDialog(const AValue: TPreviewFileDialog);
procedure CreateParams(var Params: TCreateParams); override;
class function GetControlClassDefaultSize: TPoint; override;
public
constructor Create(TheOwner: TComponent); override;
property PreviewFileDialog: TPreviewFileDialog read FPreviewFileDialog
@ -255,11 +256,17 @@ begin
Params.Style := Params.Style and DWORD(not WS_CHILD);
end;
class function TPreviewFileControl.GetControlClassDefaultSize: TPoint;
begin
Result.X:=200;
Result.Y:=200;
end;
constructor TPreviewFileControl.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
FCompStyle:=csPreviewFileControl;
SetInitialBounds(0,0,200,200);
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
end;
{ TPreviewFileDialog }

4
lcl/forms.pp
View File

@ -154,6 +154,7 @@ type
procedure CreateWnd; override;
function GetClientScrollOffset: TPoint; override;
procedure DoOnResize; override;
class function GetControlClassDefaultSize: TPoint; override;
procedure WMHScroll(var Message : TLMHScroll); message LM_HScroll;
procedure WMVScroll(var Message : TLMVScroll); message LM_VScroll;
procedure ScrollBy(DeltaX, DeltaY: Integer);
@ -247,6 +248,7 @@ type
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure SetParent(AParent: TWinControl); override;
class function GetControlClassDefaultSize: TPoint; override;
public
constructor Create(AOwner: TComponent); override;
end;
@ -461,6 +463,7 @@ type
function VisibleIsStored: boolean;
function ColorIsStored: boolean; override;
procedure DoSendBoundsToInterface; override;
class function GetControlClassDefaultSize: TPoint; override;
protected
// drag and dock
procedure DoDock(NewDockSite: TWinControl; var ARect: TRect); override;
@ -680,6 +683,7 @@ type
procedure SetHideInterval(Value : Integer);
protected
procedure Paint; override;
class function GetControlClassDefaultSize: TPoint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;

7
lcl/include/bitbtn.inc
View File

@ -30,7 +30,6 @@ begin
FButtonGlyph.OnChange := @GlyphChanged;
Align := alNone;
BorderSpacing.InnerBorder:=4;
SetInitialBounds(0,0,75,30);
RealizeKind;
end;
@ -263,4 +262,10 @@ begin
Result:=BorderSpacing.InnerBorder<>4;
end;
class function TCustomBitBtn.GetControlClassDefaultSize: TPoint;
begin
Result.X:=75;
Result.Y:=30;
end;
// included by buttons.pp

8
lcl/include/buttons.inc
View File

@ -36,7 +36,7 @@ begin
Align := alNone;
BorderSpacing.InnerBorder:=4;
// setup default sizes
SetInitialBounds(0,0,75,25);
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
end;
{------------------------------------------------------------------------------
@ -289,6 +289,12 @@ begin
Result:=BorderSpacing.InnerBorder<>2;
end;
class function TCustomButton.GetControlClassDefaultSize: TPoint;
begin
Result.X:=75;
Result.Y:=25;
end;
function TCustomButton.UseRightToLeftAlignment: Boolean;
begin
//Button always has center alignment

8
lcl/include/colorbutton.inc
View File

@ -26,7 +26,7 @@ begin
FButtonColorSize := 16;
FBorderWidth := 2;
FButtonColorAutoSize := True;
SetInitialBounds(1, 1, 75, 25);
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
end;
destructor TColorButton.Destroy;
@ -129,6 +129,12 @@ begin
Canvas.Rectangle(Result);
end;
class function TColorButton.GetControlClassDefaultSize: TPoint;
begin
Result.X:=75;
Result.Y:=25;
end;
procedure TColorButton.SetButtonColorSize(const AValue: Integer);
begin
if FButtonColorSize = AValue then Exit;

99
lcl/include/control.inc
View File

@ -2812,6 +2812,7 @@ begin
' NewClientSize='+dbgs(NewBaseParentClientSize)+
'');}
FBaseBounds:=NewBaseBounds;
Include(FControlFlags,cfBaseBoundsValid);
FBaseParentClientSize:=NewBaseParentClientSize;
fLastAlignedBounds:=Rect(0,0,0,0);
end;
@ -4008,7 +4009,7 @@ end;
instead.
Raw: If not Raw then the values will be adjusted by the constraints and
undefined values will be replaced by the current width and height.
undefined values will be replaced by GetDefaultWidth/GetDefaultHeight.
WithThemeSpace: If true, adds space for stacking. For example: TRadioButton
has a minimum size. But for stacking multiple TRadioButtons there should be
@ -4021,17 +4022,31 @@ end;
procedure TControl.GetPreferredSize(var PreferredWidth,
PreferredHeight: integer; Raw: boolean; WithThemeSpace: boolean);
begin
if not (cfPreferredSizeValid in FControlFlags) then begin
CalculatePreferredSize(FPreferredWidth,FPreferredHeight,WithThemeSpace);
Include(FControlFlags,cfPreferredSizeValid);
if WithThemeSpace then begin
if not (cfPreferredSizeValid in FControlFlags) then begin
CalculatePreferredSize(FPreferredWidth,FPreferredHeight,true);
Include(FControlFlags,cfPreferredSizeValid);
end;
PreferredWidth:=FPreferredWidth;
PreferredHeight:=FPreferredHeight;
end else begin
if not (cfPreferredMinSizeValid in FControlFlags) then begin
CalculatePreferredSize(FPreferredMinWidth,FPreferredMinHeight,false);
Include(FControlFlags,cfPreferredMinSizeValid);
end;
PreferredWidth:=FPreferredMinWidth;
PreferredHeight:=FPreferredMinHeight;
end;
PreferredWidth:=FPreferredWidth;
PreferredHeight:=FPreferredHeight;
if not Raw then begin
// use Width and Height for undefined preferred size
if PreferredWidth<=0 then PreferredWidth:=Width;
if PreferredHeight<=0 then PreferredHeight:=Height;
// use defaults for undefined preferred size
if AutoSize then begin
if PreferredWidth<=0 then PreferredWidth:=GetDefaultWidth;
if PreferredHeight<=0 then PreferredHeight:=GetDefaultHeight;
end else begin
if PreferredWidth<=0 then PreferredWidth:=Width;
if PreferredHeight<=0 then PreferredHeight:=Height;
end;
// if this control is aligned adjust PreferredWidth and/or PreferredHeight
if Parent<>nil then begin
@ -4055,6 +4070,71 @@ begin
end;
end;
{------------------------------------------------------------------------------
function TControl.GetDefaultWidth: integer;
The default width for this control independent of any calculated values
like Width and GetPreferredSize.
------------------------------------------------------------------------------}
function TControl.GetDefaultWidth: integer;
begin
if cfBaseBoundsValid in FControlFlags then
Result:=FBaseBounds.Right-FBaseBounds.Left
else if cfWidthLoaded in FControlFlags then
Result:=FReadBounds.Right-FReadBounds.Left
else
Result:=GetControlClassDefaultSize.X;
end;
{------------------------------------------------------------------------------
function TControl.GetDefaultHeight: integer;
The default height for this control independent of any calculated values
like Height and GetPreferredSize.
------------------------------------------------------------------------------}
function TControl.GetDefaultHeight: integer;
begin
if cfBaseBoundsValid in FControlFlags then
Result:=BaseBounds.Bottom-BaseBounds.Top
else if cfHeightLoaded in FControlFlags then
Result:=FReadBounds.Bottom-FReadBounds.Top
else
Result:=GetControlClassDefaultSize.Y;
end;
{------------------------------------------------------------------------------
class function TControl.GetControlClassDefaultSize: TPoint;
The default size of this type of controls.
Used by GetDefaultWidth and GetDefaultHeight.
------------------------------------------------------------------------------}
class function TControl.GetControlClassDefaultSize: TPoint;
begin
Result.X:=75;
Result.Y:=50;
end;
{------------------------------------------------------------------------------
procedure TControl.CNPreferredSizeChanged;
Utility function to retrieve Left,Top,Right and Bottom.
------------------------------------------------------------------------------}
function TControl.GetSidePosition(Side: TAnchorKind): integer;
begin
case Side of
akLeft: Result:=Left;
akTop: Result:=Top;
akRight: Result:=Left+Width;
akBottom: Result:=Top+Bottom;
end;
end;
{------------------------------------------------------------------------------
procedure TControl.CNPreferredSizeChanged;
Called by the LCL interface, when something changed that effects the result
of the interface values for GetPreferredSize.
------------------------------------------------------------------------------}
procedure TControl.CNPreferredSizeChanged;
begin
InvalidatePreferredSize;
@ -4072,6 +4152,7 @@ begin
AControl:=Self;
while AControl<>nil do begin
Exclude(AControl.FControlFlags,cfPreferredSizeValid);
Exclude(AControl.FControlFlags,cfPreferredMinSizeValid);
AControl:=AControl.Parent;
end;
end;

8
lcl/include/customcheckbox.inc
View File

@ -89,7 +89,7 @@ begin
FState := cbUnchecked;
FAllowGrayed := false;
TabStop := true;
SetInitialBounds(0,0,90,23);
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
AutoSize:=true;
end;
@ -174,6 +174,12 @@ begin
end;
end;
class function TCustomCheckBox.GetControlClassDefaultSize: TPoint;
begin
Result.X:=90;
Result.Y:=23;
end;
procedure TCustomCheckBox.Loaded;
begin
// Send first the FState to the interface before calling inherited,

1
lcl/include/customcheckgroup.inc
View File

@ -41,7 +41,6 @@ begin
ChildSizing.EnlargeVertical:=crsHomogenousChildResize;
ChildSizing.LeftRightSpacing:=6;
ChildSizing.TopBottomSpacing:=6;
SetInitialBounds(0,0,150,100);
end;
destructor TCustomCheckGroup.Destroy;

8
lcl/include/customcombobox.inc
View File

@ -103,6 +103,12 @@ begin
end;
end;
class function TCustomComboBox.GetControlClassDefaultSize: TPoint;
begin
Result.X:=100;
Result.Y:=25;
end;
procedure TCustomComboBox.DoEnter;
begin
inherited DoEnter;
@ -709,7 +715,7 @@ begin
inherited Create(TheOwner);
fCompStyle := csComboBox;
SetInitialBounds(0,0,100,25);
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
FItems := TStringlist.Create;
FItemIndex:=-1;
FMaxLength := -1;

8
lcl/include/customedit.inc
View File

@ -52,7 +52,7 @@ begin
FMaxLength:= -1;
ParentColor := false;
TabStop := true;
SetInitialBounds(0,0,80,23);
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
FEchoMode := emNormal;
BorderStyle := bsSingle;
FAutoSelect := False;
@ -347,6 +347,12 @@ begin
Result:=false;
end;
class function TCustomEdit.GetControlClassDefaultSize: TPoint;
begin
Result.X:=80;
Result.Y:=23;
end;
procedure TCustomEdit.KeyUp(var Key: Word; Shift: TShiftState);
begin
inherited KeyUp(Key, Shift);

8
lcl/include/customform.inc
View File

@ -969,6 +969,12 @@ begin
end;
end;
class function TCustomForm.GetControlClassDefaultSize: TPoint;
begin
Result.X:=320;
Result.Y:=240;
end;
procedure TCustomForm.DoDock(NewDockSite: TWinControl; var ARect: TRect);
begin
if (NewDockSite<>HostDockSite) then begin
@ -1377,7 +1383,7 @@ begin
ControlStyle := ControlStyle + [csAcceptsControls, csCaptureMouse,
csClickEvents, csSetCaption, csDoubleClicks];
SetInitialBounds(0,0,320,240);
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
ParentColor := False;
ParentFont := False;
Ctl3D := True;

8
lcl/include/customframe.inc
View File

@ -83,6 +83,12 @@ begin
if Parent<>nil then UpdateActionLists(opInsert);
end;
class function TCustomFrame.GetControlClassDefaultSize: TPoint;
begin
Result.X:=320;
Result.Y:=240;
end;
constructor TCustomFrame.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
@ -92,7 +98,7 @@ begin
if not InitInheritedComponent(Self,TFrame) then
raise EResNotFound.CreateFmt(rsResourceNotFound, [ClassName]);
end else begin
SetInitialBounds(0,0,320,240);
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
end;
end;

15
lcl/include/customgroupbox.inc
View File

@ -14,16 +14,21 @@
*****************************************************************************
}
{------------------------------------------------------------------------------}
{ function TCustomGroupBox.Create }
{------------------------------------------------------------------------------}
class function TCustomGroupBox.GetControlClassDefaultSize: TPoint;
begin
Result.X:=185;
Result.Y:=105;
end;
{------------------------------------------------------------------------------
function TCustomGroupBox.Create
------------------------------------------------------------------------------}
constructor TCustomGroupBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
fCompStyle := csGroupBox;
ControlStyle := ControlStyle + [csAcceptsControls];
Width:= 185;
Height:= 105;
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
end;
// included by stdctrls.pp

10
lcl/include/customimage.inc
View File

@ -28,7 +28,7 @@ begin
FPicture := TPicture.Create;
FPicture.OnChange := @PictureChanged;
FUseParentCanvas := false;
SetInitialBounds(0,0,100,100);
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
end;
destructor TCustomImage.Destroy;
@ -91,7 +91,6 @@ var
end;
begin
if not AutoSize then Exit; // needless to check
if AutoSizing then Exit; // we shouldn't come here in the first place
BeginAutoSizing;
@ -109,7 +108,6 @@ begin
if (NewWidth<>Width) or (NewHeight<>Height)
then begin
SetBounds(Left, Top, NewWidth, NewHeight);
// PictureChanged(Self);
end;
finally
EndAutoSizing;
@ -198,6 +196,12 @@ begin
PreferredHeight := Picture.Height;
end;
class function TCustomImage.GetControlClassDefaultSize: TPoint;
begin
Result.X:=90;
Result.Y:=90;
end;
procedure TCustomImage.Paint;
procedure DrawFrame;

8
lcl/include/customlabel.inc
View File

@ -62,6 +62,12 @@ begin
AdjustSize;
end;
class function TCustomLabel.GetControlClassDefaultSize: TPoint;
begin
Result.X:=65;
Result.Y:=17;
end;
function TCustomLabel.HasMultiLine: boolean;
var
s: String;
@ -196,7 +202,7 @@ constructor TCustomLabel.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
ControlStyle := [csSetCaption, csClickEvents, csDoubleClicks, csReplicatable];
setInitialBounds(0,0,65,17);
setInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
FShowAccelChar := True;
Color := clNone;
AutoSize:=true;

1
lcl/include/customlabelededit.inc
View File

@ -105,7 +105,6 @@ begin
FLabelPosition := lpAbove;
FLabelSpacing := 3;
CreateInternalLabel;
SetInitialBounds(0,0,80,25);
end;
procedure TCustomLabeledEdit.CreateInternalLabel;

26
lcl/include/customlistbox.inc
View File

@ -135,9 +135,15 @@ begin
UnlockSelectionChange;
end;
{------------------------------------------------------------------------------}
{ procedure TCustomListBox.UpdateSelectionMode }
{------------------------------------------------------------------------------}
class function TCustomListBox.GetControlClassDefaultSize: TPoint;
begin
Result.X:=100;
Result.Y:=80;
end;
{------------------------------------------------------------------------------
procedure TCustomListBox.UpdateSelectionMode
------------------------------------------------------------------------------}
procedure TCustomListBox.UpdateSelectionMode;
begin
if not HandleAllocated then exit;
@ -461,9 +467,9 @@ begin
end;
end;
{------------------------------------------------------------------------------}
{ function TCustomListBox.Create }
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------
function TCustomListBox.Create
------------------------------------------------------------------------------}
constructor TCustomListBox.Create(TheOwner : TComponent);
begin
inherited Create(TheOwner);
@ -479,13 +485,13 @@ begin
TControlCanvas(FCanvas).Control := Self;
ParentColor := false;
TabStop := true;
SetInitialBounds(0, 0, 100, 80);
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
UnlockSelectionChange;
end;
{------------------------------------------------------------------------------}
{ function TCustomListBox.Destroy }
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------
function TCustomListBox.Destroy
------------------------------------------------------------------------------}
destructor TCustomListBox.Destroy;
begin
Destroying;

8
lcl/include/customlistview.inc
View File

@ -37,7 +37,7 @@ begin
end;
FHoverTime := -1;
TabStop := true;
SetInitialBounds(0,0,100,90);
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
ParentColor := False;
Color := clWindow;
FCanvas := TControlCanvas.Create;
@ -45,9 +45,9 @@ begin
FProperties := [lvpColumnClick, lvpHideSelection, lvpShowColumnHeaders, lvpToolTips];
end;
{------------------------------------------------------------------------------}
{ TCustomListView CustomDraw }
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------
TCustomListView CustomDraw
------------------------------------------------------------------------------}
function TCustomListView.CustomDraw(const ARect: TRect; AStage: TCustomDrawStage): Boolean;
begin
Result := True;

7
lcl/include/custommemo.inc
View File

@ -38,7 +38,6 @@ begin
//TMemoStrings(FLines).MemoWidgetClass := TWSCustomMemoClass(WidgetSetClass);
FVertScrollbar := TMemoScrollBar.Create(Self, sbVertical);
FHorzScrollbar := TMemoScrollBar.Create(Self, sbHorizontal);
SetInitialBounds(0,0,150,90);
end;
{------------------------------------------------------------------------------
@ -248,6 +247,12 @@ begin
end;
end;
class function TCustomMemo.GetControlClassDefaultSize: TPoint;
begin
Result.X:=150;
Result.Y:=90;
end;
procedure TCustomMemo.SetWantTabs(const NewWantTabs: boolean);
begin
if FWantTabs = NewWantTabs then exit;

8
lcl/include/customnotebook.inc
View File

@ -212,7 +212,7 @@ begin
TabPosition := tpTop;
TabStop := true;
ShowTabs := True;
SetInitialBounds(0,0,200,200);
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
end;
{------------------------------------------------------------------------------
@ -718,6 +718,12 @@ begin
Result:=(ChildClass<>nil) and (ChildClass.InheritsFrom(PageClass));
end;
class function TCustomNotebook.GetControlClassDefaultSize: TPoint;
begin
Result.X:=200;
Result.Y:=200;
end;
{------------------------------------------------------------------------------
TCustomNotebook Change
------------------------------------------------------------------------------}

8
lcl/include/custompanel.inc
View File

@ -41,7 +41,7 @@ begin
FAlignment := taCenter;
FFullRepaint := true;
Color:=clBtnFace;// clBackground;
SetInitialBounds(0,0,170,50);
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
ParentColor := True;
end;
@ -138,6 +138,12 @@ begin
InflateRect(Rect, -BevelSize, -BevelSize);
end;
class function TCustomPanel.GetControlClassDefaultSize: TPoint;
begin
Result.X:=170;
Result.Y:=50;
end;
procedure TCustomPanel.Loaded;
begin
inherited Loaded;

8
lcl/include/customstatictext.inc
View File

@ -33,7 +33,7 @@ begin
FShowAccelChar:= true;
FStaticBorderStyle:=sbsNone;
ControlStyle := ControlStyle + [csOpaque, csReplicatable];
SetInitialBounds(0, 0, 65, 17);
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
end;
{------------------------------------------------------------------------------
@ -123,6 +123,12 @@ begin
Result := inherited;
end;
class function TCustomStaticText.GetControlClassDefaultSize: TPoint;
begin
Result.X:=65;
Result.Y:=17;
end;
Procedure TCustomStaticText.SetStaticBorderStyle(Value : TStaticBorderStyle);
procedure RaiseNotImplemented;

8
lcl/include/customupdown.inc
View File

@ -209,7 +209,7 @@ begin
FOrientation := udVertical;
MinBtn := TUpDownButton.CreateWithParams(Self, btPrev);
MaxBtn := TUpDownButton.CreateWithParams(Self, btNext);
SetInitialBounds(0,0,17,31);
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
BTimerProc := nil;
BTimerBounds := Rect(0,0,0,0);
FArrowKeys := True;
@ -392,6 +392,12 @@ begin
UpdateOrientation;
end;
class function TCustomUpDown.GetControlClassDefaultSize: TPoint;
begin
Result.X:=17;
Result.Y:=31;
end;
procedure TCustomUpDown.Notification(AComponent: TComponent;
Operation: TOperation);
begin

10
lcl/include/dbcustomnavigator.inc
View File

@ -1,4 +1,4 @@
{%MainUnit ../dbctrls.pas}
{%MainUnit ../dbctrls.pp}
{
*****************************************************************************
* *
@ -336,6 +336,12 @@ begin
UpdateButtons;
end;
class function TDBCustomNavigator.GetControlClassDefaultSize: TPoint;
begin
Result.X:=241;
Result.Y:=25;
end;
procedure TDBCustomNavigator.BeginUpdateButtons;
begin
inc(FUpdateButtonsLock);
@ -367,7 +373,7 @@ begin
BevelOuter:=bvNone;
BevelInner:=bvNone;
FConfirmDelete:=True;
SetInitialBounds(0,0,241,25);
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
UpdateButtons;
EndUpdateButtons;
UpdateHints;

8
lcl/include/headercontrol.inc
View File

@ -67,7 +67,7 @@ begin
FSections := CreateSections;
ControlStyle := ControlStyle + [csCaptureMouse, csClickEvents, csNoFocus, csOpaque] -
[csSetCaption];
SetInitialBounds(0, 0, 170, 30);
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
end;
destructor TCustomHeaderControl.Destroy;
@ -193,6 +193,12 @@ begin
Sections[i].State := MaxState;
end;
class function TCustomHeaderControl.GetControlClassDefaultSize: TPoint;
begin
Result.X:=170;
Result.Y:=30;
end;
procedure TCustomHeaderControl.Paint;
var
Details: TThemedElementDetails;

8
lcl/include/hintwindow.inc
View File

@ -36,7 +36,7 @@ begin
Canvas.Font := Screen.HintFont;
BorderStyle := bsNone;
Caption := 'THintWindow';
SetInitialBounds(1,1,25,25);
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
FHideInterval := 3000;
TheTimer := TCustomTimer.Create(self);
FAutoHideTimer := TheTimer;
@ -91,6 +91,12 @@ begin
DT_NOPREFIX or DT_CENTER or DT_VCENTER or DT_WORDBREAK);
end;
class function THintWindow.GetControlClassDefaultSize: TPoint;
begin
Result.X:=25;
Result.Y:=25;
end;
procedure THintWindow.ActivateHint(ARect: TRect; const AHint: String);
begin
ActivateHintData(ARect, AHint, nil);

8
lcl/include/paintbox.inc
View File

@ -20,7 +20,7 @@ constructor TPaintBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csReplicatable];
SetInitialBounds(0,0,105,105);
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
end;
procedure TPaintBox.Paint;
@ -45,4 +45,10 @@ begin
end;
end;
class function TPaintBox.GetControlClassDefaultSize: TPoint;
begin
Result.X:=105;
Result.Y:=105;
end;
// included by extctrls.pp

12
lcl/include/progressbar.inc
View File

@ -46,13 +46,13 @@ begin
fCompStyle := csProgressBar;
FPosition := 0;
FStep := 10;
FMin := 0;
FMax := 100;
FMin := 0;
FMax := 100;
FSmooth := false;
FOrientation := pbHorizontal;
FBarShowText := false;
FBarTextFormat := '%v from [%l-%u] (=%p%%)';
SetInitialBounds(0,0,100,20);
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
end;
{------------------------------------------------------------------------------
@ -75,6 +75,12 @@ begin
ApplyChanges;
end;
class function TCustomProgressBar.GetControlClassDefaultSize: TPoint;
begin
Result.X:=100;
Result.Y:=20;
end;
{------------------------------------------------------------------------------
Method: TCustomProgressBar.GetMin
Params: Nothing

1
lcl/include/radiogroup.inc
View File

@ -51,7 +51,6 @@ begin
ChildSizing.EnlargeVertical:=crsHomogenousChildResize;
ChildSizing.LeftRightSpacing:=6;
ChildSizing.TopBottomSpacing:=6;
SetInitialBounds(0,0,150,100);
TabStop := True;
end;

8
lcl/include/scrollingwincontrol.inc
View File

@ -62,6 +62,12 @@ begin
UpdateScrollBars;
end;
class function TScrollingWinControl.GetControlClassDefaultSize: TPoint;
begin
Result.X:=150;
Result.Y:=150;
end;
procedure TScrollingWinControl.SetHorzScrollBar(Value: TControlScrollBar);
begin
FHorzScrollbar.Assign(Value);
@ -217,7 +223,7 @@ begin
ControlStyle := [csAcceptsControls, csClickEvents, csDoubleClicks];
SetInitialBounds(0,0, 150, 150);
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
end;
destructor TScrollingWinControl.Destroy;

9
lcl/include/shape.inc
View File

@ -17,7 +17,7 @@
constructor TShape.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
SetInitialBounds(0,0,65,65);
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
ControlStyle := ControlStyle + [csReplicatable];
FPen := TPen.Create;
FPen.OnChange := @StyleChanged;
@ -105,3 +105,10 @@ begin
StyleChanged(Self);
end;
end;
class function TShape.GetControlClassDefaultSize: TPoint;
begin
Result.X:=65;
Result.Y:=65;
end;

8
lcl/include/speedbutton.inc
View File

@ -39,7 +39,7 @@ begin
FGlyph := TButtonGlyph.Create;
FGlyph.OnChange := @GlyphChanged;
SetInitialBounds(0, 0, 23, 22);
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
ControlStyle := ControlStyle + [csCaptureMouse]-[csSetCaption, csClickEvents];
FLayout:= blGlyphLeft;
@ -393,6 +393,12 @@ begin
Result := TSpeedButtonActionLink;
end;
class function TCustomSpeedButton.GetControlClassDefaultSize: TPoint;
begin
Result.X:=23;
Result.Y:=22;
end;
{------------------------------------------------------------------------------
Method: TCustomSpeedButton.UpdateExclusive
Params: none

8
lcl/include/spinedit.inc
View File

@ -104,6 +104,12 @@ begin
if FUpdatePending then UpdateControl;
end;
class function TCustomFloatSpinEdit.GetControlClassDefaultSize: TPoint;
begin
Result.X:=50;
Result.Y:=23;
end;
procedure TCustomFloatSpinEdit.SetValue(const AValue: Single);
begin
if FValue = AValue then Exit;
@ -146,7 +152,7 @@ begin
FUpdatePending := True;
FValueChanged := True;
SetInitialBounds(0, 0, 50, 23);
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
end;
function TCustomFloatSpinEdit.GetLimitedValue(const AValue: Single): Single;

8
lcl/include/tabcontrol.inc
View File

@ -530,6 +530,12 @@ begin
TTabControlStrings(FTabs).TabControlBoundsChange;
end;
class function TCustomTabControl.GetControlClassDefaultSize: TPoint;
begin
Result.X:=200;
Result.Y:=150;
end;
procedure TCustomTabControl.Paint;
var
ARect: TRect;
@ -587,7 +593,7 @@ begin
FImageChangeLink := TChangeLink.Create;
FImageChangeLink.OnChange := @ImageListChange;
FTabs:=TTabControlNoteBookStrings.Create(Self);
SetInitialBounds(0,0,200,150);
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
BorderWidth:=2;
FTabControlCreating:=false;
end;

1
lcl/include/togglebox.inc
View File

@ -21,7 +21,6 @@ begin
inherited Create(TheOwner);
fCompStyle := csToggleBox;
AutoSize:=false;
SetInitialBounds(0,0,90,25);
end;
{------------------------------------------------------------------------------}

8
lcl/include/toolbar.inc
View File

@ -72,7 +72,7 @@ begin
FHotImageChangeLink := TChangeLink.Create;
FHotImageChangeLink.OnChange := @HotImageListChange;
EdgeBorders := [ebTop];
SetInitialBounds(0,0,150,26);
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
Align := alTop;
end;
@ -547,6 +547,12 @@ begin
inc(ARect.Left,Indent);
end;
class function TToolBar.GetControlClassDefaultSize: TPoint;
begin
Result.X:=150;
Result.Y:=26;
end;
function TToolBar.FindButtonFromAccel(Accel: Word): TToolButton;
var
i: Integer;

8
lcl/include/toolbutton.inc
View File

@ -60,7 +60,7 @@ begin
FImageIndex := -1;
FStyle := tbsButton;
ControlStyle := [csCaptureMouse, csSetCaption, csDesignNoSmoothResize];
SetInitialBounds(0,0,23,22);
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
end;
procedure TToolButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
@ -809,6 +809,12 @@ begin
end;
end;
class function TToolButton.GetControlClassDefaultSize: TPoint;
begin
Result.X:=23;
Result.Y:=22;
end;
// included by comctrls.pp

8
lcl/include/trackbar.inc
View File

@ -70,7 +70,7 @@ begin
FTickMarks:=tmBottomRight;
FTickStyle:=tsAuto;
TabStop := true;
SetInitialBounds(0,0,100,25);
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
end;
{------------------------------------------------------------------------------
@ -313,6 +313,12 @@ begin
if Assigned (FOnChange) then FOnChange(Self);
end;
class function TCustomTrackBar.GetControlClassDefaultSize: TPoint;
begin
Result.X:=100;
Result.Y:=25;
end;
{------------------------------------------------------------------------------
Method: TCustomTrackBar.SetScalePos
Params: value : position of the scaling text

567
lcl/include/wincontrol.inc
View File

@ -60,7 +60,7 @@ type
Control: TControl; // the Control of a leaf node
MinimumSize: array[TAutoSizeBoxOrientation] of integer;
MaximumSize: array[TAutoSizeBoxOrientation] of integer; // 0 means inifinte
PreferredSize: array[TAutoSizeBoxOrientation] of integer;
PreferredSize: array[TAutoSizeBoxOrientation] of integer;// without theme space
LeftTop: array[TAutoSizeBoxOrientation] of integer;
BorderLeftTop: array[TAutoSizeBoxOrientation] of integer;
BorderRightBottom: array[TAutoSizeBoxOrientation] of integer;
@ -102,9 +102,370 @@ type
procedure WriteDebugReport;
end;
{ TAutoSizeCtrlData
This class is used by the auto size algorithm, to
1. compute the child bounds of a control given
a certain clientwidth and clientheight.
2. compute the preferred size of a control given the preferred sizes of
its childs.
}
TAutoSizeCtrlData = class
private
FChilds: TAvgLvlTree;// tree of TAutoSizeCtrlData
function GetChilds(AControl: TControl): TAutoSizeCtrlData;
procedure AlignChilds;
procedure DoMoveNonAlignedChilds(Side: TAnchorKind;
var MoveDiff: integer; FindMinimum: boolean);
public
Control: TControl; // the Control of a leaf node
WinControl: TWinControl;// the Control as TWinControl (else nil)
ChildCount: integer;
Visible: boolean;//= Control.IsControlVisible
PreferredSize: array[TAutoSizeBoxOrientation] of integer;// without theme space
Borders: array[TAnchorKind] of integer;
ClientRect: TRect;
AdjustedClientRect: TRect;
AnchorDistControl: array[TAnchorKind] of TAutoSizeCtrlData;
AnchorDistSide: array[TAnchorKind] of TAnchorSideReference;
AnchorDistLeftTop: array[TAnchorKind] of integer;
AnchorDistLeftTopValid: array[TAnchorKind] of boolean;
AnchorDistRightBottom: array[TAnchorKind] of integer;
AnchorDistRightBottomValid: array[TAnchorKind] of boolean;
constructor Create(AControl: TControl);
destructor Destroy; override;
procedure Clear;
procedure ComputePreferredClientArea(MoveNonAlignedChilds: boolean);
procedure FixControlProperties(Control: TControl);
property Childs[AControl: TControl]: TAutoSizeCtrlData read GetChilds; default;
end;
const
SizeBoxOrthogonal: array[TAutoSizeBoxOrientation] of TAutoSizeBoxOrientation
= (asboVertical,asboHorizontal);
function CompareAutoSizeCtrlDatas(Data1, Data2: Pointer): integer;
var
Control1: TControl;
Control2: TControl;
begin
Control1:=TAutoSizeCtrlData(Data1).Control;
Control2:=TAutoSizeCtrlData(Data2).Control;
if Pointer(Control1)>Pointer(Control2) then
Result:=1
else if Pointer(Control1)<Pointer(Control2) then
Result:=-1
else
Result:=0;
end;
function CompareControlWithAutoSizeCtrlData(AControl, AData: Pointer): integer;
var
Control1: TControl;
Control2: TControl;
begin
Control1:=TControl(AControl);
Control2:=TAutoSizeCtrlData(AData).Control;
if Pointer(Control1)>Pointer(Control2) then
Result:=1
else if Pointer(Control1)<Pointer(Control2) then
Result:=-1
else
Result:=0;
end;
{ TAutoSizeCtrlData }
function TAutoSizeCtrlData.GetChilds(AControl: TControl): TAutoSizeCtrlData;
var
AVLNode: TAvgLvlTreeNode;
begin
if AControl=nil then exit(nil);
if FChilds=nil then
FChilds:=TAvgLvlTree.Create(@CompareControlWithAutoSizeCtrlData);
AVLNode:=FChilds.FindKey(AControl,@CompareControlWithAutoSizeCtrlData);
if AVLNode<>nil then
Result:=TAutoSizeCtrlData(AVLNode.Data)
else begin
Result:=TAutoSizeCtrlData.Create(AControl);
FChilds.Add(Result);
end;
end;
procedure TAutoSizeCtrlData.AlignChilds;
var
RemainingClientRect: TRect;
RemainingBorderSpace: TRect;
AlignList: TFPList;
AWinControl: TWinControl;
procedure DoAlign(TheAlign: TAlign);
begin
AWinControl.CreateControlAlignList(TheAlign,AlignList,nil);
end;
begin
if ChildCount=0 then exit;
AWinControl:=TWinControl(Control);
RemainingClientRect:=AdjustedClientRect;
RemainingBorderSpace:=Rect(0,0,0,0);
// adjust RemainingClientRect by ChildSizing properties
AdjustBorderSpace(RemainingClientRect,RemainingBorderSpace,
Control.ChildSizing.LeftRightSpacing,Control.ChildSizing.TopBottomSpacing,
Control.ChildSizing.LeftRightSpacing,Control.ChildSizing.TopBottomSpacing);
AlignList := TFPList.Create;
try
// align and anchor child controls
DoAlign(alTop);
DoAlign(alBottom);
DoAlign(alLeft);
DoAlign(alRight);
DoAlign(alClient);
DoAlign(alCustom);
DoAlign(alNone);
DoAlignNotAligned;
finally
AlignList.Free;
end;
end;
constructor TAutoSizeCtrlData.Create(AControl: TControl);
var
CurBorders: TRect;
AWinControl: TWinControl;
i: Integer;
Child: TAutoSizeCtrlData;
a: TAnchorKind;
begin
Control:=AControl;
if Control is TWinControl then
WinControl:=TWinControl(Control);
ChildCount:=WinControl.ControlCount
else
ChildCount:=0;
Visible:=Control.IsControlVisible;
MinimumSize[asboHorizontal]:=Control.Constraints.EffectiveMinWidth;
MinimumSize[asboVertical]:=Control.Constraints.EffectiveMinHeight;
MaximumSize[asboHorizontal]:=Control.Constraints.EffectiveMaxWidth;
MaximumSize[asboVertical]:=Control.Constraints.EffectiveMaxHeight;
Control.BorderSpacing.GetSpaceAround(CurBorders);
CurBorders[akLeft]:=CurBorders.Left;
CurBorders[akTop]:=CurBorders.Top;
CurBorders[akRight]:=CurBorders.Right;
CurBorders[akBottom]:=CurBorders.Bottom;
ClientRect:=Control.GetClientRect;
AdjustedClientRect:=ClientRect;
if WinControl<>nil then begin
WinControl.AdjustClientRect(AdjustedClientRect);
end;
end;
destructor TAutoSizeCtrlData.Destroy;
begin
Clear;
FreeAndNil(FChilds);
inherited Destroy;
end;
procedure TAutoSizeCtrlData.Clear;
begin
if FChilds<>nil then
FChilds.FreeAndClear;
end;
procedure TAutoSizeCtrlData.DoMoveNonAlignedChilds(Side: TAnchorKind;
var MoveDiff: integer; FindMinimum: boolean);
var
i: Integer;
Child: TControl;
MoveDiffValid: Boolean;
ChildData: TAutoSizeCtrlData;
begin
MoveDiffValid:=false;
for i:=0 to ChildCount-1 do begin
Child:=WinControl.Controls[i];
ChildData:=Childs[Child];
if (ChildData.Visible)
and (Child.Align=alNone)
and (Side in Child.Anchors) and (Child.AnchorSide[Side].Control=nil)
then begin
if FindMinimum then begin
if Side=akLeft then begin
Position:=Child.Left
-Max(Child.BorderSpacing.GetSpace(Side),
WinControl.ChildSizing.LeftRightSpacing)
-AdjustedClientRect.Left;
end else begin
Position:=Child.Top
-Max(Child.BorderSpacing.GetSpace(Side),
WinControl.ChildSizing.TopBottomSpacing)
-AdjustedClientRect.Top;
end;
if (not MoveDiffValid) or (MoveDiff>Position) then
begin
MoveDiff:=Position;
MoveDiffValid:=true;
end;
end else begin
ChildData.MinDistances[Side]:=Child.GetSidePosition(Side)-MoveDiff;
ChildData.MinDistanceValid[Side]:=true;
end;
end;
end;
end;
procedure TAutoSizeCtrlData.ComputePreferredClientArea(
MoveNonAlignedChilds: boolean);
{ if MoveNonAlignedChilds=true then all non-aligned childs will be moved the
parallel, so that at least one child is positioned left most and one child
is positioned top most.
Type of controls:
1. non-aligned: the left side of the control has only a designed position.
That means: Align=alNone, akLeft is set, AnchorSide[akLeft].Control=nil
and Parent.ChildSizing.Layout=cclNone
2. Aligned: Align<>alNone
These are put consecutively into the remaining space.
BorderSpacing and AdjustClientRect defines the space.
The aligned sides automatically set the Anchors and the AnchorSide.Control
to nil.
alLeft,alRight,alTop,alBottom have one free side, which can be anchored.
3. centered: akLeft and akRight are not set
4. one side anchored: akLeft is set and akRight is not
OR akRight is set and akLeft is not
4.1 anchored to a side (asrLeft,asrRight)
4.2 anchored to a center (asrCenter)
5. both sides anchored: akLeft and akRight not
Note: asrCenter is not allowed here
Circles and invalid combinations will be automatically fixed.
}
procedure SetDefaultPreferredSize;
begin
PreferredSize[asboHorizontal]:=WinControl.Width;
PreferredSize[asboVertical]:=WinControl.Height;
end;
var
i: Integer;
VisibleCount: Integer;
Child: TControl;
ChildData: TAutoSizeCtrlData;
begin
if (WinControlChildSizing.Layout<>cclNone) or (ChildCount=0) then begin
// layouts are not yet supported
SetDefaultPreferredSize;
exit;
end;
// fix control properties
// check if there are visible childs
// init dependencies
VisibleCount:=0;
for i:=0 to ChildCount-1 do begin
Child:=WinControl.Controls[i];
if Child.Align=alCustom then begin
// this is not LCL business
SetDefaultPreferredSize;
exit;
end;
FixControlProperties(Child);
ChildData:=Childs[Child];
if ChildData.Visible then
inc(VisibleCount);
ChildData.ClearDependentPositions;
for a:=Low(TAnchorKind) to High(TAnchorKind) do begin
ChildData.AnchorDistLeftTopValid[a]:=false;
ChildData.AnchorDistRightBottomValid[a]:=false;
ChildData.AnchorDistControl:=nil;
ChildData.AnchorDistSide:=asrLeft;
if (Child.Align in [alLeft,alRight,alTop,alBottom,alClient])
and (a in AnchorAlign[Child.Align]) then begin
// this is an aligned side
// => the dependencies will be setup later
end else a in Child.Anchors then begin
// this is an anchored side
ChildData.AnchorDistControl:=Child.AnchorSide[a].Control;
ChildData.AnchorDistSide:=Child.AnchorSide[a].Side;
end else begin
// this is a dangling side
end;
end;
end;
if VisibleCount=0 then begin
SetDefaultPreferredSize;
exit;
end;
if (WinControl.ChildSizing.Layout=cclNone) then begin
// First move the non-aligned controls (i.e. not aligned or fixed anchored):
// Find the leftmost and topmost of those controls
MoveDiff:=0;
DoMoveNonAlignedChilds(akLeft,MoveDiff,true);
DoMoveNonAlignedChilds(akLeft,MoveDiff,false);
MoveDiff:=0;
DoMoveNonAlignedChilds(akTop,MoveDiff,true);
DoMoveNonAlignedChilds(akTop,MoveDiff,false);
end;
// align controls
end;
procedure TAutoSizeCtrlData.FixControlProperties(Control: TControl);
var
a: TAnchorKind;
begin
if Control.Align in [alLeft,alRight,alTop,alBottom,alClient] then begin
// the aligned sides must be anchored
Control.Anchors:=Control.Anchors+AnchorAlign[Control.Align];
for a:=Low(TAnchorKind) to High(TAnchorKind) do begin
if a in AnchorAlign[Control.Align] then begin
// the aligned sides can not be anchored to a control
Control.AnchorSide[a].Control:=nil;
end
if Control.AnchorSide[a].Side=asrCenter then begin
// an aligned control can not be centered
Control.AnchorSide[a].Side:=asrLeft;
if not (a in AnchorAlign[Control.Align]) then begin
Control.Anchors:=Control.Anchors-[a];
Control.AnchorSide[a].Control:=nil;
end;
end;
end;
end else begin
for a:=Low(TAnchorKind) to High(TAnchorKind) do begin
if (a in Control.Anchors)
and (Control.AnchorSide[a].Side=asrCenter) then begin
if Control.AnchorSide[a].Control<>nil then begin
// the control should be centered relative to another control
if a in [akLeft,akTop] then begin
// un-anchor the other side
Control.Anchors:=Control.Anchors-OppositeAnchor[a];
Control.AnchorSide[OppositeAnchor[a]].Control:=nil;
end else begin
// the centering was setup via the right,bottom
// => normalize it to center via the Left,Top
Control.AnchorSide[OppositeAnchor[a]].Control:=Control.AnchorSide[a].Control;
Control.AnchorSide[OppositeAnchor[a]].Side:=asrCenter;
Control.AnchorSide[a].Control:=nil;
Control.AnchorSide[a].Side:=asrLeft;
Control.Anchors:=Control.Anchors+OppositeAnchor[a]-[a];
end;
end else begin
// the asrCenter is not active => ok
end;
end;
end;
end;
end;
{ TAutoSizeBox }
@ -1010,16 +1371,76 @@ end;
{------------------------------------------------------------------------------
TWinControl AdjustClientRect
------------------------------------------------------------------------------}
Procedure TWinControl.AdjustClientRect(var ARect: TRect);
procedure TWinControl.AdjustClientRect(var ARect: TRect);
Begin
//Not used. It's a virtual procedure that should be overriden.
end;
{------------------------------------------------------------------------------
TWinControl CreateControlAlignList
Creates a list of controls that need to be aligned via TheAlign.
------------------------------------------------------------------------------}
procedure TWinControl.CreateControlAlignList(TheAlign: TAlign;
AlignList: TFPList; StartControl: TControl);
function InsertBefore(Control1, Control2: TControl;
AAlign: TAlign): Boolean;
begin
Result := False;
case AAlign of
alTop: Result := Control1.Top < Control2.Top;
alLeft: Result := Control1.Left < Control2.Left;
// contrary to VCL, we use > for alBottom, alRight
// Maybe it is a bug in the VCL.
// This results in first control is put rightmost/bottommost
alBottom: Result := (Control1.Top + Control1.Height)
> (Control2.Top + Control2.Height);
alRight: Result := (Control1.Left + Control1.Width)
> (Control2.Left + Control2.Width);
end;
end;
var
I, X: Integer;
Control: TControl;
begin
AlignList.Clear;
// first add the current control
if (StartControl <> nil)
and (StartControl.Align = TheAlign)
and ((TheAlign = alNone)
or StartControl.IsControlVisible)
then
AlignList.Add(StartControl);
// then add all other
for I := 0 to ControlCount - 1 do
begin
Control := Controls[I];
if (Control.Align = TheAlign)
and ((TheAlign = alNone)
or Control.IsControlVisible
or (Control.ControlStyle * [csAcceptsControls, csNoDesignVisible] =
[csAcceptsControls, csNoDesignVisible])) then
begin
if Control = TheControl then Continue;
X := 0;
while (X < AlignList.Count)
and not InsertBefore(Control, TControl(AlignList[X]), TheAlign) do
Inc(X);
AlignList.Insert(X, Control);
end;
end;
end;
{------------------------------------------------------------------------------
TWinControl AlignControls
Align child controls
------------------------------------------------------------------------------}
procedure TWinControl.AlignControls(AControl: TControl;
var RemainingClientRect: TRect);
@ -1030,7 +1451,7 @@ var
RemainingBorderSpace: TRect; // borderspace around RemainingClientRect
// e.g. Right=3 means borderspace of 3
function AlignWork: Boolean;
function NeedAlignWork: Boolean;
var
I: Integer;
CurControl: TControl;
@ -1535,58 +1956,9 @@ var
{$ENDIF}
end;
function InsertBefore(Control1, Control2: TControl;
AAlign: TAlign): Boolean;
begin
Result := False;
case AAlign of
alTop: Result := Control1.Top < Control2.Top;
alLeft: Result := Control1.Left < Control2.Left;
// contrary to VCL, we use > for alBottom, alRight
// Maybe it is a bug in the VCL.
// This results in first control is put rightmost/bottommost
alBottom: Result := (Control1.Top + Control1.Height)
> (Control2.Top + Control2.Height);
alRight: Result := (Control1.Left + Control1.Width)
> (Control2.Left + Control2.Width);
end;
end;
procedure DoAlign(AAlign: TAlign);
var
I, X: Integer;
Control: TControl;
begin
AlignList.Clear;
// first add the current control
if (AControl <> nil)
and (AControl.Align = AAlign)
and ((AAlign = alNone)
or AControl.IsControlVisible)
then
AlignList.Add(AControl);
// then add all other
for I := 0 to ControlCount - 1 do
begin
Control := Controls[I];
if (Control.Align = AAlign)
and ((AAlign = alNone)
or Control.IsControlVisible
or (Control.ControlStyle * [csAcceptsControls, csNoDesignVisible] =
[csAcceptsControls, csNoDesignVisible])) then
begin
if Control = AControl then Continue;
X := 0;
while (X < AlignList.Count)
and not InsertBefore(Control, TControl(AlignList[X]), AAlign) do
Inc(X);
AlignList.Insert(X, Control);
end;
end;
CreateControlAlignList(AAlign,AlignList,AControl);
{$IFDEF CHECK_POSITION}
if CheckPosition(Self) then
if AlignList.Count>0 then begin
@ -1653,10 +2025,10 @@ begin
try
//if csDesigning in ComponentState then begin
//DebugLn('[TWinControl.AlignControls] ',Name,':',Classname,' ',Left,',',Top,',',Width,',',Height,' AlignWork=',AlignWork,' ControlCount=',ControlCount);
//DebugLn('[TWinControl.AlignControls] ',Name,':',Classname,' ',Left,',',Top,',',Width,',',Height,' AlignWork=',NeedAlignWork,' ControlCount=',ControlCount);
//if AControl<>nil then DebugLn(' AControl=',AControl.Name,':',AControl.ClassName);
//end;
if AlignWork then
if NeedAlignWork then
begin
AdjustClientRect(RemainingClientRect);
RemainingBorderSpace:=Rect(0,0,0,0);
@ -1839,6 +2211,7 @@ var
MovableChildAnchors: TAnchors;
NewChildBounds: TRect;
OldChildBounds: TRect;
Layout: TAutoSizeCtrlData;
begin
{$IFDEF VerboseAutoSize}
debugln('TWinControl.DoAutoSize ',DbgSName(Self));
@ -1850,7 +2223,11 @@ begin
DisableAutoSizing;
DisableAlign;
Layout:=nil;
try
Layout:=TAutoSizeCtrlData.Create(Self);
Layout.ComputePreferredClientArea();
// test if resizing is possible
HasVisibleChilds:=false;
for i:=0 to ControlCount-1 do
@ -1858,7 +2235,7 @@ begin
HasVisibleChilds:=true;
break;
end;
CurAnchors:=Anchors;
if Align<>alNone then CurAnchors:=CurAnchors+AnchorAlign[Align];
ChildsFixedSides:=[];
@ -1872,8 +2249,8 @@ begin
// move childs tight to left and top (so no space left and above childs)
if (ControlCount > 0) then begin
// get current bounds of all childs including border space
GetChildBounds(ChildBounds,true,false);
// get preferred bounds of all childs including border space
GetChildBounds(ChildBounds,true,true);
CurClientRect:=ClientRect;
AdjustClientRect(CurClientRect);
//DebugLn(['TWinControl.DoAutoSize ',DbgSName(Self),' ChildsBounds=',dbgs(ChildBounds),' CurClientRect=',dbgs(CurClientRect)]);
@ -1920,7 +2297,10 @@ begin
// autosize control to preferred size
if (not WidthIsFixed) or (not HeightIsFixed) then begin
GetPreferredSize(PreferredWidth,PreferredHeight,false,false);
GetPreferredSize(PreferredWidth,PreferredHeight,
false,// with constraints
false // without theme space
);
//if ControlCount>0 then DebugLn(['TWinControl.DoAutoSize ',DbgSName(Self),' PreferredWidth=',PreferredWidth,' PreferredHeight=',PreferredHeight,' ControlCount=',ControlCount]);
end else begin
PreferredWidth:=0;
@ -1948,6 +2328,7 @@ begin
SetBoundsKeepBase(NewLeft,NewTop,PreferredWidth,PreferredHeight,true);
end;
finally
Layout.Free;
Exclude(FControlFlags,cfAutoSizeNeeded);
EnableAlign;
EnableAutoSizing;
@ -5876,9 +6257,16 @@ end;
WithBorderSpace, FixateParentAnchors: boolean);
Calculates the bounds of all visible childs in client coordinates.
If WithBorderSpace=true then the space around the childs is included.
If UsePreferredSizes=true then instead of the current childbounds the
minimum size is calculated using GetPreferredSize.
------------------------------------------------------------------------------}
procedure TWinControl.GetChildBounds(var ChildBounds: TRect;
WithBorderSpace, FixateParentAnchors: boolean);
WithBorderSpace, UsePreferredSizes: boolean);
{$DEFINE VerboseGetChildBounds}
procedure FixateSide(Side: TAnchorKind);
begin
@ -5897,9 +6285,8 @@ var
ChildWidth,ChildHeight: integer;
a: TAnchorKind;
FixatedAnchors: TAnchors;
//CurClientRect: TRect;
AnchorsToParent: TAnchors;
AnchorsToSibling: TAnchors;
AnchorsToSiblings: TAnchors;
MinWidth: LongInt;
MinHeight: LongInt;
begin
@ -5907,47 +6294,27 @@ begin
MinWidth:=0;
MinHeight:=0;
{CurClientRect:=ClientRect;
AdjustClientRect(CurClientRect);
if WithBorderSpace then begin
AlignSpaceAround:=Rect(
CurClientRect.Left, // left space
CurClientRect.Top, // top space
ClientWidth-CurClientRect.Right,// right space
ClientHeight-CurClientRect.Bottom// bottom space
);
end else
AlignSpaceAround:=Rect(0,0,0,0);}
SpaceAround:=Rect(0,0,0,0);
FixatedAnchors:=[];
for I := 0 to ControlCount - 1 do begin
AControl:=Controls[I];
if not AControl.IsControlVisible then continue;
AnchorsToParent:=AControl.GetAnchorsDependingOnParent(false);
if FixateParentAnchors then
if not UsePreferredSizes then
FixatedAnchors:=FixatedAnchors+AnchorsToParent;
if AControl.AutoSize and (AControl.Align=alNone) then begin
if AControl.AutoSize and UsePreferredSizes then begin
AControl.GetPreferredSize(ChildWidth,ChildHeight,true,false);
if ChildWidth>0 then begin
ChildWidth:=AControl.Constraints.MinMaxWidth(ChildWidth);
end else begin
ChildWidth:=AControl.Constraints.EffectiveMinWidth;
if ChildWidth<=0 then
ChildWidth:=AControl.Width;
end;
if ChildHeight>0 then begin
ChildHeight:=AControl.Constraints.MinMaxHeight(ChildHeight);
end else begin
ChildHeight:=AControl.Constraints.EffectiveMinHeight;
if ChildHeight<=0 then
ChildHeight:=AControl.Height;
end;
if ChildWidth<=0 then
ChildWidth:=AControl.GetDefaultWidth;
if ChildHeight<=0 then
ChildHeight:=AControl.GetDefaultHeight;
end else begin
ChildWidth:=AControl.Width;
ChildHeight:=AControl.Height;
end;
ChildWidth:=AControl.Constraints.MinMaxWidth(ChildWidth);
ChildHeight:=AControl.Constraints.MinMaxHeight(ChildHeight);
if WithBorderSpace then begin
AControl.BorderSpacing.GetSpaceAround(SpaceAround);
@ -5955,40 +6322,44 @@ begin
SpaceAround.Right:=Max(SpaceAround.Right,ChildSizing.LeftRightSpacing);
SpaceAround.Top:=Max(SpaceAround.Top,ChildSizing.TopBottomSpacing);
SpaceAround.Bottom:=Max(SpaceAround.Bottom,ChildSizing.TopBottomSpacing);
end else begin
SpaceAround:=Rect(0,0,0,0);
end;
MinWidth:=Max(MinWidth,SpaceAround.Left+ChildWidth+SpaceAround.Right);
MinHeight:=Max(MinHeight,SpaceAround.Top+ChildHeight+SpaceAround.Bottom);
with ChildBounds do begin
if FixateParentAnchors then begin
if not UsePreferredSizes then begin
Left := Min(AControl.Left-SpaceAround.Left, Left);
Top := Min(AControl.Top-SpaceAround.Top, Top);
Right := Max(AControl.Left+ChildWidth+SpaceAround.Right,Right);
Bottom := Max(AControl.Top+ChildHeight+SpaceAround.Bottom,Bottom);
end else begin
AnchorsToSibling:=[akLeft,akRight,akTop,akBottom]-AnchorsToParent;
AnchorsToSiblings:=[akLeft,akRight,akTop,akBottom]-AnchorsToParent;
if (akLeft in AnchorsToSibling) then begin
if (akLeft in AnchorsToSiblings) then begin
Left := Min(AControl.Left-SpaceAround.Left, Left);
Right := Max(AControl.Left+ChildWidth+SpaceAround.Right,Right);
end
else if (akRight in AnchorsToSibling) then begin
else if (akRight in AnchorsToSiblings) then begin
Left := Min(AControl.Left+AControl.Width-ChildWidth-SpaceAround.Left, Left);
Right := Max(AControl.Left+AControl.Width+SpaceAround.Right,Right);
end;
if (akTop in AnchorsToSibling) then begin
if (akTop in AnchorsToSiblings) then begin
Top := Min(AControl.Top-SpaceAround.Top, Top);
Bottom := Max(AControl.Top+ChildHeight+SpaceAround.Bottom,Bottom);
end
else if (akBottom in AnchorsToSibling) then begin
else if (akBottom in AnchorsToSiblings) then begin
Top := Min(AControl.Top+AControl.Height-ChildHeight-SpaceAround.Top, Top);
Bottom := Max(AControl.Top+AControl.Height+SpaceAround.Bottom,Bottom);
end;
end;
end;
//DebugLn(['TWinControl.GetChildBounds ',DbgSName(Self),' ChildBounds=',dbgs(ChildBounds),' ',DbgSName(AControl),'.BoundsRect=',dbgs(AControl.BoundsRect),' SpaceAround=',dbgs(SpaceAround),' AnchorsToParent=',dbgs(AnchorsToParent),' Preferred=w=',ChildWidth,',h=',ChildHeight]);
{$IFDEF VerboseGetChildBounds}
DebugLn(['TWinControl.GetChildBounds ',DbgSName(Self),' ChildBounds=',dbgs(ChildBounds),' ',DbgSName(AControl),'.BoundsRect=',dbgs(AControl.BoundsRect),' SpaceAround=',dbgs(SpaceAround),' AnchorsToParent=',dbgs(AnchorsToParent),' Preferred=w=',ChildWidth,',h=',ChildHeight]);
{$ENDIF}
end;
for a:=Low(TAnchorKind) to High(TAnchorKind) do
if a in FixatedAnchors then FixateSide(a);

9
lcl/pairsplitter.pas
View File

@ -101,6 +101,7 @@ type
protected
function GetCursor: TCursor; override;
procedure SetCursor(Value: TCursor); override;
class function GetControlClassDefaultSize: TPoint; override;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
@ -331,6 +332,12 @@ begin
inherited SetCursor(Value);
end;
class function TCustomPairSplitter.GetControlClassDefaultSize: TPoint;
begin
Result.X:=90;
Result.Y:=90;
end;
constructor TCustomPairSplitter.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
@ -338,7 +345,7 @@ begin
ControlStyle := ControlStyle - [csAcceptsControls];
FSplitterType := pstHorizontal;
Cursor := crHSplit;
SetInitialBounds(0, 0, 90, 90);
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
FPosition:=45;
CreateSides;
end;

1
lcl/spin.pp
View File

@ -60,6 +60,7 @@ type
procedure InitializeWnd; override;
procedure FinalizeWnd; override;
procedure Loaded; override;
class function GetControlClassDefaultSize: TPoint; override;
public
constructor Create(TheOwner: TComponent); override;
function GetLimitedValue(const AValue: Single): Single;

11
lcl/stdctrls.pp
View File

@ -160,6 +160,7 @@ type
TCustomGroupBox = class (TWinControl)
protected
class function GetControlClassDefaultSize: TPoint; override;
public
constructor Create(AOwner: TComponent); Override;
end;
@ -293,6 +294,7 @@ type
procedure DoExit; override;
procedure DrawItem(Index: Integer; ARect: TRect;
State: TOwnerDrawState); virtual;
class function GetControlClassDefaultSize: TPoint; override;
procedure LMChanged(var Msg); message LM_CHANGED;
procedure Change; dynamic;
procedure Select; dynamic;
@ -484,6 +486,7 @@ type
procedure Loaded; override;
procedure InitializeWnd; override;
procedure FinalizeWnd; override;
class function GetControlClassDefaultSize: TPoint; override;
procedure CheckIndex(const AIndex: Integer);
function GetItemHeight: Integer;
function GetItemIndex: integer; virtual;
@ -672,6 +675,7 @@ type
procedure SetSelText(const Val: string); virtual;
procedure RealSetText(const Value: TCaption); override;
function ChildClassAllowed(ChildClass: TClass): boolean; override;
class function GetControlClassDefaultSize: TPoint; override;
procedure KeyUp(var Key: Word; Shift: TShiftState); override;
procedure WMChar(var Message: TLMChar); message LM_CHAR;
procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X, Y: Integer); override;
@ -753,6 +757,7 @@ type
function WordWrapIsStored: boolean; virtual;
procedure ControlKeyDown(var Key: Word; Shift: TShiftState); override;
procedure CNChar(var Message: TLMKeyUp); message CN_CHAR;
class function GetControlClassDefaultSize: TPoint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@ -894,6 +899,7 @@ type
procedure SetFocusControl(Val: TWinControl); virtual;
procedure SetShowAccelChar(Val: boolean); virtual;
function DialogChar(var Message: TLMKey): boolean; override;
class function GetControlClassDefaultSize: TPoint; override;
public
constructor Create(AOwner: TComponent); override;
property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
@ -1008,6 +1014,7 @@ type
function DialogChar(var Message: TLMKey): boolean; override;
function ChildClassAllowed(ChildClass: TClass): boolean; override;
function IsBorderSpacingInnerBorderStored: Boolean; override;
class function GetControlClassDefaultSize: TPoint; override;
property ParentColor default false;
function UseRightToLeftAlignment: Boolean; override;
public
@ -1098,6 +1105,7 @@ type
procedure SetChecked(Value: Boolean); override;
procedure RealSetText(const Value: TCaption); override;
procedure ApplyChanges; virtual;
class function GetControlClassDefaultSize: TPoint; override;
procedure Loaded; override;
public
constructor Create(TheOwner: TComponent); override;
@ -1355,6 +1363,7 @@ type
procedure TextChanged; override;
procedure Resize; override;
procedure FontChanged(Sender: TObject); override;
class function GetControlClassDefaultSize: TPoint; override;
procedure WMActivate(var Message: TLMActivate); message LM_ACTIVATE;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
@ -1380,12 +1389,12 @@ type
property WordWrap: Boolean read FWordWrap write SetWordWrap default false;
property OptimalFill: Boolean read FOptimalFill write SetOptimalFill default false;
public
constructor Create(TheOwner: TComponent); override;
function CalcFittingFontHeight(const TheText: string;
MaxWidth, MaxHeight: Integer; var FontHeight,
NeededWidth, NeededHeight: integer): Boolean;
function ColorIsStored: boolean; override;
function AdjustFontForOptimalFill: Boolean;
constructor Create(TheOwner: TComponent); override;
procedure Paint; override;
property AutoSize default True;
property Color default clNone;