TStatusBar with bottom aligned panel - delphi

I have a form with a TStatusBar, and bottom aligned TPanel, a bottom aligned TSplitter and client aligned TPanel, as shown in the following screenshot:
(The splitter is coloured red to make it a little more obvious)
Button1 simply increases the height of Panel1 by 20:
Panel1.Height := Panel1.Height + 20;
But when clicked the order of the controls changes, with Panel1 being blow the status bar and the splitter is now resizing the status bar.
This only happens when the height of Panel1 is increased by more than the height of StatusBar1 (19).
I assume this is caused by having two bottom aligned controls, but I'm at a loss as to the exact cause of the problem and how to work around it.
I'm currently using XE2, but I have the same issue with D2010.
In this situation is there a way to set the height of Panel1 to an arbitrary value, while ensuring that the controls maintain their expected positions?

Work around the problem by setting the Top property for the controls after changing the panel height.
StatusBar1.Top := Panel1.Top + Panel1.Height;

Try this (worked fine for me):
procedure TForm1.Button1Click(Sender: TObject);
begin
Panel1.SetBounds(Panel1.Left, Panel1.Top - 20,
Panel1.Width, Panel1.Height + 20);
end;

Alternatively, if you don't want to keep track of where you're changing position/size of controls,
type
TForm1 = class(TForm)
..
private
protected
procedure AlignControls(AControl: TControl; var Rect: TRect); override;
..
procedure TForm1.AlignControls(AControl: TControl; var Rect: TRect);
begin
inherited;
if AControl = Panel1 then
StatusBar1.Top := Panel1.Top + Panel1.Height;
end;

Related

Firemonkey hide overflow of round corners using stylebook

In firemonkey I am trying to make a progressbar using rectangles with round corners. The simplest case is a rectangle (the progressbar) and the second rectangle inside it (progress till now). Attached a simple example is provided.
Progressbar with corners (paint):
I've tried the following things:
Let the second rectangle also have rounded corners. This doesn't work because these roundings will change if the second rectangle is very short or almost at the end.
Use clipchildren. This is almost the same as hiding overflow in html / css, but Delphi does not include rounded corners in this function.
Create a TPath in which the image should be drawn. I really like to avoid this solution, because it doesn't use the stylebook. I prefer using one stylebook for all styles, instead of using multiple places in the code for style solutions.
What does work:
There is one really ugly method to make this work. I use that method now, but I really hope you can help me find another solution. The ugly method is:
Just use one rectangle. Fill it with a gradient brush, set the two gradient point at the same place and make the gradient itself 0 degrees. The result of this method is a lot of ugly code when I've to change the status of the progressbar etc.
Is this something we can avoid, or is this the only solution that is possible?
Progressbar goal (paint):
Thank you in advance!
Jan
I'm not sure what you mean by
Use clipchildren. This is almost the same as hiding overflow in html / css, but Delphi does not include rounded corners in this function.
I got this to work by using one Rectangle for the border; on top of that a Layout for the progress, which contains another Rectangle. The second Rectangle always has the dimensions of the first (which means the corners look the same), the Layout's ClipChildren is set to true, and the progress is controlled by setting its Width.
Here's how I implemented it:
type
TRoundProgressBar = class (TLayout)
strict private
FProgress: Single;
FFill: TBrush;
FStroke: TStrokeBrush;
StrokeRect, FillRect: TRectangle;
FillLayout: TLayout;
procedure SetFill(const Value: TBrush);
procedure SetStroke(const Value: TStrokeBrush);
procedure FillChanged(Sender: TObject);
procedure StrokeChanged(Sender: TObject);
procedure SetProgress(Progress: Single);
procedure UpdateWidths;
protected
procedure Resize; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Fill: TBrush read FFill write SetFill;
property Stroke: TStrokeBrush read FStroke write SetStroke;
property Progress: Single read FProgress write SetProgress;
end;
implementation
constructor TRoundProgressBar.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FFill := TBrush.Create(TBrushKind.Solid, $FFE0E0E0);
FFill.OnChanged := FillChanged;
FStroke := TStrokeBrush.Create(TBrushKind.Solid, $FF000000);
FStroke.OnChanged := StrokeChanged;
FillLayout := TLayout.Create(self);
FillLayout.Parent := self;
FillLayout.Align := TAlignLayout.Left;
FillLayout.ClipChildren := true;
FillRect := TRectangle.Create(FillLayout);
FillRect.Parent := FillLayout;
FillRect.Align := TAlignLayout.Left;
FillRect.XRadius := 15;
FillRect.YRadius := 15;
StrokeRect := TRectangle.Create(self);
StrokeRect.Parent := self;
StrokeRect.Align := TAlignLayout.Contents;
StrokeRect.XRadius := 15;
StrokeRect.YRadius := 15;
StrokeRect.Fill.Kind := TBrushKind.None;
end;
destructor TRoundProgressBar.Destroy;
begin
FFill.Free;
FStroke.Free;
inherited;
end;
procedure TRoundProgressBar.SetFill(const Value: TBrush);
begin
FFill.Assign(Value);
end;
procedure TRoundProgressBar.SetProgress(Progress: Single);
begin
FProgress := Min(Max(Progress, 0), 100);
UpdateWidths;
end;
procedure TRoundProgressBar.FillChanged(Sender: TObject);
begin
FillRect.Fill.Assign(FFill);
end;
procedure TRoundProgressBar.Resize;
begin
inherited;
UpdateWidths;
end;
procedure TRoundProgressBar.SetStroke(const Value: TStrokeBrush);
begin
FStroke.Assign(Value);
end;
procedure TRoundProgressBar.StrokeChanged(Sender: TObject);
begin
StrokeRect.Stroke.Assign(FStroke);
end;
procedure TRoundProgressBar.UpdateWidths;
begin
FillRect.Width := Width;
FillLayout.Width := Width * (FProgress / 100);
Repaint;
end;
Exactly clipchildren can not work, because it's use the bounding box of the control (so a Rectf). however what you can do :
1) override the onpaint of the trectangle (it's quite simple)
2) Use 2 Trectangles (call them orange and white), on the first tRectangle (orange) you set to not draw the left sides (via the Sides property of Trectangle) and of the second Trectangle (white) you set to not draw the right sides (also via the sides property). put these 2 Trectangles inside a Tlayout (or any other container you would like), set the align of the second Trectangle (white) to all, and the align of the first Trectangle (orange) to ALleft. after you just need to say MyOrangeRect.width := XX where xx the amount of your progress relative to the with of the container off course
I like to chip in with another solution with just one TRectangle:
Just add a TRectangle, set your borders, corners and set the fill property to TBitmap.
Now you can create a TBitmap with a color (with the width as progress) to the fill.bitmap.bitmap (notice the double bitmap) property at runtime.
Your corners are still respected.
extra: You can also use a one vertical line bitmap created in photoshop with a nice glow/color effect like the IOS battery progress bar and stretch that in your TRectangle.
Just use two shapes (roundrect) like this:
procedure TForm4.SpinBox1Change(Sender: TObject);
begin
roundrect2.Width:=strtoint(SpinBox1.Text);
end;
And change the width property of the upper shape when ever you want to progress more;
When a TRectangle is painted internally it actually creates a path.
The best solution for you would be to make a custom component, which contains two TPathData (call them e.g. PathBackground and PathFill), that are recalculated when the percentage changes and when it is resized.
In the Paint routine I would paint this way
Canvas.FillPath(PathBackground, ...);
Canvas.FillPath(PathFill, ...);
Canvas.DrawPath(PathBackground, ...);
By drawing the edge as the last thing, you avoid rendering errors.

