ListView

← →
MaDgic © (2003-07-08 14:03) [0]

Скажите п-а как сделать что бы при перетаскивании фаила на ListView в нем создавался его ярлык.

← →
wl © (2003-07-08 14:33) [1]

в Кулибе есть пример, как выполнить Drag&Drop из проводника так, чтобы его содержимое отображалось в Memo. От этого можно отталкиваться. А вот как получить иконку, соответствущую заданному типу файла, я не знаю, есть какая-то API функция, ищи в MSDN.

← →
DVM © (2003-07-08 14:35) [2]

WM_DROPFILES или IDropTarget

← →
DVM © (2003-07-08 14:36) [3]

> А вот как получить иконку, соответствущую заданному типу
> файла, я не знаю, есть какая-то API функция, ищи в MSDN.
>

ExtractAssociatedIcon или ShFileInfo

← →
wl © (2003-07-08 14:39) [4]

Ну вот, теперь есть всё необходимое, чтобы поместить Иконку и название файла в ListView. Выглядеть будет как самый настоящий ярлык.

← →
MaDgic © (2003-07-08 20:10) [5]

Может кто-нибудь написать полный текст,
или пример.

← →
MaDgic © (2003-07-09 07:52) [6]

никто что-ли не сталкивался с этим

← →
wl © (2003-07-09 08:20) [7]

Думаешь кто-нить будет напрягаться?

← →
MaDgic © (2003-07-09 13:34) [8]

ну как хотя бы скопировать фаил

← →
wl © (2003-07-09 14:02) [9]

Мда... Посмотри на компонент TShellListView, может он тебе поможет.

А копировать файл можно несколькими способами:
1. С помощью потоков (Пример из помощи к делфи):
procedure TForm1.Save1Click(Sender: TObject); var NewFileName: string; Msg: string; NewFile: TFileStream; OldFile: TFileStream; begin NewFileName := ExtractFilePath(Application.ExeName) + ExtractFileName(Edit1.Text); Msg := Format("Copy %s to %s?", [Edit1.Text, NewFileName]); if MessageDlg(Msg, mtCustom, mbOKCancel, 0) = mrOK then begin OldFile := TFileStream.Create(Edit1.Text, fmOpenRead or fmShareDenyWrite); try NewFile := TFileStream.Create(NewFileName, fmCreate or fmShareDenyRead); try NewFile.CopyFrom(OldFile, OldFile.Size); finally FreeAndNil(NewFile); end; finally FreeAndNil(OldFile); end; end; end;
2) с помощью WinAPI функции
BOOL CopyFile( LPCTSTR lpExistingFileName, LPCTSTR lpNewFileName, BOOL bFailIfExists );
3) ещё как-то...

Тебе похоже в самом деле ярлык нужен был? Опиши пожалуйста свою задачу более подробно

← →
wl © (2003-07-10 09:56) [10]

Код Drag&Drop из кулибы, как и обещал....
{Так можно заставить окно принимать файлы, перетаскиваемые из проводника} {ОБЯЗАТЕЛЬНО ПОМЕСТИТЕ В СЕКЦИЮ PRIVATE СТРОКИ procedure CreateParams(var Params: TCreateParams); override; procedure WMDropFiles(var Message: TWMDropFiles); message WM_DROPFILES; и не забудьте - ShellAPI поместить в uses} procedure TForm1.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); Params.ExStyle := Params.ExStyle or WS_EX_ACCEPTFILES; {сделаем окно способным принимать файлы} end; procedure TForm1.WMDropFiles(var Message: TWMDropFiles); var aFile: array [0..255] of Char; begin inherited; DragQueryFile(Message.drop, 0, aFile, 256); Memo1.Lines.LoadFromFile(aFile); DragFinish(Message.Drop); end; procedure TForm1.FormCreate(Sender: TObject); {Form1.OnCreate} begin DragAcceptFiles(Handle, True); {сделаем окно неравнодушным к пролетающим над ним файлам} end;

drag&drop работает, а вот с ярлыком проблемы
я думаю с атрибутами и дескриптором
как их узнать

uses
ShellAPI, ComCtrls, ShellCtrls, ShlObj, ComObj, ActiveX;

private

procedure CreateParams(var Params: TCreateParams); override;
procedure WMDropFiles(var Message: TWMDropFiles); message WM_DROPFILES;

procedure CreateLink(const PathObj, PathLink, Desc, Param: string);
var
IObject: IUnknown;
SLink: IShellLink;
PFile: IPersistFile;
begin
IObject := CreateComObject(CLSID_ShellLink);
SLink := IObject as IShellLink;
PFile := IObject as IPersistFile;
with SLink do begin
SetArguments(PChar(Param));
SetDescription(PChar(Desc));
SetPath(PChar(PathObj)); end;
PFile.Save(PWChar(WideString(PathLink)), FALSE);
end;

procedure TForm1.CreateParams(var Params: TCreateParams);
begin
inherited
CreateParams(Params);
Params.ExStyle := Params.ExStyle or WS_EX_ACCEPTFILES;
end;

procedure TForm1.WMDropFiles(var Message: TWMDropFiles);
var
aFile: array [0..255] of Char;
begin
inherited;
DragQueryFile(Message.drop, 0, aFile, 256);

CreateLink(afile, shelllistview1.Root+ExtractFileName(afile),afile , afile );
DragFinish(Message.Drop);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
DragAcceptFiles(Handle, True);
end;

заранее благодарен

если переташить ярлык то всё получается

ListView не запускает обычные ярлыки по двойному клику
Но через Enter они запускаются нормально
Подскажите, как сделать чтобы они запускались из ListView по двойному нажатию мышки.

из Windows они тоже нормально запускаются

ListView Найти похожие ветки