如何在 TVirtualStringTree 中绘制动画水平条？

Question

我的目标是在VST中绘制一个自定义动画进度条

我的目标是绘制与下图类似的结果，我尝试做这样的事情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;

但我无法获得与下图相同的结果并达到相同的方法：

这就是我在编码中得到的结果：

进度条出现在不在它旁边的节点上，它的设计与图像中显示的不同我在上面发布的动画图像的设计。

Answer 1

OnBeforeCellPaint 仅在绘制单元格之前触发一次。

我使用了一个计时器来重新绘制 VST 以“动画化”矩形。

注意Percents 是小数，而不是百分比值，所以100% 是1。

一个非常基本的演示如下：

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;

---

八月假期奖励 又名“动画左侧的 100% 非动画矩形”

这会绘制类似于问题中的动画 GIF 的内容。

这里使用了嵌套例程。

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

AWidth矩形宽度
APercent进度百分比
ASteps完全100%进度的块数
ALeft左上角点的水平坐标矩形

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;

Answer 2

首先，您需要增大单元格（行）的高度。我假设你知道该怎么做。

接下来，正如我在 cmets 中所说，您使用错误的方向进行计算：

最后，你没有按你应该的方式除以 100！

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% // for testing?
  // progressBar on Column 3
  begin
  // draw progressbar
    ProgressBarRect.Left := 0;
    ProgressBarRect.Top := round((CellRect.Top - CellRect.Bottom) * Percents/100)  + CellRect.Bottom;
    ProgressBarRect.Right := 30;
    ProgressBarRect.Bottom := CellRect.Bottom - 1;
    if (ProgressBarRect.Top - ProgressBarRect.Bottom) > 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.Top - ProgressBarRect.Bottom) > 0 then
    begin
      TargetCanvas.Brush.Color := RGB(221,255,187);
      TargetCanvas.FillRect(ProgressBarRect);
    end;
  end; 
end;

编辑注释

更新删除了将大小固定为 10% 的测试线