Why is my Delphi form control cropped when my form is bigger than my screen?

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.

Delphi element alignment - center

There seems to be align property that works really well, but is is possible to align element so all elements on panel would be aligned to center all on bottom of each other if they all have less than size of container? Something like top-center-center.
Something like this:
Or at least horizontally, and vertically they can have 100%.
Put the elements into their own container, such as a TPanel or TFrame, that is a child of your main container. Set the child container's Align property to alCustom and use the parent container's OnAlignPosition event to keep the child container centered to itself:
// Panel1 is the Parent container for the child panel...
procedure TMyForm.Panel1AlignPosition(Sender: TWinControl; Control: TControl;
var NewLeft, NewTop, NewWidth, NewHeight: Integer; var AlignRect: TRect;
AlignInfo: TAlignInfo);
begin
if Control = ChildPanel then
begin
NewLeft := AlignRect.Left + ((AlignRect.Width - Control.Width) div 2);
NewTop := AlignRect.Top + ((AlignRect.Height - Control.Height) div 2);
end;
end;
There is no need for coding anything. Just place panels and other visual objects in the right way an set the properties of the visual objects as shown here:
Align: alNone or alCustom
and
Anchors: none (akLeft=False, akTop=False, akRight=False, akBottom=False)
Than and an object will stay at its relative horizontal and vertical position. If you place it in the middle in a container it will stay centered.
To center it only vertical set
Align: alNone or alCustom
and
Anchors: akTop=True OR akBottom=True
To center it only horizontal set
Align: alNone or alCustom
and
Anchors: akLeft=True OR akRight=True
You can center the control with this little procedure
procedure CenterControl( AControl : TControl );
begin
if Assigned( AControl.Parent )
then
begin
// remove alignment
AControl.Align := alNone;
// remove the anchors
AControl.Anchors := [];
// center on parent
AControl.Left := ( AControl.Parent.ClientWidth - AControl.Width ) div 2;
AControl.Top := ( AControl.Parent.ClientHeight - AControl.Height ) div 2;
end
else
raise Exception.Create( 'Control needs a Parent!' );
end;
If the parent gets resized the control will always be centered, as long as you did not change its size.
In RAD 10+ there is control TRelativePanel which has AlignVerticalCenterWithPanel and AlignHorisontalCenterWithPanel life-save options (and other useful capabilities).
You can also position invisilble line or dot in the center and build other controls around it with TRelativePanel provided properties Above/Below/etc.
Worth to mention, control is made on top level Embarcadero quality standards (crashes only in design mode).

Conflicting AutoSize and AutoWrap in TFlowPanel

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.

Resizing buttons so they are all the same width

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?

Resources