Jump to content
Fórum Script Brasil
  • 0

Extrair + de 1000 Icones do Windows


Jhonas

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

Link to comment
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.



  • Forum Statistics

    • Total Topics
      152.1k
    • Total Posts
      651.8k
×
×
  • Create New...