Как п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;


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

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...