I am using a TFlowLayout to display a number of boxes.
When the screen is resized the FlowLayout adjusts the number of boxes per line automatically.
However I want to adjust the height of the surrounding element (TTreeViewItem) automatically.
I achieved this by adding an event:
procedure TDeviceTreeView.DeviceTreeViewResize(Sender: TObject);
begin
height := ChildrenRect.Height;
end;
This works halfways: the size is adjusted to grow when the elements in the flow layout need more lines.
However it never shrinks.
I know why. If you look at TControl.GetChildrenRect you will see:
function TControl.GetChildrenRect: TRectF;
var
I: Integer;
Control: TControl;
begin
Result := AbsoluteRect;
{ children }
if not (ClipChildren or SmallSizeControl) and (FControls <> nil) then
for I := GetFirstVisibleObjectIndex to GetLastVisibleObjectIndex - 1 do
begin
Control := FControls[I];
if Control.Visible then
Result := UnionRect(Result, Control.GetChildrenRect);
end
end;
Note that the base rectangle is:
Result := AbsoluteRect;
And from that it will loop through the child controls, always adding (union) to the first rect.
This causes the behavior you are experiencing: if the ChildControl's rect surpasses the FlowLayout's rect it increases, but will never decrease because the FlowLayout.AbsoluteRect is the starting rect in the function.
What you can do to solve that in a simple way is calculating the "ChildRect" yourself.
procedure TDeviceTreeView.DeviceTreeViewResize(Sender: TObject);
var childrenRect: TRectF;
begin
if ((csLoading in FlowLayout1.ComponentState) = False) then // You might want to check for csLoading to avoid unecessary calls to resize
begin
childrenRect := TRectF.Empty;
for i := 0 to FlowLayout1.ControlsCount - 1 do
childrenRect := TRectF.Union(childrenRect, FlowLayout1.Controls[i].ChildrenRect);
FlowLayout1.Height := childrenRect.Height;
end;
end;
You need to set TTreeViewItem property Align:alTop. In FMX it looks like: TTreeViewItem.Align:=talignlayout(1);
Related
The scenario is this:
I've created a Delphi (XE2) form.
On it is a single TGroupBox (or other control) stretched so it occupies the full width of the form with the top.
Right anchor (in addition to left and top) on TGroupBox is set.
Form width set to 1200px (to illustrate the point).
If I run this application on a monitor whose Screen.Width property is greater than 1200px (I'm running without any DPI virtualization AFAIK) then the TGroupBox renders as you'd expect.
However.. if the monitor's width is less than 1200px then the right hand portion of the control is missing from the screen regardless of how your resize the form.
I've overridden the Create() method of my form with the override; directive and verified that I'm setting the width property correctly, however the control is still cropped.
Can anyone advise either how to:
a) set the width property of the form such that it is affects the positioning of the child components or...
b) suggest a way to force a relayout of all child components once the form is rendered?
Tracing the code to see what happens, I came up with the below adjustment.
procedure TForm1.WMWindowPosChanging(var Message: TWMWindowPosChanging);
var
MessageWidth: Integer;
begin
MessageWidth := Message.WindowPos.cx;
inherited;
if MessageWidth > Message.WindowPos.cx then
GroupBox1.Width := GroupBox1.Width - MessageWidth + Message.WindowPos.cx;
end;
This is not a generalized solution, but it makes clear what the problem is. VCL asks for a window size for its form which is not granted by the OS since it is larger then the desktop. From then on the form resumes anchoring the child control with its design time specified width which is larger than the client width of the form, thus right side of the child control overflows.
Another solution can be to override handling of WM_GETMINMAXINFO message to let the OS grant the asked width.
procedure TForm1.WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo);
begin
inherited;
Message.MinMaxInfo.ptMaxTrackSize.X := 1200;
end;
This may not be a good solution because then the form will be larger than the desktop.
Regarding your 'a' and 'b' items, I don't think 'b' is possible - or at least not possible to make the VCL relayout by itself - because VCL defers applying anchor rules until after the component (form) is done loading. By then, the form's width is different than the design time width but child controls' placement remain unaffected. No amount of forcing to layout will make them in sync again.
However it should possible to recalculate everything from scratch if your own code keeps a reference to the design time width. Below is not complete code.
type
TForm1 = class(TForm)
..
private
FAdjustShrinkWidth, FAdjustShrinkHeight: Integer;
protected
procedure Loaded; override;
public
procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer;
AHeight: Integer); override;
end;
...
procedure TForm1.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
TrackWidth, TrackHeight: Boolean;
begin
TrackWidth := AWidth = 1200;
TrackHeight := AHeight = ??;
inherited;
if TrackWidth and (Width < AWidth) then
FAdjustShrinkWidth := AWidth - Width;
if TrackHeight and (Height < AHeight) then
FAdjustShrinkHeight := AHeight - Height;
end;
procedure TForm1.Loaded;
procedure ReadjustControlAnchors(Control: TWinControl);
var
i: Integer;
begin
for i := 0 to Control.ControlCount - 1 do
if (akRight in Control.Controls[i].Anchors) or (akBottom in Control.Controls[i].Anchors) then begin
Control.Controls[i].Left := // some complex calculation depending on the anchors set;
Control.Controls[i].Top := // same as above;
Control.Controls[i].Width := // same as above;
Control.Controls[i].Height := // same as above;
if (Control.Controls[i] is TWinControl) and (TWinControl(Control.Controls[i]).ControlCount > 0) then
ReadjustControlAnchors(TWinControl(Control.Controls[i]));
end;
end;
begin
inherited;
ReadjustControlAnchors(Self);
end;
I have no idea how to fill in the blanks in the above code. Reading and tracing VCL code may be compulsory to imitate VCL anchoring.
I can't think of anything for 'a'.
Update:
VCL has actually left a backdoor for a control to lie to its immediate children about their parent's size while they are anchoring. Documentation explains it a bit different:
UpdateControlOriginalParentSize is a protected method that updates the
original size of the parent control. It is used internally to update
the anchor rules of the control.
We can use it to tell the groupbox the intended original size.
type
TForm1 = class(TForm)
..
private
FWidthChange, FHeightChange: Integer;
protected
procedure UpdateControlOriginalParentSize(AControl: TControl;
var AOriginalParentSize: TPoint); override;
public
procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer;
AHeight: Integer); override;
end;
...
procedure TForm1.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
RequestedWidth, RequestedHeight: Integer;
begin
RequestedWidth := AWidth;
RequestedHeight := AHeight;
inherited;
if csLoading in ComponentState then begin
if RequestedWidth <> Width then
FWidthChange := Width - AWidth;
if RequestedHeight <> Height then
FHeightChange := Height - AHeight;
end;
end;
procedure TForm1.UpdateControlOriginalParentSize(AControl: TControl;
var AOriginalParentSize: TPoint);
begin
inherited;
if akRight in AControl.Anchors then
AOriginalParentSize.X := AOriginalParentSize.X - FWidthChange;
if akBottom in AControl.Anchors then
AOriginalParentSize.Y := AOriginalParentSize.Y - FHeightChange;
end;
I note again that this will affect the form's immediate children only. Should the groupbox hosts controls that anchors right and bottom, it also has to override the same method.
Also note that this will not undo the fact that the form's width has changed. That's if there was a left anchored control that's at the far right of the form, it will not replace itself to client boundary. It will act as if the form's width has been decreased, i.e. remain out of sight.
How do you get the label height to automatically adjust when resizing the form? All of the properties are set. Align is top. Autosize is true. Word wrap is true.
When I change the form size the label adjust the caption fine. However, the actual label will not resize its height.
This leaves a gap when the form width is increasing or it leaves the bottom part of the caption unreadable. Makes it ugly when you have controls below the label that should move up or down depending on the label's height.
I would hate to do this using the form's resize event. Too bad there is no form "resize end" event.
Any help? Thanks.
If I recall correctly, with Autosize set to true, the height of the label is automatically set to the actual height of the text in Caption.
You might try setting Autosize to false and see how that works for you.
I've solved by inheriting from tlabel.
there is a bug with the autosize in this case (autosize, wordwrap and alTop)
to make it recalculate it size you need to:
AutoSize := false;
AutoSize := true;
so you can override the resize procedure like that:
procedure TResizableLabel.Resize;
begin
AutoSize := false;
AutoSize := true;
end;
however if you will do it on every resize it will shrink the width also, so you will lose the width of the parent from alTop, in case it is just aligned left it will probably be ok, but if you want center or right alignment you will need a better solution.
this is the full solution, it will call the autosize only when needed:
TResizableLaber = class(TLabel)
protected
FTextHeight, FTextWidth : integer;
function GetCaption : TCaption;
procedure SetCaption(ACaption : TCaption);
function GetFont : TFont;
procedure SetFont(AFont : TFont);
public
procedure Resize; override;
property Caption : TCaption read GetCaption write SetCaption;
property Font : TFont read GetFont write SetFont;
end;
implementation
procedure TResizableLaber.Resize;
var
num : double;
begin
inherited;
if AutoSize then
begin
if (FTextHeight = 0) or (FTextWidth = 0) then
begin
//lazy evaluation, we re evaluate every time the caption or font changes
FTextWidth := Utills.GetTextWidth(Caption, Font);
FTextHeight := Utills.GetTextHeight(Caption,Font);
end;
//TODO: there is still one bug here, set alCenter and make the last word long enough so it cant always wrapped to the line before, even though there is globally enough space
num := ( Height / FTextHeight) - (FTextWidth /Width );
//if num is greater then 1 it means we need an extra line, if it is lower then zero it means there is an extra line
if (num > 1) or (num < 0) then
begin
//just doing this all the time will cause it to really resize and will break alTop matching the whole space
AutoSize := false;
AutoSize := true;
end;
end;
end;
function TResizableLaber.GetCaption : TCaption;
begin
Result := inherited Caption;
end;
procedure TResizableLaber.SetCaption(ACaption : TCaption);
begin
FTextWidth := Utills.GetTextWidth(ACaption, Self.Font);
FTextHeight := Utills.GetTextHeight(ACaption,Self.Font);
inherited Caption := ACaption;
end;
function TResizableLaber.GetFont : TFont;
begin
Result := inherited Font;
end;
procedure TResizableLaber.SetFont(AFont : TFont);
begin
FTextWidth := Utills.GetTextWidth(Caption, AFont);
FTextHeight := Utills.GetTextHeight(Caption,AFont);
inherited Font := AFont;
end;
class function Utills.GetTextHeight(const Text:String; Font:TFont) : Integer;
var
bitmap: TBitmap;
begin
bitmap := TBitmap.Create;
try
bitmap.Canvas.Font := Font;
Result := bitmap.Canvas.TextHeight(Text);
finally
bitmap.Free;
end;
end;
class function Utills.GetTextWidth(const Text:String; Font:TFont) : Integer;
var
bitmap: TBitmap;
begin
bitmap := TBitmap.Create;
try
bitmap.Canvas.Font := Font;
Result := bitmap.Canvas.TextWidth(Text);
finally
bitmap.Free;
end;
end;
I've spent quite some time to get both the wordwrap and the height of a series of labels right. The previous answer (thanks ndori), using the pointless-looking solution of first making Autosize false, followed by setting it to true is the solution!
Below my code for publishing a (long) series of labels, where the caption text is generated somewhere else and can be as short as one character up to several lines of text. So, I need a fixed label width, active wordwrap and a constant white space between all different labels.
When resizing the form the label.width (arbitrary set to 560 below) may be adjusted to fit the new form when resizing. I think the real problem is getting the label heights correctly displayed.
{ AL[] = global variable: array of TLabel
{ AL[].caption (the text) is delivered elsewhere, and can be short or long (= multiline text)
{ N_ActiveLabels = global integer variable: # of active labels to publish }
procedure PublishListOfLabels;
var
i : integer;
begin
AL[0].Top := 15; // or whatever
AL[0].Visible := true;
AL[0].Width := 560; // (re)set this here as otherwise the wordwrap makes
// the label text a long narrow column!
AL[0].AutoSize := false; // THIS IS REQUIRED!
AL[0].AutoSize := true; // THIS IS REQUIRED!
if N_ActiveLabels > 1 then begin
for i := 1 to N_ActiveLabels -1 do begin
AL[i].Visible := true;
AL[i].Width := 560;
AL[i].AutoSize := false;
AL[i].AutoSize := true;
AL[i].Top := AL[i-1].Top + AL[i-1].Height + 18;
// 18 was chosen as vertical white space between any two labels
end;
end;
end;
I found repainting (or refreshing) of the labels not needed.
I also encountered solutions like:
H := AL[i].Canvas.TextHeight(AL[i].caption);
where H is supposed to contain the real height of AL[i] (after filling its caption with text and calling PublishListOfLabels. it is NOT working.
I mention this as this solution has been proposed at several other places dealing with the same issue (getting a correct TLabel height).
[I use Berlin 10.1 - perhaps later versions have solved the Autosize.false /.true aberation]
I am trying to use TFlowPanel component in the following manner:
Place on the main form Form1 component FlowPanel1: TFlowPanel.
Set Form1.Width = 400, FlowPanel1.Align = alTop, FlowPanel1.AutoSize = True, FlowPanel1.AutoWrap = True.
Place on the FlowPanel1 5 SpeedButtons and set their Width to 64.
Compile and run.
Reduce width of the form (something about Form1.Width = 200).
For some reason, the speedbuttons do not automatically line up in two rows when user resizes the form. Although, they do line up in two rows when AutoSize = False, AutoWrap = True.
What is the reason for this behavior and how to solve it?
Edit: I've found "quick and dirty" solution. The following code is the event handler to the TFlowPanel.OnResize event:
procedure TForm1.FlowPanel1Resize(Sender: TObject);
begin
with FlowPanel1 do
begin
AutoSize := False;
Realign; // line up controls
AutoSize := True; // adjust TFlowPanel.Height
end;
end;
However, I still wonder if there is a standard way to solve the problem.
I wasn't able to find the exact reason of such behavior in code, but basically you've challenged two sizing properties to fight, the AutoSize and Align. The problem is, I think, that when you resize a form, the control with AutoSize configured to True and Align set to alTop will first try to autosize the control and then align to top of its parent. What I can tell for sure, these two properties shouldn't be combined at least from their logical meaning.
What I would suggest to your workaround is turn off the autosize by default and in OnResize event turn it temporary on and back to off to automatically adjust the height. So in code it would change simply to:
procedure TForm1.FlowPanel1Resize(Sender: TObject);
begin
// there's no Realign here, since the AlignControls request is called
// at control resize, so here you have children already aligned, what
// you then need is to request the control to autosize the height and
// turn off the autosizing to the default, disabled state
FlowPanel1.AutoSize := True;
FlowPanel1.AutoSize := False;
end;
tl,dr: It's a bug in TFlowPanel.
Normally, the AutoSize and Align properties go together very well by default since this is taken care of already at TControl level, so I wondered why this happened. I noticed an overriden AlignControls method in TFlowPanel and thought to bypass it for testing purposes:
type
TWinControlAccess = class(TWinControl);
TAlignControls = procedure(Instance: TObject; AControl: TControl;
var Rect: TRect);
TFlowPanel = class(Vcl.ExtCtrls.TFlowPanel)
protected
procedure AlignControls(AControl: TControl; var Rect: TRect); override;
end;
TForm1 = class(TForm)
...
procedure TFlowPanel.AlignControls(AControl: TControl; var Rect: TRect);
begin
// Skip TCustomFlowPanel.AlignControls
TAlignControls(#TWinControlAccess.AlignControls)(Self, AControl, Rect);
end;
procedure TForm1.FlowPanel1Resize(Sender: TObject);
begin
// Do my own aligning of the last button
if FlowPanel1.ClientWidth < Button5.BoundsRect.Right then
begin
Button5.Left := 1;
Button5.Top := Button1.Height + 1;
end
else if FlowPanel1.ClientWidth > Button4.BoundsRect.Right + Button5.Width then
begin
Button5.Left := Button4.BoundsRect.Right;
Button5.Top := 1;
end;
end;
Now, this works as expected. So what's wrong with TFlowPanel's implementation of AlignControls? It looks like the following snippet is the reason:
if AutoSize then
Rect := TRect.Create(
Rect.Left,
Rect.Top,
Rect.Left + (ExplicitWidth - (Width - (Rect.Right - Rect.Left))),
Rect.Top + (ExplicitHeight - (Height - (Rect.Bottom - Rect.Top))));
When this part is commented out, the behaviour is as expected with Align set as well as not. Now, I would like to submit this to QC, but maybe I am overlooking some of its aspects. Please edit or comment when (and then why) this code indeed is needed.
I have a "wide" TPanel with several buttons on it (essentially a tool bar). All the buttons have Align=Left. I have created a function which will resize the buttons to the same size and calculate the width of them so they fill the entire TPanel. I call this function in the OnResize event handler of the TPanel.
procedure ScaleButtonsOnPanel;
var i: Integer;
begin
for i:=0 to mPanel.ControlCount-1 do begin
mPanel.Controls[i].Width := round(mPanel.width/mPanel.ControlCount-1)
end;
end;
The problem is if I minimize and then restore the form the layout of the buttons change from the design layout.
Can anyone offer a solution to having buttons on a panel which can be resized but maintain the design time order (in terms of left to right placement) ?
I do not really see your problem. But of course, you must set the position of the buttons, not only their size.
procedure TForm1.Panel1Resize(Sender: TObject);
var
i: Integer;
btnWidth: integer;
begin
btnWidth := Panel1.Width div Panel1.ControlCount;
for i := 0 to Panel1.ControlCount - 1 do
begin
Panel1.Controls[i].Left := i * btnWidth;
Panel1.Controls[i].Width := btnWidth;
end;
end;
This works very well.
See https://privat.rejbrand.se/panelresize.wmv.
OK, now I see. I think the alLeft is actually your problem. Controls with the same align tend to change their order. This is a well-known Delphi annoyance. Do it like I do above, instead. Just make sure that you go through the buttons in the right order. If you cannot rely on the ordering of Panel1.Controls, then you can do like this: Set the Tag property of each toolbar button to its position (0, 1, ...) in the toolbar then do
procedure TForm1.Panel1Resize(Sender: TObject);
var
i: Integer;
btnWidth: integer;
begin
btnWidth := Panel1.Width div Panel1.ControlCount;
for i := 0 to Panel1.ControlCount - 1 do
begin
Panel1.Controls[i].Left := Panel1.Controls[i].Tag * btnWidth;
Panel1.Controls[i].Width := btnWidth;
end;
end;
Have you tried to see if a TFlowPanel doesn't better suit your needs?
Ok, here's the problem. I have a label component in a panel. The label is aligned as alClient and has wordwrap enabled. The text can vary from one line to several lines. I would like to re-size the height of the the panel (and the label) to fit all the text.
How do I get the necessary height of a label when I know the text and the width of the panel?
You can use the TCanvas.TextRect method, along with the tfCalcRect and tfWordBreak flags :
var
lRect : TRect;
lText : string;
begin
lRect.Left := 0;
lRect.Right := myWidth;
lRect.Top := 0;
lRect.Bottom := 0;
lText := myLabel.Caption;
myLabel.Canvas.Font := myLabel.Font;
myLabel.Canvas.TextRect(
{var} lRect, //will be modified to fit the text dimensions
{var} lText, //not modified, unless you use the "tfModifyingString" flag
[tfCalcRect, tfWordBreak] //flags to say "compute text dimensions with line breaks"
);
ASSERT( lRect.Top = 0 ); //this shouldn't have moved
myLabel.Height := lRect.Bottom;
end;
TCanvas.TextRect wraps a call to the DrawTextEx function from the Windows API.
The tfCalcRect and tfWordBreak flags are delphi wrappers for the values DT_CALCRECT and DT_WORDBREAK of the windows API. You can find detailed information about their effects in the DrawTextEx documentation on msdn
Use TextWidth and TextHeight.
See an example here:
http://www.greatis.com/delphicb/tips/lib/fonts-widthheight.html
TextWidth will tell you how wide the text would be, and then you can divide that by the control width to see how many rows you need. The remainder of the division should be an additional row.
You can use one line of code for this:
label.width := label.canvas.textwidth(label.caption);
or you can set the label's autosize property to true in the object inspector.
If you can align it alTop and keep AutoSize on then TLabel will auto adjust the height after settign the caption.
in FMX there is a trick to do that simply :
when creating a Label set Autosize := true and use the OnResize Event to update the size of the parent...
Rectangle1 := TRectangle.create(Form1);
Rectangle1.parent := Form1;
Label1 := TLabel.create(Rectangle1);
Label1.parent := Rectangle1;
Label1.Align := TAlignLayout.Top; // keep the same width and auto size parent height
Label1.OnResize := DoReSize;
Label1.WordWrap := true;
Lable1.Autosize := true;
The parent size will be updated here (assuming that the Sender object is the most bottom control in the parent, if not you need to arrange this function to summarize all the components size and verticaly)
procedure DoParentResize(Sender : TObject);
begin
TControl(TControl(Sender).parent).Height := TControl(Sender).Height + 4;
end;
if we use Label1.Align := TALignLayout.None;
then we should add the position inside the parent :
procedure DoParentResize(Sender : TObject);
begin
TControl(TControl(Sender).parent).Height := TControl(Sender).Position.Y + TControl(Sender).Height + 4;
end;
Wich result in a single function for (almost) all cases :
procedure TForm1.DoParentResize(Sender : TObject);
begin
if TControl(Sender).Align in [TAlignLayout.None, TAlignLayout.Client, TAlignLayout.Center, TAlignLayout.VertCenter ] then
begin
TControl(TControl(Sender).parent).Height := TControl(Sender).Position.Y + TControl(Sender).Height + 4;
end
else
begin
TControl(TControl(Sender).parent).Height := TControl(Sender).Height + 4;
end;
end;
You need to reduce the LRect.right by the label left and right margins, and then add the label top and bottom margins to the label height at the end or the text might not fit the label.
procedure TFrm.PatternEditTyping(Sender: TObject);
begin
(Sender as Tedit).Canvas.Font.Size := (Sender as Tedit).Font.Size;
(Sender as Tedit).Width := (Sender as Tedit).Canvas.TextWidth((Sender as Tedit).Text);
end;
This code adjusts Tedit.Width while you type inside it. Just keep the font family in Canvas and in Tedit the same.