delphi - 拖动节点时 TTreeView 选择故障

我正在对 TTreeView 实现拖放功能。在它的 OnStartDrag 事件中，我正在创建派生类的 DragOcject:

  TTreeDragControlObject = class(TDragObject)
  private
    FDragImages: TDragImageList;
    FText: String;
  protected
    function GetDragImages: TDragImageList; override;
  end;

procedure TfrmMain.tvTreeStartDrag(Sender: TObject;
  var DragObject: TDragObject);
begin
  DragObject := TTreeDragControlObject.Create;
  TTreeDragControlObject(DragObject).FText := tvTree.Selected.Text;
end;

这是我的 GetDragImages 的覆盖 DragObcject 函数:

function TTreeDragControlObject.GetDragImages: TDragImageList;
var
  Bmp: TBitmap;
begin
  if FDragImages = nil then
  begin
    FDragImages := TDragImageList.Create(nil);
    Bmp := TBitmap.Create;
    try
      Bmp.Width := Bmp.Canvas.TextWidth(FText) + 25;
      Bmp.Height := Bmp.Canvas.TextHeight(FText);

      Bmp.Canvas.TextOut(25, 0, FText);

      FDragImages.Width := Bmp.Width;
      FDragImages.Height := Bmp.Height;
      FDragImages.SetDragImage(FDragImages.Add(Bmp, nil), 0, 0);
    finally
      Bmp.Free;
    end;
  end;

  Result := FDragImages;
end;

一切正常，除了在拖动树节点时出现绘画故障:



我怎样才能避免这种行为？

最佳答案

根据@Sean 和@bummi 的回答，我将在 D5 中发布对我有用的整个代码和结论。

在 WinXP XPManifest 上，必须是 而不是 - 需要 Hide/ShowDragImage。

在 Win7 上需要 XPManifest。 Hide/ShowDragImage 是 不是 必须的。

结论 - 同时使用 XPManifest 和 HideDragImage 和 ShowDragImage 以确保电视在 XP/Win7 上都能正常工作。

type
  TTreeDragControlObject = class(TDragControlObject)
  private
    FDragImages: TDragImageList;
    FText: String;
  protected
    function GetDragImages: TDragImageList; override;
  public
    destructor Destroy; override;
    procedure HideDragImage; override;
    procedure ShowDragImage; override;
    property DragText: string read FText write FText;
  end;

  TForm1 = class(TForm)
    TreeView1: TTreeView;
    procedure TreeView1StartDrag(Sender: TObject; var DragObject: TDragObject);
    procedure TreeView1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
    procedure TreeView1EndDrag(Sender, Target: TObject; X, Y: Integer);
  private
    FDragObject: TTreeDragControlObject;
  public
  end;

...

{ TTreeDragControlObject}
destructor TTreeDragControlObject.Destroy;
begin
  FDragImages.Free;
  inherited;
end;

procedure TTreeDragControlObject.HideDragImage;
begin
  GetDragImages.HideDragImage;
end;

procedure TTreeDragControlObject.ShowDragImage;
begin
  GetDragImages.ShowDragImage;
end;

function TTreeDragControlObject.GetDragImages: TDragImageList;
var
  Bmp: TBitmap;
begin
  if FDragImages = nil then
  begin
    FDragImages := TDragImageList.Create(nil);
    Bmp := TBitmap.Create;
    try
      Bmp.Width := Bmp.Canvas.TextWidth(FText) + 25;
      Bmp.Height := Bmp.Canvas.TextHeight(FText);
      Bmp.Canvas.TextOut(25, 0, FText);
      FDragImages.Width := Bmp.Width;
      FDragImages.Height := Bmp.Height;
      FDragImages.SetDragImage(FDragImages.Add(Bmp, nil), 0, 0);
    finally
      Bmp.Free;
    end;
  end;
  Result := FDragImages;
end;

{ TForm1 }
procedure TForm1.TreeView1StartDrag(Sender: TObject; var DragObject: TDragObject);
begin
  FDragObject := TTreeDragControlObject.Create(TTreeView(Sender));
  FDragObject.DragText := TTreeView(Sender).Selected.Text;
  DragObject := FDragObject;
end;

procedure TForm1.TreeView1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept := Source is TTreeDragControlObject;
end;

procedure TForm1.TreeView1EndDrag(Sender, Target: TObject; X, Y: Integer);
begin
  FDragObject.Free;
end;

请注意，在您的代码中 FDragImages 和 var DragObject 都在泄漏内存。我建议使用 TDragControlObject 而不是 TDragObject(您的 tvTreeEndDrag 现在是否完全触发？ - 它没有为我触发)

关于delphi - 拖动节点时 TTreeView 选择故障，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/13623298/