einfaches Drag & Drop und MouseUp

[Alex_ITA01]

Hallo,
ich habe schon zum Drag&Drop einiges gelesen und mitbekommen, dass es dann Probleme mit dem MouseUp gibt, wenn man dieses auch benötigt.

Delphi-Quellcode:

type
  TForm1 = class(TForm)
    Label1: TLabel;
    ListBox1: TListBox;
    procedure Label1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Label1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
    StartDragging: Boolean;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  StartDragging := False;
end;

procedure TForm1.Label1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  StartDragging := True;
  Label1.BeginDrag(False, 8);
  StartDragging := False;
end;

procedure TForm1.Label1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if StartDragging then
  begin
    ShowMessage('StartDragging=True');
    Exit;
  end;

  if Button = mbRight then
    ShowMessage('mbRight');

  if Button = mbLeft then
    ShowMessage('mbLeft');
end;

procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  if Sender is TLabel then
  begin
    ListBox1.Items.Add(TLabel(Sender).Caption);
  end;
end;

procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  if Sender is TLabel then
    Accept := True
  else
    Accept := False;
end;

Hier mal ein ganz einfaches Beispiel mit einem Label und einer ListBox.
Ich möchte eigentlich, die entsprechende ShowMessage erhalten wenn ich mit der linken oder rechten Maustaste drauf drücke bzw. das entsprechende DragEvent wenn ich es in die ListBox ziehe.

Hat jemand eine Idee wie man das hinbekommt?

[SneakyBagels]

Ich weiß nicht genau was dein Ziel ist. Aber das sieht doch mehr als kompliziert aus.

Versuchs mal hiermit:

Delphi-Quellcode:

// FormCreate
DragAcceptFiles(ListBox1.Handle, Accept);

function IsDirectory(const aFileName: string): Boolean;
var
 R: DWORD;
begin
 R := GetFileAttributes(PChar(aFileName));
 Result := (R <> DWORD(-1)) and ((R and FILE_ATTRIBUTE_DIRECTORY) <> 0);
end;

procedure DragDropHandleProcess(Wnd: HWND; aPath: string);
var
 bIsPath: Boolean;
begin
 bIsPath := IsDirectory(aPath);

 if bIsPath and (Wnd = ListBox1.Handle) then
  FListBox1.Items.Add(aPath);
end;

// ApplicationEvents aufs Form packen und OnMessage nutzen
const
 BufferLength = 255;
var
 QtyDroppedFiles, FileIndex: Integer;
 pDroppedFilename: array [0 .. BufferLength] of Char;
begin
WM_DROPFILES:
   begin
    QtyDroppedFiles := DragQueryFile(Msg.WParam, Cardinal(-1), nil, 0);

    try
     for FileIndex := 0 to QtyDroppedFiles - 1 do
      begin
       DragQueryFile(Msg.WParam, FileIndex, @pDroppedFilename, BufferLength);
       DragDropHandleProcess(Msg.HWND, PChar(@pDroppedFilename));
       Break;
      end;
    finally
     DragFinish(Msg.WParam);
     Handled := True;
    end;
   end;
end;

[Alex_ITA01]

Ich will keine Dateien irgendwo hin schieben sondern ein Drag Event von einer Komponente A zu einer Kompenente B realisieren und dabei muss A und B jeweils noch auf sein MouseUp reagieren können wenn die Maus auch tatsächlich losgelassen wurde. Dein Beispiel ist glaube ich nicht das was ich möchte. Hat noch jemand eine Idee?

Das mit dem Label und der Listbox ist nur ein Beispiel und könnte genauso gut etwas anderes sein was vom Typ TControl ist

[Fritzew]

Irgendwie verstehe ich das nicht...
1. Dein Beispiel kann nicht funktionieren da Du Source und Sender vertauschst.
2. Was willst Du wirklich erreichen? Ist mir nicht klar. Deine Variable StartDragging ist nutzlos, ich verstehe den Sinn nicht.

[himitsu]

SetCapture

Aber eigentlich macht Windows das automatisch, für die Komponente, in in welcher die Maustaste runtergedrückt wurde,
womit dann die MouseMove und MouseButtonUp bei jener Komponente landen, auch wenn man die Maus aus der Komponente rausgeschoben hat.

[Fritzew]

Zitat:

Zitat von himitsu (Beitrag 1374453)

SetCapture

Aber eigentlich macht Windows das automatisch, für die Komponente, in in welcher die Maustaste runtergedrückt wurde,
womit dann die MouseMove und MouseButtonUp bei jener Komponente landen, auch wenn man die Maus aus der Komponente rausgeschoben hat.

In der VCL? Das macht dieVCL selber, komplett unabhängig von Windows. Hier geht es nur um Vcl DragundDrop.
Das ist schon seit D1 so.

[himitsu]

