Få ikon for fil

Min erfaring er at det altid bliver grimt når det bliver rezised

Jo det ved jeg godt men det er derfor jeg bruger SHGFI_SMALLICON for så troede jeg at jeg fik dem i 16x16

Her er et lille program som kan udtrække en ikon fra en fil eller fra systemet:

unit ICUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  shellapi, ExtCtrls, StdCtrls, Buttons;

type
  TForm1 = class(TForm)
    Image1: TImage;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    IconGroup: TRadioGroup;
    Label1: TLabel;
    Edit1: TEdit;
    Image2: TImage;
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.BitBtn1Click(Sender: TObject);
var
IC: HIcon;
begin
  IC:=ExtractIcon(HInstance,'Shell32.dll',StrToInt(Edit1.Text));
  //IC:=ExtractIcon(HInstance,'G:\Autorun.exe',0);
  Image2.Picture.Icon.Handle:=IC;
  Edit1.SetFocus;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
var
IC:HIcon;
begin
  case IconGroup.ItemIndex of
    0:IC:=loadIcon(0,IDI_Application);
    1:IC:=loadIcon(0,IDI_Asterisk);
    2:IC:=loadIcon(0,IDI_Exclamation);
    3:IC:=loadIcon(0,IDI_Hand);
    4:IC:=loadIcon(0,IDI_Question);
    5:IC:=loadIcon(0,IDI_Winlogo);
  end;
  Image1.Picture.Icon.Handle:=IC;
end;

end.

NB.
Jeg har flg. items i min Icongroup:
Application
Asterisk
Exclamation
Hand
Question
Winlogo

kigger lige på det

Det som den første kanp gør er blot at hente nogle ikonr ud fra en fil hvor i der er ikoner.
Nummer to knap henter blot nogle system ikoner.

Det jeg har brug for er at jeg kan få ikonet til fx *.doc uden at have en fil (ved godt dette findesi i registreringsdatabasen og det virker også) og det skal helst være via et apikald. Hvis man så angiver en fil der eksistere og fx er en exe med eget ikon er det, det jeg vil have.

Forstået ? (eller er det for kryptisk skrevet :) )

er der nogen hjemme ?

Jeg kan ikke finde på noget at sige ud fra din beskrivelse.
Hvis du angiver en exe-fil, har du jo fået en programstump, som kan udtrække en ikon.
Hvis du kun angiver en filtype, må du en tur rundt om registreringsdatabasen for at få navnet på den exe-fil, der er associeret med filtypen. Har får du samtigig nummeret på den ikon du skal bruge fra exe-filen.

Jo, men det er noget der tager gevaldig lang tid hvis der fx er 1000 filer og derfor ville jeg gerne hvism na kunen udnytte et api kald da det ofte er det hurtigste. FX fik det jeg alllerførste jeg foreslog til at virke

Her er det komplette eksempel fra members.truepath
Lav en form med en TListview.
Oprette til formen en OnCreate og OnDestroy event
Opret til Listview en OnColumClick event

God fornøjelse.

NB. Jeg kan ikke få sorteringen til at virke.

unit Listview;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ShellApi, ComCtrls;

type
  TForm1 = class(TForm)
    ListView1: TListView;

{ START PART IV }
    procedure ListView1ColumnClick(Sender: TObject;
                                  Column: TListColumn);
    procedure ListView1Compare(Sender: TObject;
                              Item1, Item2: TListItem;
                              Data: Integer;
                              var Compare: Integer);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
{ END PART IV }
  private
    { Private declarations }

{ START PART IV }
    SortForward : Boolean;
    SortColumn  : Integer;
{ END PART IV }

{ START PART III }
    tmpIcon : TIcon;
    procedure GetFileInfo(AListView:TListView;
                          AFileName:String;
                          var AShInfo:TSHFileInfo);
    procedure CreateImages(var AListView:TListView);
{ END PART III }

{ START PART II }
    procedure FillListView(var AListView:TListView;
                          ADir: String);
{ END PART II }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}




procedure TForm1.FormCreate(Sender: TObject);
begin

{ START PART III }
  tmpIcon := TIcon.Create;
{ END PART III }

  // create TLisView.LargeImages TImageList
  ListView1.LargeImages := TImageList.Create(self);
  // create TLisView.SmallImages TImageList
  ListView1.SmallImages := TImageList.Create(Self);
  // fill the large and small images
  CreateImages(ListView1);

