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.