Jump to content
Fórum Script Brasil
  • 0
Sign in to follow this  
Jhonas

Extrair + de 1000 Icones do Windows

Question

O Windows tem arquivos de Icones que voce pode usar em seus programas  ou outras aplicações

o código abaixo, extrai esses icones dos arquivos ( .DLL )  e salva esses icones em uma pasta no Diretório " C:\Icones "  

o Tamanho desses icones é 32 X 32 ...  No XP o resultado foi de 984 Icones

OBS: Se alguém souber de outros arquivos  que contenham icones, favor informar.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

  // Arquivos de Icones do Windows
  Arquivo: array[0..22] of STRING = ('shell32.dll', 'wmploc.dll', 'imageres.dll',
  'ieframe.dll', 'vscript.dll', 'compstui.dll', 'ddores.dll', 'mmcndmgr.dll',
  'moricons.dll', 'netshell.dll', 'pnidui.dll', 'pifmgr.dll', 'wpdshext.dll',
  'comres.dll', 'dmdskres.dll', 'dsuiext.dll', 'mstscax.dll', 'setupapi.dll',
  'vrlmon.dll', 'wiashext.dll', 'mmres.dll', 'inetpic.dll', 'inetpic.cpl');

  implementation

{$R *.dfm}

uses
  ShellAPI;

procedure ExtractIconsFromWindows(SavetoFolder : string);
var
  Icon: TIcon;
  ExtrFileName, Arq : string;
  NumberOfIcons, i, n: Integer;
begin
  for n := 0 to 22 do
     begin
        showmessage('Extraindo Icones de : ' + Arquivo[n]);
        Arq := copy(Arquivo[n],1,pos('.',Arquivo[n])-1);
        ExtrFileName := IncludeTrailingBackSlash(Arquivo[n]);
        Icon := TIcon.Create;
        try
          NumberOfIcons := ExtractIcon(0, PChar(Arquivo[n]), UINT(-1));
          for i := 0 to NumberOfIcons - 1 do
          begin
            Icon.Handle := ExtractIcon(0, PChar(Arquivo[n]), i);
            Icon.Transparent := true;
            Icon.SaveToFile(IncludeTrailingBackSlash(SavetoFolder) +
                        Arq + ' - '+ IntToStr(i)+'.ico');
          end;
        finally
          icon.Free;
        end;
     end;
     showmessage('Extração de Icones Finalizada.');
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
   ExtractIconsFromWindows('C:\Icones');
end;

end.

Abraço

Share this post


Link to post
Share on other sites

0 answers to this question

Recommended Posts

There have been no answers to this question yet

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Sign in to follow this  



  • Forum Statistics

    • Total Topics
      148575
    • Total Posts
      644272
×
×
  • Create New...