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;

← →
MaDgic (2003-07-14 20:22) [11]

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;

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

← →
MaDgic (2003-07-14 21:32) [12]

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

← →
MaDgic (2003-07-15 21:43) [13]

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

← →
MaDgic (2003-07-16 20:05) [14]

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

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