TTreeView selection glitch while dragging a node - delphi

Question

I'm implementing drag-and-drop functionality to a TTreeView. On a OnStartDrag Event of it, I'm creating the DragOcject of my derived class:
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;
And this is my override GetDragImages function of my 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;
Everything works fine except it has a painting glitch while dragging over the tree nodes:
How can I avoid this behavior?

Answer 1

Based on #Sean's and #bummi's answers I would post the entire code and conclusions that worked for me in D5.
On WinXP XPManifest is not a must - Hide/ShowDragImage are needed.
On Win7 XPManifest is needed. Hide/ShowDragImage are not a must.
Conclusion - use both XPManifest and HideDragImage and ShowDragImage to ensure TV will work both on 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;
Note that in your code both FDragImages and var DragObject are leaking memory. I'd suggest using TDragControlObject instead of TDragObject (does your tvTreeEndDrag fire at all now? - it did not fire for me)

Answer 2

Using TXPManifest fixes this bug in D7.
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, XPMan, ComCtrls;
additional:
procedure Win7UpdateFix(Form: TForm; CharCode: Word);
var i: Integer;
begin
if Assigned(Form) and (Win32MajorVersion >= 6) and (Win32Platform = VER_PLATFORM_WIN32_NT) then //Vista, Win7
begin
case CharCode of
VK_MENU, VK_TAB: //Alt or Tab
begin
for i := 0 to Form.ComponentCount-1 do
begin
if Form.Components[i] is TWinControl then
begin
//COntrols that disappear - Buttons, Radio buttons, Checkboxes
if (Form.Components[i] is TButton)
or (Form.Components[i] is TRadioButton)
or (Form.Components[i] is TCheckBox) then
TWinControl(Form.Components[i]).Invalidate;
end;
end;
end;
end;
end;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=VK_MENU then
begin
Win7UpdateFix(Self,key)
end;
end;

Answer 3

This same behaviour occurs in Delphi 2010 and TXPManifest does not fix it. By co-incidence I recently and independently came across this same problem in a Delphi 2010 application. The solution is to implement the HideDragImage()/ShowDragImage() methods like so ...
TTreeDragControlObject = class(TDragObject)
private
FDragImages: TDragImageList;
FText: String;
protected
function GetDragImages: TDragImageList; override;
public
procedure HideDragImage; override;
procedure ShowDragImage; override;
end;
... and then ...
procedure TTreeDragControlObject.HideDragImage;
begin
FDragImages.HideDragImage
end;
procedure TTreeDragControlObject.ShowDragImage;
begin
FDragImages.ShowDragImage
end;
The conseequence of this is that the windows API function ImageList_DragShowNolock() is called just before and after the drag image is painted ( via windows message TVM_SELECTITEM( TVGN_DROPHILITE)) . Without this function being called, the drag image is not properly painted. The need for ImageList_DragShowNolock(False/True) delimiting TVM_SELECTITEM+TVGN_DROPHILITE is a poorly documented feature, and if other forums are to judge, is a common cause for complaint.