delphi – TTreeView在拖动节点时选择毛刺

发布时间：2020-12-15 03:33:55 所属栏目：大数据来源：网络整理

导读：我正在向TTreeView实现拖放功能.在OnStartDrag事件上,我创建了我的派生类的DragOcject： TTreeDragControlObject = class(TDragObject) private FDragImages: TDragImageList; FText: String; protected function GetDragImages: TDragImageList; override;

我正在向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;

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

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,FText);

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

  Result := FDragImages;
end;

一切都可以正常工作,除了在拖动树节点时有一个绘画毛刺：

如何避免这种行为？

解决方法

基于@ Sean和@ bummi的答案,我将发布在D5中为我工作的整个代码和结论.

在WinXP XPManifest不是必须的 – 需要隐藏/ 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,FText);
      FDragImages.Width := Bmp.Width;
      FDragImages.Height := Bmp.Height;
      FDragImages.SetDragImage(FDragImages.Add(Bmp,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,Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept := Source is TTreeDragControlObject;
end;

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

请注意,在您的代码中,FDragImages和var DragObject都会泄漏内存.我建议使用TDragControlObject而不是TDragObject(现在你的tvTreeEndDrag是否火灾？ – 它没有为我开火)

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!