Как пpинимать яpлыки пpи пеpетягивании их на контpол?
Из советов Nomadic'a:
|
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; |
[001709]
