TTreeView selection glitch while dragging a node

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?

Mycenaean

Well, I'm stumped. It doesn't happen with a TListBox, seems to be a bug in the TTreeView paint code. All I can suggest is looking for a 3rd party TreeView control. – Drear

What is the glitch? What behaviour are you trying to avoid? – Orthopedist

@TOndrej Please take a look at a last image of my post. The selection behind created bitmap stays after cursor moves. – Mycenaean

@Mycenaean I still don't understand what the problem is. "Selection stays" seems OK to me: dragging should not change the current selection. It would help if you could describe in detail what is happening and what you think should be happening instead. – Orthopedist

with delphi 2010 + I can the can not reproduce the behavior. With D7 I can, just didn't find a work around for the painting bug. – Intersection

@TOndrej The bug exists in Delphi 7 - as bummi mentioned it's the painting bug. Have you tried to reproduce it in D7? – Mycenaean

Its worth mentioning that same bug can also appear in a Delphi 2010 application. I have been able to reproduce this. – Mcmaster

@kobik I tried to use TDragControlobject but it does not change anything :( – Mycenaean

I'm catched this bag too (on Win7 with Aero). Have no idea how fix it. Thinking. Screenshot: https://i.sstatic.net/WJmd5.png – Ladylove

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)

Nobility

Yes kobik you're right - I have to combine those two methods to get desired result :) End drag is firing successfully. – Mycenaean

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;

Intersection

Yes, but it also causes control that have & in caption to vanish after clicking the ALT key :-( – Mycenaean

I added a piece of code, which might help, perhaps has to be adapted – Intersection

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.

Mcmaster

Thanks for the answer. Unfortunately that approach is not working in D7 :-( – Mycenaean

+1 Your solution worked for me even in D5 (with and without XPManifest). – Nobility

The above worked on XP. But did not worked on Win7 machine - adding XPManifest cured it. – Nobility