Strange mouse events

[Lenfors]

Hello!

Se my demo project below. I'm trying to handle the drag and drop functionality manually but I'm having problems with the events generated.

If I click on a node the following events are created:
Mouse down
Click
Mouse up
Mouse down
Select shape
End drag

Why do I get two Mouse down events? As it looks to my program the mousekey is now still down!?

If I want to start a drag operation, which event should I use to set the BeginDrag?
How should I terminate a drag if it begins in MouseDown and it's just a normal click (no drag)?

Regards, Mikael

Code: Select all

unit Unit12;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls, TeeProcs, TeeTree;
type
  TForm12 = class(TForm)
    Tree1: TTree;
    Log: TRichEdit;
    procedure FormCreate(Sender: TObject);
    procedure Tree1DblClick(Sender: TObject);
    procedure Tree1Click(Sender: TObject);
    procedure Tree1UnSelectShape(Sender: TTreeNodeShape);
    procedure Tree1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Tree1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Tree1DblClickShape(Sender: TTreeNodeShape; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Tree1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure Tree1EndDrag(Sender, Target: TObject; X, Y: Integer);
    procedure Tree1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure Tree1DragDropShape(Sender: TCustomTree; Dragged,
      Parent: TTreeNodeShape);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form12: TForm12;

implementation

{$R *.dfm}

procedure TForm12.FormCreate(Sender: TObject);
Var I: Integer;
begin
   for I := 0 To 99 Do
   begin
      Tree1.AddRoot('Node ' + IntToStr(I));
   end;
end;

procedure TForm12.Tree1Click(Sender: TObject);
begin
log.Lines.Add('Click');
end;

procedure TForm12.Tree1DblClick(Sender: TObject);
begin
log.Lines.Add('Dbl click');
end;

procedure TForm12.Tree1DblClickShape(Sender: TTreeNodeShape;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
log.Lines.Add('Dbl click shape');
end;

procedure TForm12.Tree1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
log.Lines.Add('Drag drop');
end;

procedure TForm12.Tree1DragDropShape(Sender: TCustomTree; Dragged,
  Parent: TTreeNodeShape);
begin
log.Lines.Add('Drag drop shape');
end;

procedure TForm12.Tree1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
log.Lines.Add('Drag over');
end;

procedure TForm12.Tree1EndDrag(Sender, Target: TObject; X, Y: Integer);
begin
log.Lines.Add('End drag');
end;

procedure TForm12.Tree1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
log.Lines.Add('Mouse down');
tree1.beginDrag(false);
end;

procedure TForm12.Tree1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
log.Lines.Add('Mouse up');
end;

procedure TForm12.Tree1UnSelectShape(Sender: TTreeNodeShape);
begin
log.Lines.Add('Select shape');
end;

end.

[Yeray]

Hi Mikael,

What I'm experiencing is a little bit different.
Here it is my testing app.

tree_drag.zip

(1.58 KiB) Downloaded 1251 times

With it, when clicking on a node, I'm getting:

MouseDown
MouseDown
SelectShape
Click
MouseUp

Adding this:

Code: Select all

Tree1.DragAndDrop.Automatic:=true;

I get:

MouseDown
MouseDown
Click
MouseUp
DragOver (...)
DragDrop
EndDrag

Is this what you are experiencing?