Как пpинимать яpлыки пpи пеpетягивании их на контpол

Code:

TForm1 = class(TForm)

...

private

   { Private declarations }

   procedure WMDropFiles(var M: TWMDropFiles); message WM_DROPFILES;

...

end;

var

Form1: TForm1;

implementation

uses

StrUtils, ShellAPI, ComObj, ShlObj, ActiveX;

procedure TForm1.FormCreate(Sender: TObject);

begin

...

DragAcceptFiles(Handle, True);

...

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

...

DragAcceptFiles(Handle, False);

...

end;

procedure TForm1.WMDropFiles(var M: TWMDropFiles);

var

hDrop: Cardinal;

n: Integer;

s: string;

begin

hDrop := M.Drop;

n := DragQueryFile(hDrop, 0, nil, 0);

SetLength(s, n);

DragQueryFile(hDrop, 0, PChar(s), n + 1);

DragFinish(hDrop);

M.Result := 0;

FileOpen(s);

end;

procedure TForm1.FileOpen(FileName: string);

begin

if CompareText(ExtractFileExt(FileName), '.lnk') = 0 then

   FileName := ResolveShortcut(Application.Handle, FileName);

DocName := ExtractFileName(FileName);

Caption := Application.Title + ' - ' + DocName;

...

end;

function ResolveShortcut(Wnd: HWND; ShortcutPath: string): string;

var

obj: IUnknown;

isl: IShellLink;

ipf: IPersistFile;

pfd: TWin32FindDataA;

begin

Result := '';

obj := CreateComObject(CLSID_ShellLink);

isl := obj as IShellLink;

ipf := obj as IPersistFile;

ipf.Load(PWChar(WideString(ShortcutPath)), STGM_READ);

with isl do

begin

   Resolve(Wnd, SLR_ANY_MATCH);

   SetLength(Result, MAX_PATH);

   GetPath(PChar(Result), Length(Result), pfd, SLGP_UNCPRIORITY);

   Result := PChar(Result);

end;

end;