{ START PART II }
  // set our default TListView properties
  ListView1.HideSelection      := False;
  ListView1.MultiSelect        := False;
  ListView1.ReadOnly          := True;
  ListView1.ShowColumnHeaders  := True;
  ListView1.ViewStyle          := vsReport;

  // add our default TListView columns
  with ListView1.Columns.Add do
  begin
    Caption  := 'Name';
    Width    := 150;
  end;
  with ListView1.Columns.Add do
  begin
    Caption  := 'Size';
    Width    := 75;
    Alignment := taRightJustify;
  end;
{ START PART III }
  with ListView1.Columns.Add do
  begin
    Caption  := 'Type';
    Width    := 150;
    Alignment := taRightJustify;
  end;
{ END PART III }

{ START PART IV }
  with ListView1.Columns.Add do
  begin
    Caption  := 'DirOrFile';
    Width    := 0; // for debugging make this 100
  end;
{ END PART IV }

  // fill our TListView columns for the root
  FillListView(ListView1,'C:');
{ END PART II }

{ START PART IV }
  SortForward := FALSE;
  SortColumn  := 0;
  // do an initial header click to sart with a sort
  ListView1.OnColumnClick(ListView1,ListView1.Column[0]);
{ END PART IV }

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  // destroy TLisView.LargeImages TImageList
  ListView1.LargeImages.Free;
  // destroy TLisView.SmallImages TImageList
  ListView1.SmallImages.Free;

{ START PART III }
  tmpIcon.Free;
{ END PART III }

end;

procedure TForm1.CreateImages(var AListView:TListView);
var
  SysImageList: UINT;
  SFI: TSHFileInfo;
begin
  with AListView do
  begin

    // get Windows large icons
    SysImageList := SHGetFileInfo('',
                                  0,
                                  SFI,
                                  SizeOf(SFI),
                                  SHGFI_SYSICONINDEX or
                                  SHGFI_LARGEICON);
    if SysImageList <> 0 then
    begin
      LargeImages.Handle := SysImageList;
      Largeimages.ShareImages := TRUE;
    end;

    // get Windows small icons
    SysImageList := SHGetFileInfo('',
                                  0,
                                  SFI,
                                  SizeOf(SFI),
                                  SHGFI_SYSICONINDEX or
                                  SHGFI_SMALLICON);
    if SysImageList <> 0 then
    begin
      SmallImages.Handle := SysImageList;
      SmallImages.ShareImages := TRUE;
    end;
  end;
end;

{ START PART II }
procedure TForm1.FillListView(var AListView:TListView;
                              ADir: String);
var

{ START PART III }
  ShInfo : TSHFileInfo;
{ END PART III }

  FileSearchRec : TSearchRec;
begin
  // make sure our path ends in a back-slash
  if ADir[Length(ADir)] <> '\' then
    ADir := ADir + '\';

  Screen.Cursor := crHourGlass;

  AListView.Items.Clear;
  AListView.Items.BeginUpdate();
  try

    // find the first file in our directory, by adding *.* we will
    // be looking for all fiels and directories
    if FindFirst(ADir + '*.*', faAnyFile , FileSearchRec) = 0 then
    begin

{ START PART III }
      GetFileInfo(AListView,FileSearchRec.Name,ShInfo);
{ END PART III }

      // add the first file to our TListView
      with AListView.Items.Add do
      begin
        Caption := FileSearchRec.Name;

{ START PART III }
        ImageIndex := ShInfo.iIcon;
{ END PART III }

        SubItems.Add(IntToStr(FileSearchRec.Size));

{ START PART III }
        SubItems.Add(ShInfo.szTypeName);
{ END PART III }

{ START PART IV }
        // set subitem to be tested when sorting to
        // whether or not the listitem is for a dir
        // as we will attempt to keep dir together
        if ShInfo.szTypeName = 'File Folder' then
          SubItems.Add('dir')
        else
          SubItems.Add('file');
{ END PART IV }

      end;

      // find all other files and directories, and add them to our
      // TListView
      while FindNext(FileSearchRec) = 0 do
      begin

{ START PART III }
        GetFileInfo(AListView,FileSearchRec.Name,ShInfo);
{ END PART III }

        with AListView.Items.Add do
        begin
          Caption := FileSearchRec.Name;

{ START PART III }
          ImageIndex := ShInfo.iIcon;
{ END PART III }

          SubItems.Add(IntToStr(FileSearchRec.Size));

