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

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

Автор: 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;

Взято с www.delphiworld.narod.ru

DELPHI FAQ