Firemonkey hide overflow of round corners using stylebook

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:

1. 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.
2. Use clipchildren. This is almost the same as hiding overflow in html / css, but Delphi does not include rounded corners in this function.
3. 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;