{ START PART III }
          SubItems.Add(ShInfo.szTypeName);
{ END PART III }

{ START PART IV }
          // set subitem to be tested when sorting to
          // whether or not the listitem is for a dir
          // as we will attempt to keep dir together
          if ShInfo.szTypeName = 'File Folder' then
            SubItems.Add('dir')
          else
            SubItems.Add('file');
{ END PART IV }

        end;
      end;

      // terminate our FindFirst/FindNext sequence
      FindClose(FileSearchRec);
    end;
  finally
    AListView.Items.EndUpdate();
    Screen.Cursor := crDefault;
  end;
end;
{ END PART II }

{ START PART III }
procedure TForm1.GetFileInfo(AListView:TListView;
                            AFileName:String;
                            var AShInfo:TSHFileInfo);
var
  tmpStr        : String;
  tmpHIcon      : hIcon;
  iSmall,iLarge : Integer;
begin
  tmpStr := ExtractFileExt(AFileName);
  if tmpStr <> '' then
  begin
    SHGetFileInfo(pChar(AFileName),
                  FILE_ATTRIBUTE_NORMAL,
                  AShInfo,
                  SizeOf(AShInfo),
                  SHGFI_TYPENAME or
                  SHGFI_SYSICONINDEX or
                  SHGFI_USEFILEATTRIBUTES or
                  SHGFI_SMALLICON);
  end
  else // directory
    SHGetFileInfo(pChar('c:\*.'),
                  FILE_ATTRIBUTE_NORMAL or
                  FILE_ATTRIBUTE_DIRECTORY,
                  AShInfo,
                  SizeOf(AShInfo),
                  SHGFI_TYPENAME or
                  SHGFI_SYSICONINDEX or
                  SHGFI_USEFILEATTRIBUTES or
                  SHGFI_SMALLICON);

{  // get the exe icons
  if UpperCase(tmpStr) = '.EXE' then
  begin
    tmpHIcon := ExtractIcon(handle,
                            pChar(ExtractFilePath(AFileName)+
                                  AFileName),
                            0);
    // icon handle will equal 0 if none is available
    if tmpHIcon = 0 then
      Exit;

    // release icon handle to set it to the new one
    tmpIcon.ReleaseHandle;
    tmpIcon.Handle := tmpHIcon;

    // add icon to our list
    iSmall := AListView.SmallImages.AddIcon(tmpIcon);
    iLarge := AListView.LargeImages.AddIcon(tmpIcon);

    // set new icon index
    if AListView.ViewStyle = vsReport then
      AShInfo.iIcon := iSmall
    else
      AShInfo.iIcon := iLarge;

  end;}
end;
{ END PART III }


{ START PART IV }
procedure TForm1.ListView1ColumnClick(Sender: TObject;
  Column: TListColumn);
begin
  if Column.Index = SortColumn then
    SortForward := not SortForward
  else
  begin
    SortColumn := Column.Index;
    SortForward := TRUE;
  end;
  ListView1.SortType := stData;
  ListView1.SortType := stNone;
end;

procedure TForm1.ListView1Compare(Sender: TObject;
                                  Item1, Item2: TListItem;
                                  Data: Integer;
                                  var Compare: Integer);
begin
  with ListView1 do
  begin
    Compare := 0;
    if (Item1.SubItems[2] = 'dir') and
      (Item2.SubItems[2] = 'file') then
      Compare := -1
    else if (Item1.SubItems[2] = 'file') and
            (Item2.SubItems[2] = 'dir') then
      Compare := 1
    else
    begin // Compare files
      case SortColumn of
        // sort on file name
        0 : Compare := CompareText(Item1.Caption,
                                  Item2.Caption);
        // sort on file size
        1 : Compare := StrToInt(Item1.SubItems.Strings[0]) -
                                StrToInt(Item2.SubItems.Strings[0]);
        else Compare := CompareText(Item1.SubItems.Strings[SortColumn - 1],
                                  Item2.SubItems.Strings[SortColumn - 1]);
      end;
    end;

    if not SortForward then
      Compare := -Compare

  end;
end;



end.

ser ud til at jeg kan godt kan bruge det men kigger det lige bedre igennem en af dagene :) Og vender så tilbage

nca > jeg kan ikke helt bruge din løsning for den er for langsom .. men derfor er den ikke forkert så jeg giver lidt

Hvorfor ikke bare bruge ExtractAssociatedIcon som kan findes i ShellAPI?