PHP DM Gate v0.9 » Как показать иконку, ассоциированную с данным типом файла? <span class="vd">[Delphi, Windows]</span>

Grademax (23.08.12 08:55) [0]

Стоит задача, нужно показать иконку, ассоциированную с данным типом файла.
Не понимаю в чем дело... Программа падает при запуске.

uses windows, messages, KOL, ShellAPI;
var W:PControl;
Ico : PIcon;
IconIndex : Word;
{----------------------------------------------------------------------}
Procedure OnPaint( Dummy: Pointer; Sender: PControl; DC: HDC );
begin
Ico.Draw(W.Canvas.Handle,10,10);
end;
{----------------------------------------------------------------------}
BEGIN
W := NewForm( Applet, 'MiniForm' ).SetClientSize( 400, 300 );
W.CenterOnParent;
W.OnPaint := TOnPaint( MakeMethod( nil, @OnPaint));

Ico.Handle := ExtractAssociatedIcon(hInstance, PChar('c:\Windows\regedit.exe'), IconIndex);

Run( W );
END.

<Цитата>
Дмитрий К © (23.08.12 10:19) [1]

Ico не создан.

<Цитата>
Grademax (23.08.12 19:20) [2]

Да, косячнул... Но сути это не меняет... Программа всё равно падает

uses windows, messages, KOL, ShellAPI;
var W:PControl;
Ico : PIcon;
IconIndex : Word;
{----------------------------------------------------------------------}
Procedure OnPaint( Dummy: Pointer; Sender: PControl; DC: HDC );
begin
Ico.Draw(W.Canvas.Handle,10,10);
end;
{----------------------------------------------------------------------}
BEGIN
W := NewForm( Applet, 'MiniForm' ).SetClientSize( 400, 300 );
W.CenterOnParent;
W.OnPaint := TOnPaint( MakeMethod( nil, @OnPaint));

Ico := NewIcon;
Ico.Handle := ExtractAssociatedIcon(hInstance, PChar('c:\Windows\regedit.exe'), IconIndex);

Run( W );
END.

В итоге, пришлось придумывать альтернативный вариант (он работает):

uses windows, messages, KOL, ShellAPI;
var W:PControl;
Ico : PIcon;
{----------------------------------------------------------------------}
Procedure OnPaint( Dummy: Pointer; Sender: PControl; DC: HDC );
begin
Ico.Draw(W.Canvas.Handle,10,10);
end;
{----------------------------------------------------------------------}
Function GetRegistryIconHandle(FileName: string): HICON;
var Reg:HKey;
IconPath: String; //путь для файла с иконкой
IconNum, //номер иконки в файле
QPos: Integer; //позиция запятой в записи реестра
begin
IconNum := 0;
Reg := RegKeyOpenRead( HKEY_CLASSES_ROOT, '\' + ExtractFileExt(FileName));
IconPath := RegKeyGetStrEx(Reg, '');

Reg := RegKeyOpenRead( HKEY_CLASSES_ROOT, '\' + IconPath + '\DefaultIcon');
IconPath := RegKeyGetStrEx(Reg, '');
RegKeyClose(Reg);

QPos := Pos(',', IconPath);
if QPos <> 0 then
begin
IconNum := Str2Int(Copy(IconPath, QPos + 1, 4));
IconPath := Copy(IconPath, 1, QPos - 1)
end;
Result := ExtractIcon(hInstance, PChar(IconPath), IconNum);
end;
{----------------------------------------------------------------------}
BEGIN
W := NewForm( Applet, 'MiniForm' ).SetClientSize( 400, 300 );
W.CenterOnParent;
W.Margin := 0;
W.CanResize := False;
W.StayOnTop:=True;
W.OnPaint := TOnPaint( MakeMethod( nil, @OnPaint));

Ico := NewIcon;
Ico.Handle := GetRegistryIconHandle('c:\Windows\regedit.chm'); // <-Можно воткнуть даже не существующий файл
// актуально только расширение!
Run( W );
END.

<Цитата>
Дмитрий К © (23.08.12 21:10) [3]

> Программа всё равно падает
ExtractAssociatedIcon вторым параметром нужна перменная.

По теме можно использовать ImageList. Цитата из KOLBook:
LoadSystemIcons(smallicons) - связывает список изображений с глобальным системным списком пиктограмм, в котором хранятся, в том числе, пиктограммы, соответствующие зарегистрированным в системе типам файлов. На деле, хотя название этого метода начинается со слова Load, никакой физической "загрузки" изображений не происходит. Просто обращение к изображениям данного списка приводит к обращению к пиктограммам системного списка. Системный список нельзя модифицировать (доступ возможен в режиме "только чтение"). Чтобы получить информацию о том, какие пиктограммы из списка каким типам файлов соответствуют, необходимо воспользоваться либо функциями API, либо функциями KOL (FileIconSystemIdx, FileIconSysIdxOffline, DirIconSysIdxOffline);

<Цитата>
RusSun © (24.08.12 05:49) [4]

program Project1;
uses
Windows, KOL;
{$R *.res}
var form,FilesList1:pcontrol;
ImageList:PImageList;var i:integer;

procedure DropFiles(Dummy : Pointer;Sender: PControl;const Filelist:string;Pt:Tpoint);
var s:string;k,j:integer; //j,k:integer; n,
a: array[ 0..MAX_PATH ] of string;
begin
{//если бросить один файл
FilesList1.LVItemAdd('');inc(i);
FilesList1.LVItems[i,1]:='Puth '+filelist;
FilesList1.LVItemImageIndex[i]:=FileIconSysIdxOffline(filelist);}
//много файлов
j:=0;
s := Filelist;
while s <> '' do
begin
inc(j); a[j] := Trim( Parse( s, #13 ) );
s := Trim( s );
end;
for k:=1 to j do begin
FilesList1.LVItemAdd('');
inc(i);FilesList1.LVItems[i,1]:='Puth '+a[k];
FilesList1.LVItemImageIndex[i]:=FileIconSysIdxOffline(a[k]);
end;
end;
begin
Form := NewForm(nil, 'LV').setclientsize(600,600).CenterOnParent;
ImageList := NewImageList( form );
ImageList.Colors := ilcColor24;
ImageList.LoadSystemIcons(false);
FilesList1 := NewListView( form, lvsDetail, [ lvoGridLines ],ImageList, nil, nil ).SetAlign ( caClient );//setclientsize(600,600);
FilesList1.LVColAdd( 'Файл', taLeft, 50);
FilesList1.LVColAdd( 'Путь', taLeft, 450);
//область для работы
FilesList1.OnDropFiles :=TOnDropFiles(MakeMethod(nil,@DropFiles));
//form.ExStyle := form.ExStyle or WS_EX_ACCEPTFILES;
i:=-1;
Run(Form);
end.

<Цитата>
Grademax (24.08.12 12:17) [5]

Мой вариант не отображает никакую иконку у EXE-файла, если у EXE-файла иконка отсутствует, а это ни есть хорошо.

Вариант, который предоставил RusSun, работает абсолютно корректно!

Спасибо!

<Цитата>