Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

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

01.01.2007

Автор: Nomadic

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;

Взято с https://delphiworld.narod.ru