Drag and Drop "nach draußen"...

[nezumi7]

Ich kram das nochmal vor, weil ich es inzwischen mit Bordmitteln lösen konnte. Mir ging es darum, den vollständigen Pfad eines geöffneten Ordners dadurch zu ermitteln, dass ich etwas aus meinem Programm auf diesen geöffneten Ordner ziehe. Ich finde das sehr praktisch, wenn man - wie ich gerade - seine ganzen Daten aus den letzten 20 Jahren durchgeht und ausmistet.

Ich hab es mit einer zweiten (transparenten) Form gemacht. Falls es jemand gebrauchen kann:

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Buttons;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Label1: TLabel;
    Button1: TButton;
    SpeedButton1: TSpeedButton;
    GroupBox1: TGroupBox;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
      procedure WMMove(var Msg: TWMMOVE); message WM_MOVE;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  

  implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);
begin
pnt2.X := Speedbutton1.Left;
pnt2.Y := Speedbutton1.top;
pnt := Form1.Speedbutton1.clienttoscreen(pnt2);

Form2.Left := pnt.X-Speedbutton1.Left;
Form2.Top := pnt.Y-Speedbutton1.Top;
form2.Width := Speedbutton1.width;
form2.Height := Speedbutton1.Height;
Form2.BorderStyle := bsNone;
Form2.AlphaBlend := true;
Form2.AlphaBlendValue := 5;

Form2.show;
Timer1.Enabled := false;
end;

procedure TForm1.WMMove(var Msg: TWMMOVE);
begin
if Form2 <> Nil then begin
pnt := Form1.Speedbutton1.clienttoscreen(pnt2);
MoveWindow(Form2.Handle, pnt.X-Speedbutton1.Left, pnt.Y-Speedbutton1.Top, Form2.Width,Form2.Height, True);
end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.FormStyle := fsstayontop;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
Button1.SetFocus;
Form2.BringToFront;
end;

procedure TForm1.SpeedButton1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
end;

end.

Delphi-Quellcode:

unit Unit2;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, FileCtrl, SHDocVw;

  type
  TForm2 = class(TForm)
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;
  pnt, pnt2, targetpnt: TPoint;
  wnd: HWND;
implementation

uses Unit1;

{$R *.dfm}


function getpath(wnd: HWND): String;
var
ShellWin: IShellWindows;
i: Integer;
ClName: array[0..64]of Char;
Pfad: AnsiString;
begin
ShellWin := CoShellWindows.Create;
for i := 0 to Pred(ShellWin.Count) do
   with ShellWin.Item(i) as IWebBrowser2 do begin
   GetClassName(hwnd, ClName, SizeOf(ClName));
      if wnd = hwnd then begin
      if (string(ClName)= 'ExploreWClass') or (string(ClName)= 'CabinetWClass') then
      begin
        Pfad:= StringReplace(LocationURL, 'file:///', '', [rfReplaceAll, rfIgnoreCase]);
        Pfad:= StringReplace(Pfad, '/', '\', [rfReplaceAll]);
        Pfad:= StringReplace(Pfad, '%20', ' ', [rfReplaceAll]);
        Pfad:= Stringreplace(pfad, '%FC', 'ü', [rfreplaceAll]);
        Pfad:= Stringreplace(pfad, '%DC', 'Ü', [rfreplaceAll]);
        Pfad:= Stringreplace(pfad, '%E4', 'ä', [rfreplaceAll]);
        Pfad:= Stringreplace(pfad, '%C4', 'Ä', [rfreplaceAll]);
        Pfad:= Stringreplace(pfad, '%F6', 'ö', [rfreplaceAll]);
        Pfad:= Stringreplace(pfad, '%D6', 'Ö', [rfreplaceAll]);
        Pfad:= Stringreplace(pfad, '%DF', 'ß', [rfreplaceAll]);
        if DirectoryExists(Pfad) then
        Result := IncludeTrailingPathDelimiter(Pfad);
      end;
      end;
    end;
    end;


procedure TForm2.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if form2.Cursor <> crsizeall then form2.Cursor := crsizeall;
if (Shift = [ssleft]) then begin
form2.Left := mouse.CursorPos.X-Form2.Width div 2;
form2.Top := mouse.CursorPos.Y-Form2.Height div 2;
end;
end;

procedure TForm2.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  var
  pfad: String;
  z: Integer;
  begin

targetpnt.X := form2.left+(form2.Width div 2);
targetpnt.Y := form2.top+(form2.height div 2);

Form2.Left := pnt.X-Form1.Speedbutton1.Left;
Form2.Top := pnt.Y-Form1.Speedbutton1.Top;
form2.Cursor := crdefault;

wnd := windowfrompoint(targetpnt);

pfad := '';
z := 0;

While (pfad = '') and (z<9) do begin
try
wnd := GetAncestor(wnd,GA_Parent);
pfad := getpath(wnd);
finally
end;
inc(z);
end;

Form1.Label1.Caption := pfad;
Form1.SpeedButton1.Down := false;
end;

procedure TForm2.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Form1.SpeedButton1.Down := true;
end;

end.