Firemonkey hide overflow of round corners using stylebook - delphi

Question

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

Answer 1

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;

Answer 2

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

Answer 3

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.

Answer 4

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;

Answer 5

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.