如何在 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 仅在绘制单元格之前触发一次。

为了 "animate" 矩形，我使用了定时器重绘 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

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

接下来，正如我在评论中所说，您使用了错误的计算方向：

最后你没有按照你应该的那样将你的百分比除以 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% 的测试线

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

how to draw animated level bar in TVirtualStringTree?

delphi

virtualtreeview

tvirtualstringtree

delphi-xe8

编辑备注