VCL setzt auf Windows auf.
Wenn das VCL-D&D nicht mit ReleaseCapture dazwischenfunkt, dann bleibt das Verhalten ja so.
Mit SetCapture kann man selber einer oder keiner anderen Komponente den "MausFokus" geben, bzw. der Quellkomponente "wieder" den Fokus verpassen ... falls man damit dann das D&D der VCL nicht stört.

Und natürlich kann man ein Drag&Drop aus selber implementieren, ohne das "uralte" System der VCL zu nutzen.

Oder mit etwas Aufwand könnte man das Drag&Drop vom Windows auch nur programmintern nutzen.

[Fritzew]

Zitat:

Zitat von himitsu (Beitrag 1374455)

VCL setzt auf Windows auf.
Wenn das VCL-D&D nicht mit ReleaseCapture dazwischenfunkt, dann bleibt das Verhalten ja so.
Mit SetCapture kann man selber einer oder keiner anderen Komponente den "MausFokus" geben, bzw. der Quellkomponente "wieder" den Fokus verpassen ... falls man damit dann das D&D der VCL nicht stört.

Und natürlich kann man ein Drag&Drop aus selber implementieren, ohne das "uralte" System der VCL zu nutzen.

Da gebe ich Dir Recht, nur sollten wir vielleicht mal dem TE mitteilen dass er während dem Drag & Drop nicht auf eine andere Maustaste reagieren kann. Und ich denke nicht dass man SetCapture in dem Zusammenhang überhaupt erwähnen sollte.

Das kann richtig lustig werden... Ich habe hier eine 3D-Mouse mit 12!!! Tasten könnte ein neuer Anwendungsfall werden, mit Taste 1 starten und je nach Taste loslassen anders reagieren.

[Alex_ITA01]

Wieso vertausche ich Source und Sender?

Was ich erreichen will?
Ich habe eine Komponente A und will diese per Drag&Drop auf Komponente B verschieben. Natürlich will ich nicht die Komponente A auf B drauf schieben aber ich will bei dem Drop von B wissen ob der Sender=A war und natürlich auf alle Eigenschaften vom Sender (A) zugreifen. Gleichzeitig soll aber das MouseUp wirklich getriggert werden, wenn ich nur mit der linken oder rechten Maustaste auf Komponente A drücke.

Die Variable StartDragging ist dafür da, da das BeginDrag sofort ein MouseUp feuert aber die Maus ja gar nicht losgelassen wurde. Damit will ich nur sicherstellen, dass es sich in dem MouseUp Event nicht um das Standard-Event des BeginDrag geht.

Soweit verstanden?

Ich will einfach in diesem konkreten Beispiel, das das Label im MouseUp auf die linke und rechte Maustaste reagiert und gleichzeit ein Drag&Drop in die ListBox möglich ist und ich dort einfach die Caption des Labels adde...

Zitat:

Da gebe ich Dir Recht, nur sollten wir vielleicht mal dem TE mitteilen dass er während dem Drag & Drop nicht auf eine andere Maustaste reagieren kann.

Das ist mir klar, ich möchte ja am besten auch erst, dass das Drag&Drop startet, wenn ich die linke Maustaste drücke, gedrückt halte und die Maus verschiebe. Dann ist alles gut. Wenn ich aber die Linke/Rechte Maustaste drücke und sofort wieder loslasse, dann will ich natürlich das normale MouseUp mit der entsprechenden Übergabe der gedrückten Maustaste

[jaenicke]

Das ganze ist im Grunde recht einfach:
Du darfst nicht beim Drücken der Maustaste sofort einen Dragvorgang beginnen, denn das löst sofort das MouseUp aus. Stattdessen musst du das MouseMove benutzen und erst nach einer Bewegung mit gedrückter Maustaste (ggf. mit Toleranz von ein paar Pixeln) den Dragvorgang auslösen.

Außerdem benutzt du in ListBox1DragDrop und ListBox1DragOver wie schon genannt Sender (die Ereignisquelle für die Mausaktion, also die Listbox) statt Source (der Dragquelle, also das Label).

// EDIT:
Sprich:

Delphi-Quellcode:

procedure TForm1.Label1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if ssLeft in Shift then // ggf. noch beim MouseDown die X- und Y-Koordinaten speichern und hier die Differenz ermitteln
  begin
    StartDragging := True;
    Label1.BeginDrag(False, 8);
    StartDragging := False;
  end;
end;

procedure TForm1.Label1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if not StartDragging then
  begin
    if Button = mbRight then
      ShowMessage('mbRight');

    if Button = mbLeft then
      ShowMessage('mbLeft');
  end;
end;

procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  if Source is TLabel then
  begin
    ListBox1.Items.Add(TLabel(Source).Caption);
  end;
end;

procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  if Source is TLabel then
    Accept := True
  else
    Accept := False;
end;