delphi - TVirtualDrawTree - 如何将节点放置在一行中？

标签 delphi delphi-xe8 virtualtreeview tvirtualstringtree

这是我的其他问题 Here 的后续问题.

正如我在评论中建议提出有关此主题的新问题

有人建议我在 Row 中绘制不同的图像。我从一开始的目标就是并排插入节点，我被告知这不能用 VDT 来完成，它不是为此目的而制作的。但是什么让我确信有办法，因为我看到一个在线项目使用相同的 VDT 来做到这一点

这是该项目的屏幕截图

enter image description here

使用资源查看器(例如 PE 资源管理器)我发现了以下形式的数据

    object VDT: TVirtualDrawTree
      AlignWithMargins = True
      Left = 5
      Top = 5
      Width = 457
      Height = 227
      Margins.Left = 5
      Margins.Top = 5
      Margins.Right = 5
      Margins.Bottom = 5
      Align = alClient
      BevelInner = bvNone
      BevelOuter = bvNone
      DefaultNodeHeight = 55
      Header.AutoSizeIndex = 0
      Header.Font.Charset = DEFAULT_CHARSET
      Header.Font.Color = clWindowText
      Header.Font.Height = -11
      Header.Font.Name = 'Tahoma'
      Header.Font.Style = []
      HotCursor = crHandPoint
      TabOrder = 0
      TreeOptions.PaintOptions = [toHideFocusRect, toHideSelection, toHotTrack, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages, toAlwaysHideSelection, toUseBlendedSelection]
      TreeOptions.SelectionOptions = [toExtendedFocus, toMiddleClickSelect, toRightClickSelect]
      OnBeforeCellPaint = VDTBeforeCellPaint
      OnGetNodeWidth = VDTGetNodeWidth
      OnMouseUp = VDTMouseUp
      ExplicitLeft = 3
      ExplicitTop = 3
      Columns = <
        item
          Position = 0
          Width = 54
          WideText = '55'
        end
        item
          Position = 1
          Width = 54
          WideText = '55'
        end
        item
          Position = 2
          Width = 54
          WideText = '55'
        end
        item
          Position = 3
          Width = 54
          WideText = '55'
        end
        item
          Position = 4
          Width = 54
          WideText = '55'
        end
        item
          Position = 5
          Width = 54
          WideText = '55'
        end
        item
          Position = 6
          Width = 54
          WideText = '55'
        end
        item
          Position = 7
          Width = 54
          WideText = '55'
        end>
    end
  end

所以我告诉自己，我必须使用Tviruaildrawtree来实现相同的目标，然后我开始创建数据

type
  TAnmiClass = class
  private
    Fanmigraphic : TGifImage;

  public
    property anmigraphic: TGifImage read Fanmigraphic write Fanmigraphic;

  public
    constructor Create;
    destructor Destroy; override;
  end;

type
  PAnimeData = ^TAnimeData;

  TAnimeData = record
    FObject: TAnmiClass;
  end;

因为我认为我必须为节点创建图像对象，因为我将从 url 下载一些图像列表，然后将它们添加到节点，如下所示，因此以下代码将图像从字符串列表下载到桌面然后加载它到节点 Tgifimage

For i := 0 To animationimages.Count-1 do
begin
Animaturl := animationimages.Strings[i];

URI := TIdURI.Create(Animaturl);
try
ImageName := URI.Document;
finally
FreeAndNil(URI);
end;

if (ExtractFileExt(ImageName) = '.gif') then
begin
addanimation(Animaturl);
end;
end;

procedure TForm2.addanimation(AAnimationUrl: String);
var
AnmiClass: TAnmiClass;
path: string;
begin

VDTAni.BeginUpdate;
try
AnmiClass := TAnmiClass.Create;

path := AAnimationUrl;

if fileexists(path) then
begin
AnmiClass.anmigraphic.LoadFromFile(path);
AnmiClass.anmigraphic.Animate := True;
AnmiClass.anmigraphic.Transparent := True;
end;

AddAnmiToVD(VDTAni, nil, AnmiClass);

finally
VDTAni.EndUpdate;
end;

这是我如何在 VDT 内绘制节点

