how to draw animated level bar in TVirtualStringTree?

Question

I am targeting to draw a custom animated progress bar in VST

My goal is drawing a similar result as image below, I tried to do something like this OnBeforeCellPaint:

procedure TForm2.VTs1BeforeCellPaint(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
var
  NewRect : TRect;
  xOff, yOff : Integer;
  ProgressBarRect: TRect;
  Percents: Real;
  DrawProgressBar: Boolean;
begin
  //draw progress
  Percents := 10; // 40%
  // progressBar on Column 3
  begin
  // draw progressbar
    ProgressBarRect.Left := 0;
    ProgressBarRect.Top := CellRect.Top + 1;
    ProgressBarRect.Right := round((CellRect.Right - CellRect.Left) * Percents)  + CellRect.Left;
    ProgressBarRect.Bottom := CellRect.Bottom - 1;
    if (ProgressBarRect.Right - ProgressBarRect.Left) > 0 then
    begin
      TargetCanvas.Brush.Color := RGB(179,255,102);
      TargetCanvas.FillRect(ProgressBarRect);
    end;
  // ProgressBarRect
    inc(ProgressBarRect.Left);
    inc(ProgressBarRect.Top);
    dec(ProgressBarRect.Right);
    dec(ProgressBarRect.Bottom);
    if (ProgressBarRect.Right - ProgressBarRect.Left) > 0 then
    begin
      TargetCanvas.Brush.Color := RGB(221,255,187);
      TargetCanvas.FillRect(ProgressBarRect);
    end;
  end; 
end;

but I can't do the same result and reach the same approach as the image which follows:

That's the result I've got in coding:

The progress bars are coming along to the node not beside it and its not same design as showing in the image it comes yellow long back ground of the node I wanted to make it in the left side of the node and have the same design of the animated image that I've posted above.

Answer 1

OnBeforeCellPaint triggers only once, before the cell is painted.

I've used a timer to repaint the VST in order to "animate" the rect.

Notice that Percents is a decimal, not a percentage value, so 100% is 1.

A very basic demo follows:

private
  Percents: Real;

. . .

implementation

procedure TForm2.FormCreate(Sender: TObject);
begin
  Percents := 0;
  VirtualStringTree1.AddChild(nil);
end;

procedure TForm2.Timer1Timer(Sender: TObject);
begin
  if Percents > 1 then
    Percents := 0
  else
    Percents := Percents + 0.025;

  VirtualStringTree1.Repaint;
end;

procedure TForm2.VirtualStringTree1BeforeCellPaint(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
const
  CPROGBARWIDTH = 30;//rect width
  CPROGBARSTEPS = 6;//how many rect is 100%
var
  r: TRect;
  h, n: Integer;
begin
  if Percents > 1 then
    Percents := 1
  else if Percents = 0 then
    Exit;//nothing to draw

  h := Round(CellRect.Height / CPROGBARSTEPS) - 1;

  r.Top := CellRect.bottom - h - 1;
  r.Left := 1;{align left}
  //r.Left := CellRect.Right - CPROGBARWIDTH - 1;{align right}
  r.Width := CPROGBARWIDTH;

  TargetCanvas.Brush.Color := clSkyBlue;

  n := Ceil(Percents * CPROGBARSTEPS);//how many rect to draw?

  while n > 0 do begin
    r.Height := h;
    TargetCanvas.FillRect(r);
    Dec(r.Top, 1 + h);
    Dec(n);
  end;
end;

---

August Holidays Bonus AKA "100% non-animated rect on the left side of the animated one"

This draws something similar to the animated GIF in the question.

Here a nested routine is used.

procedure drawProgress(AWidth: Integer; APercent: Real; ASteps: Integer; ALeft: Integer = 1);

AWidth the rectangle width
APercent the progress percentage
ASteps number of chunks which make the full 100% progress
ALeft horizontal coordinate of the upper-left corner point of the rectangle

procedure TForm2.VirtualStringTree1BeforeCellPaint(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);

  procedure drawProgress(AWidth: Integer; APercent: Real; ASteps: Integer; ALeft: Integer = 1);
  var
    r: TRect;
    h, n: Integer;
  begin
    if APercent > 1 then
      APercent := 1
    else if APercent = 0 then
      Exit;//nothing to draw

    h := Round(CellRect.Height / ASteps) - 1;

    r.Top := CellRect.bottom - h - 1;
    r.Left := ALeft;
    r.Width := AWidth;

    TargetCanvas.Brush.Color := clSkyBlue;

    n := Ceil(APercent * ASteps);//how many rect to draw?

    while n > 0 do begin
      r.Height := h;
      TargetCanvas.FillRect(r);
      Dec(r.Top, 1 + h);
      Dec(n);
    end;
  end;

begin
  drawProgress(10,        1, 7);
  drawProgress(30, Percents, 7, 1 + 10 + 1);
end;