Скачать: CL | DM;

Как получить иконку файла по его расширению?   Найти похожие ветки 

← →
Navi   (2006-08-07 21:01) [0]

Здравствуйте!
Собственно сабж.
Пробовал так:
var
 fi: TSHFileInfo;

 ShGetFileInfo(PChar("*.bmp"), 0, fi, SizeOf(fi),
   SHGFI_SMALLICON or SHGFI_SYSICONINDEX or SHGFI_TYPENAME); - возвращает 0;
 Корректный результат получается только когда задано реальное имя файла.
Что делать?
Спасибо.

---

← →
kami ©   (2006-08-07 21:27) [1]

SHGFI_ICON or SHGFI_SMALLICON or SHGFI_USEFILEATTRIBUTES

---

← →
begin...end ©   (2006-08-07 21:30) [2]

> Navi   (07.08.06 21:01)
> Что делать?

Читать MSDN:

If the uFlags parameter includes the SHGFI_USEFILEATTRIBUTES flag, this parameter does not have to be a valid file name. The function will proceed as if the file exists with the specified name and with the file attributes passed in the dwFileAttributes parameter. This allows you to obtain information about a file type by passing just the extension for pszPath and passing FILE_ATTRIBUTE_NORMAL in dwFileAttributes.

---

← →
apic ©   (2006-08-12 16:51) [3]

Зайди на сайт DelphiWorld и дай в поиск Что-то типа "извлечь иконку", ответ на твой вопрос я нашел помоиму где-то там...

---

← →
vain ©   (2006-08-13 23:29) [4]

А разве, нельзя в реестр глянуть, где хранится иконка для данного типа файлов? Кстати, у меня у самого вопросы по реестру... http://delphimaster.net/view/2-1155496198/

---

← →
PSPF2003 ©   (2006-08-14 09:47) [5]

У меня вот программка есть то нет?

В Edit нужно вести текст типа .txt

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, Registry, ShellAPI, ExtCtrls;

type
 TForm1 = class(TForm)
   Panel1: TPanel;
   Image1: TImage;
   Label1: TLabel;
   Label2: TLabel;
   Label3: TLabel;
   ParamLabel: TLabel;
   Label4: TLabel;
   DescriptionLabel: TLabel;
   Button1: TButton;
   Edit1: TEdit;
   Label5: TLabel;
   OpenWithLabel: TLabel;
   Button2: TButton;
   Label6: TLabel;
   FileDescriptionLabel: TLabel;
   procedure Button1Click(Sender: TObject);
   procedure Button2Click(Sender: TObject);
 private
   { Private declarations }
   ParamString: String;
   ExtDescription: String;
   FileDescription: String;
   OpenWith:String;
   procedure SplitStr(SplitChar: Char; var Str, Str1: String);
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.SplitStr(SplitChar: Char; var Str, Str1: String);
var
i: Integer;
begin
i := Pos(SplitChar, Str);
if i <> 0 then
 begin
  Str1 := Copy(Str, i + 1, Length(Str) - i + 1);
  SetLength(Str, i - 1);
 end
else
 ParamString := "";
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Reg: TRegistry;
IconFileName, IconIndex: String;
PC: Array[0..255] of Char;
i: Integer;
ExtIcon:TIcon;
ExtStr:String;
begin
ExtStr:=Edit1.Text;
if ExtStr[1]<>"." then
 Insert(".", ExtStr, 1);
Edit1.Text:=ExtStr;

ExtIcon:=TIcon.Create;
Reg := TRegistry.Create;
 try
  with Reg do
   begin
    RootKey := HKEY_CLASSES_ROOT;
    OpenKey(Edit1.Text, True);
    ExtDescription := ReadString("");
    OpenKey("\" + ExtDescription, True);
    FileDescription := ReadString("");
    OpenKey("DefaultIcon", True);

    IconFileName := ReadString("");
    SplitStr(",", IconFileName, IconIndex);
    StrPCopy(PC, IconFileName);

    ExtIcon.Handle := ExtractIcon(0, PC, StrToInt(IconIndex));
    Image1.Picture.Assign(ExtIcon);

    OpenKey("\" + ExtDescription + "\Shell\Open\Command", True);
    OpenWith := ReadString("");

    i := Pos(""", OpenWith);
    if i = 1 then
     begin
      OpenWith := Copy(OpenWith, 2, Length(OpenWith) - 1);
      i := Pos(""", OpenWith);
      ParamString := Copy(OpenWith, i + 3, Length(OpenWith) - i - 3);
      OpenWith := Copy(OpenWith, 0, i - 1);
     end
    else SplitStr(" ", OpenWith, ParamString)
   end;
 finally
  Reg.Free;
  ExtIcon.Free;
  ParamLabel.Caption:=ParamString;
  DescriptionLabel.Caption:=ExtDescription;
  FileDescriptionLabel.Caption:=FileDescription;
  OpenWithLabel.Caption:=OpenWith;
 end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Close;
end;

end.

---

Страницы: 1 вся ветка

Скачать: CL | DM;



Память: 0.47 MB
Время: 0.03 c