6

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): 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): Progressbar result

Thank you in advance!

Jan

JvA
  • 63
  • 7
  • Using your 'what does work' answer you could add a class helper which encapsulates all your ugly code in one function, making the rest of your code clean. – Dsm Feb 20 '17 at 13:49
  • Thank you for your advice. In case there is no other solution I will do it that way. – JvA Feb 20 '17 at 13:58

5 Answers5

4

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;
DNR
  • 1,619
  • 2
  • 14
  • 22
1

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

  • Thank you for your help. The second solution does not seem to work unfortunately, because when the progressbar is low (1% for example) or high the round corners will change. Maybe I do understand you wrong? How can I implement the first solution? I am affraid I have to do that in code instead of in the stylebook? – JvA Feb 20 '17 at 18:19
  • when progressbar is low (ie width < corner radius) simply hide the "orange" rectangle and add left side (+ left corners) to the "white" rectangle. it's easy if percent < 5{corner radius} then hide orange rectangle else if percent > 95 then hide white rectangle else orange rectangle.width := percent –  Feb 20 '17 at 18:34
  • In that case the whole progressbar will be filled if the status is only 96%. I will think about that, it looks like this is the best solution available. Thank you! – JvA Feb 20 '17 at 18:47
  • if it's the best solution don't forget to accept the answer because i need 50 reputation to create a bounty –  Feb 20 '17 at 19:12
1

Just use two shapes (roundrect) like this:

progress image1

progress image2

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;

Remy Lebeau
  • 555,201
  • 31
  • 458
  • 770
Nasreddine Galfout
  • 2,550
  • 2
  • 18
  • 36
  • Thank you for your help, however this is not the solution I am looking for. The blue bar's right side should be a straight line instead of a corner except at the begin and end of the whole bar. – JvA Feb 20 '17 at 18:21
1

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.

Edward
  • 247
  • 1
  • 11
0

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.

Hans
  • 2,220
  • 13
  • 33