Ir para conteúdo
Fórum Script Brasil
  • 0

Extrair + de 1000 Icones do Windows


Jhonas

Pergunta

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 para o comentário
Compartilhar em outros sites

0 respostass a esta questão

Posts Recomendados

Até agora não há respostas para essa pergunta

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152k
    • Posts
      651,8k
×
×
  • Criar Novo...