delphi - 如何在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% 进度的 block 数
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;