procedure TForm2.VDTAniBeforeCellPaint(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
var
Data: PAnimeData;
NewRect: TRect;
R: TRect;
begin
//
if not Assigned(Node) then
begin
exit;
end;

Data := VDTAni.GetNodeData(Node);

case Column of

0 :
begin
NewRect := ContentRect;
NewRect.Left := NewRect.Left +2;
NewRect.Width := 55;
NewRect.Height := 55;
NewRect.Top := NewRect.Top + 2;
NewRect.Bottom := NewRect.Bottom;
TargetCanvas.StretchDraw( NewRect, Data.FObject.anmigraphic);
end;

end;
end;

但我无法将节点排列为与上面显示的图像相同

似乎它不能在 onbeforecellpanit 中制作。

在我的另一个问题中，Tom Brunberg 建议将图像划分为 10 个节点，例如，如果添加的图像为 80 个，并且每行需要 8 个节点，每个节点有 8 个图像，并且每个图像都显示在其自己的专栏。但我不知道如何在编码中做到这一点或从哪里开始。

当前代码的问题 

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, VirtualTrees, Gifimg, Vcl.StdCtrls,
  Vcl.Grids, Vcl.ExtCtrls;


type
  TImageOBJArr = array of TGifimage;


type
  TaniDataclass = class
  ImageOBJArr: TImageOBJArr;
  private
    FAnirefrence: String;
    FAniIMage: TGifimage;
  public
    property Anirefrence: String read FAnirefrence write FAnirefrence;
    property AniIMage: TGifImage read FAniIMage write FAniIMage;

  public
    constructor Create;
    destructor Destroy; override;
  end;

type
Panidata = ^Tanidata;

Tanidata = record
FObject: TaniDataclass;
end;






type
  TForm1 = class(TForm)
    VDTani: TVirtualStringTree;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure VDTaniBeforeCellPaint(Sender: TBaseVirtualTree;
      TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
      CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
    procedure FormCreate(Sender: TObject);
    procedure VDTaniFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
    procedure VDTaniGetNodeDataSize(Sender: TBaseVirtualTree;
      var NodeDataSize: Integer);
  private
    { Private declarations }
   ImageOBJArr: TImageOBJArr;  // Main storage of images
  public
    { Public declarations }
      Dimagelist : Tstringlist;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TaniDataclass }

constructor TaniDataclass.Create;
begin
FAniIMage := TGifImage.Create;
end;

destructor TaniDataclass.Destroy;
begin
FAniIMage.Free;
  inherited;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Node: PVirtualNode;
  Data: Panidata;
  i, row, col: integer;
  fn: String;
begin

  // Load images to main store ImgArr
SetLength(ImageOBJArr, Dimagelist.Count);

for i := 0 to Dimagelist.Count -1 do
begin
fn := Dimagelist[I];
ImageOBJArr[i] := TGifimage.Create;
ImageOBJArr[i].LoadFromFile(fn);
end;

  // Setup vdt nodes and assign images eight in a row
  // hardcoded for now. You may want to add dynamics
  // for varying window and image sizes
  row := 0;
  while row <= (Dimagelist.Count div 8) do
  begin
    Node := VDTani.AddChild(nil);
    Data := VDTani.GetNodeData(Node);
    SetLength(Data.FObject.ImageOBJArr, 8);
    for col := 0 to 7 do
      Data.FObject.ImageOBJArr[col] := ImageOBJArr[row * 8 + col];
    inc(row);
  end;

end;


procedure TForm1.FormCreate(Sender: TObject);
begin
Dimagelist :=  Tstringlist.Create;
VDtAni.NodeDataSize := SizeOf(Tanidata);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(Dimagelist) then
begin
  FreeAndNil(Dimagelist);
end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin

Dimagelist.Add('1mm.gif');
Dimagelist.Add('2mm.gif');
Dimagelist.Add('3mm.gif');
Dimagelist.Add('4mm.gif');
Dimagelist.Add('5mm.gif');
Dimagelist.Add('6mm.gif');


end;

procedure TForm1.VDTaniBeforeCellPaint(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
var
  Data: Panidata;
begin
if not Assigned(Node) then
begin
exit;
end;

  Data := VDTani.GetNodeData(Node);
  Sender.NodeHeight[Node] := 54;
  CellRect.Height := 54;

  TargetCanvas.StretchDraw( CellRect, Data.FObject.ImageOBJArr[Column]);
end;

procedure TForm1.VDTaniFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
var
Data: Panidata;
begin
Data := VDTani.GetNodeData(Node);
if Assigned(Data) then
Data.FObject.Free;
end;
procedure TForm1.VDTaniGetNodeDataSize(Sender: TBaseVirtualTree;
  var NodeDataSize: Integer);
begin
NodeDataSize := SizeOf(Tanidata);
end;

end.

我在以下代码中遇到异常，我向字符串列表添加了 6 个图像路径，然后尝试在每一列上绘制

row := 0;
  while row <= (Dimagelist.Count div 2) do
  begin
    Node := VDTani.AddChild(nil);
    Data := VDTani.GetNodeData(Node);
    SetLength(Data.FObject.ImageOBJArr, 2);
    for col := 0 to 7 do
      Data.FObject.ImageOBJArr[col] := ImageOBJArr[row * 2 + col];
    inc(row);
  end;

最佳答案

这是我建议的实现。

type
  TImgArr = array of TBitmap;

  TVdtData = record
    FObject: TimgArr;
  end;
  PVdtData = ^TVdtData;

  TForm2 = class(TForm)
    Vdt: TVirtualDrawTree;
    ...
  private
    { Private declarations }
    ImgArr: TImgArr;  // Main storage of images

implementation

procedure TForm2.Button1Click(Sender: TObject);
var
  Node: PVirtualNode;
  Data: PVdtData;
  p: pointer;
  i, row, col: integer;
  fn: TFileName;
begin
  // Load images to main store ImgArr
  SetLength(ImgArr, 100);
  for i := 0 to 99 do
  begin
    fn := Format('c:\tmp\nums\%.2d.bmp',[i]);
    ImgArr[i] := TBitmap.Create;
    ImgArr[i].LoadFromFile(fn);
  end;

  // Setup vdt nodes and assign images eight in a row
  // hardcoded for now. You may want to add dynamics
  // for varying window and image sizes
  row := 0;
  while row <= (100 div 8) do
  begin
    Node := Vdt.AddChild(nil);
    p := Node.GetData;
    Data := Vdt.GetNodeData(Node);
    // SetLength(Data.FObject, 8);
    SetLength(Data.FObject, Vdt.Header.Columns.Count);
    for col := 0 to 7 do
      Data.FObject[col] := ImgArr[row * 8 + col];
    inc(row);
  end;
end;

procedure TForm2.VdtBeforeCellPaint(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
var
  Data: PVdtData;
begin
  if not Assigned(Node) then exit;

  Data := Vdt.GetNodeData(Node);
  Sender.NodeHeight[Node] := 64;
  CellRect.Height := 64;

  if Assigned(Data.FObject[Column]) then
    TargetCanvas.StretchDraw( CellRect, Data.FObject[Column]);
end;

不保证不存在错误。

结果

enter image description here

但说实话，正如其他人指出的那样，仅使用 TDrawGrid 或 TStringGrid 会容易得多。当然，这是你的决定。

关于delphi - TVirtualDrawTree - 如何将节点放置在一行中？，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/38828254/

上一篇：delphi - 如何删除 wsNormal 全屏表单标题栏内容偏移？

下一篇：delphi - 如何在TVirtualStringTree中绘制动画水平条？

相关文章：

delphi - 将 ASM 指令 RDRand 转换为 Win64

德尔福XE2 : Why FireMonkey apps are HD?

delphi - 移植 C 联合

android - TlistView OnItemClick 在 iOS 上选择第一条记录

Delphi xe8 错误读取从 Delphi 7 版本创建的文本文件，反之亦然

android - 如何正确释放 Firemonkey 控件，在本例中是带有父项的子窗体？

delphi - 如何克隆 TPopupMenu 的菜单项？

delphi - Delphi 的虚拟 TreeView 中的快速滚动

delphi - Devexpress ExpressQuantumTreeList 与虚拟 TreeView ？

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

©2024 IT工具网  联系我们