Solved

small icons in files

Posted on 2000-05-14
4
154 Views
Last Modified: 2010-04-04
How can I extract a small icon from a exe using the icon index? I know it can be done without the icon index with something like ShGetFileInfo(...). Or with big icons and the icon index with ExtractIcon(...) but I need little icons! Anybody know how to do this?
0
Comment
Question by:zilog
  • 2
4 Comments
 
LVL 17

Accepted Solution

by:
inthe earned 50 total points
Comment Utility
hi,
here is example of extracting small and large icons using extracticonex()


unit ExtractIconExU;

interface

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

type
  TForm1 = class(TForm)
    DriveComboBox1: TDriveComboBox;
    DirectoryListBox1: TDirectoryListBox;
    FileListBox1: TFileListBox;
    Label1: TLabel;
    ScrollBox1: TScrollBox;
    ScrollBox2: TScrollBox;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Image1: TImage;
    Image2: TImage;
    procedure FileListBox1DblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  LargeIconsBitmap: TBitmap;  // this holds the icon images
  SmallIconsBitmap: TBitmap;

implementation

{$R *.DFM}

procedure TForm1.FileListBox1DblClick(Sender: TObject);
var
   NumIcons: Integer;         // holds the icon count
   LIcon: HICON;              // holds the handles to extracted icons
   SIcon: HICON;
   LoopCount: Integer;        // a general loop counter
begin
   {determine the number of icons stored in this file}
   NumIcons:=ExtractIconEx(PChar(FileListBox1.FileName), -1, LIcon, SIcon, 0);

   {display this number}
   Label4.Caption:='Total Number of Icons: '+IntToStr(NumIcons);

   {resize the images and clear the canvases of the offscreen bitmaps.
    we add a 1 to the width in case there are no icons. this prevents
    the Height of these objects from being reset to 1.}
   Image1.Width:=NumIcons*40+1;
   Image2.Width:=NumIcons*40+1;
   LargeIconsBitmap.Width:=NumIcons*40+1;
   LargeIconsBitmap.Canvas.FillRect(LargeIconsBitmap.Canvas.ClipRect);
   SmallIconsBitmap.Width:=NumIcons*40+1;
   SmallIconsBitmap.Canvas.FillRect(SmallIconsBitmap.Canvas.ClipRect);

   {extract each large and small icon from the file}
   for LoopCount:=0 to NumIcons-1 do
   begin
      {find the icon in the selected application, if one exists}
      ExtractIconEx(PChar(FileListBox1.FileName), LoopCount, LIcon, SIcon, 1);

      {display the large icon}
      DrawIcon(LargeIconsBitmap.Canvas.Handle, (LoopCount*40)+4, 2, LIcon);

      {draw the small icon to the correct dimensions}
      DrawIconEx(SmallIconsBitmap.Canvas.Handle, (LoopCount*40)+4, 2, SIcon,
                 GetSystemMetrics(SM_CXSMICON), GetSystemMetrics(SM_CYSMICON),
                 0, 0, DI_NORMAL);
   end;

   {assign the offscreen bitmaps to the images for display}
   Image1.Picture.Bitmap.Assign(LargeIconsBitmap);
   Image2.Picture.Bitmap.Assign(SmallIconsBitmap);
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
   {create the offscreen bitmaps to hold the images of the icons.}
   LargeIconsBitmap:=TBitmap.Create;
   LargeIconsBitmap.Height:=53;
   LargeIconsBitmap.Width:=40;

   SmallIconsBitmap:=TBitmap.Create;
   SmallIconsBitmap.Height:=53;
   SmallIconsBitmap.Width:=40;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
   {free the offscreen bitmaps}
   LargeIconsBitmap.Free;
   SmallIconsBitmap.Free;
end;

end.




Regards Barry

0
 
LVL 17

Expert Comment

by:inthe
Comment Utility
oops forgot the "form as text" view

object Form1: TForm1
  Left = 321
  Top = 159
  BorderStyle = bsDialog
  Caption = 'ExtractIconEx Example'
  ClientHeight = 354
  ClientWidth = 314
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  Position = poScreenCenter
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 0
    Top = 0
    Width = 314
    Height = 26
    Align = alTop
    Caption =
      'Double click on a file in the list box. If it is an application,' +
      ' its icons will be displayed below.'
    WordWrap = True
  end
  object Label2: TLabel
    Left = 8
    Top = 168
    Width = 56
    Height = 13
    Caption = 'Large Icons'
  end
  object Label3: TLabel
    Left = 8
    Top = 264
    Width = 54
    Height = 13
    Caption = 'Small Icons'
  end
  object Label4: TLabel
    Left = 196
    Top = 168
    Width = 108
    Height = 13
    Alignment = taRightJustify
    Caption = 'Total Number of Icons:'
  end
  object DriveComboBox1: TDriveComboBox
    Left = 8
    Top = 40
    Width = 145
    Height = 19
    DirList = DirectoryListBox1
    TabOrder = 0
  end
  object DirectoryListBox1: TDirectoryListBox
    Left = 8
    Top = 64
    Width = 145
    Height = 97
    FileList = FileListBox1
    ItemHeight = 16
    TabOrder = 1
  end
  object FileListBox1: TFileListBox
    Left = 160
    Top = 40
    Width = 145
    Height = 121
    ItemHeight = 16
    ShowGlyphs = True
    TabOrder = 2
    OnDblClick = FileListBox1DblClick
  end
  object ScrollBox1: TScrollBox
    Left = 8
    Top = 184
    Width = 297
    Height = 73
    TabOrder = 3
    object Image1: TImage
      Left = 0
      Top = 0
      Width = 105
      Height = 53
    end
  end
  object ScrollBox2: TScrollBox
    Left = 8
    Top = 280
    Width = 297
    Height = 65
    TabOrder = 4
    object Image2: TImage
      Left = 0
      Top = 0
      Width = 105
      Height = 45
    end
  end
end
0
 
LVL 3

Expert Comment

by:bryan7
Comment Utility
listenning
0
 

Author Comment

by:zilog
Comment Utility
That's exactly what I wanted Inthe. And it works in my old version of Delphi 3 too.
Thanks for answering my question so quickly.
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Suggested Solutions

In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
Internet Business Fax to Email Made Easy - With eFax Corporate (http://www.enterprise.efax.com), you'll receive a dedicated online fax number, which is used the same way as a typical analog fax number. You'll receive secure faxes in your email, fr…
In this tutorial you'll learn about bandwidth monitoring with flows and packet sniffing with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're interested in additional methods for monitoring bandwidt…

771 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now