Как создать ЯРЛЫК

← →
GRAVE DIGGER (2002-09-14 18:14) [0]

Как сделать, чтоб на форму можно было перетаскивать(создавать)
ярлыки внешних программ!
Я создаю прогу заменяющую рабочий стол!

← →
[NIKEL] (2002-09-15 00:14) [1]

может поможет:
<CODETForm1 = 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; >

Как создать ЯРЛЫК Найти похожие ветки