Buscar por:

Trocando icone do aplicativo ja compilado

Código

Este e o melhor

procedure UpdateIcons(const FileName, IcoFileName: String);

type

  PIcoItemHeader = ^TIcoItemHeader;

  TIcoItemHeader = packed record

    Width: Byte;

    Height: Byte;

    Colors: Byte;

    Reserved: Byte;

    Planes: Word;

    BitCount: Word;

    ImageSize: DWORD;

  end;

  PIcoItem = ^TIcoItem;

  TIcoItem = packed record

    Header: TIcoItemHeader;

    Offset: DWORD;

  end;

  PIcoHeader = ^TIcoHeader;

  TIcoHeader = packed record

    Reserved: Word;

    Typ: Word;

    ItemCount: Word;

    Items: array [0..MaxInt shr 4 - 1] of TIcoItem;

  end;

  PGroupIconDirItem = ^TGroupIconDirItem;

  TGroupIconDirItem = packed record

    Header: TIcoItemHeader;

    Id: Word;

  end;

  PGroupIconDir = ^TGroupIconDir;

  TGroupIconDir = packed record

    Reserved: Word;

    Typ: Word;

    ItemCount: Word;

    Items: array [0..MaxInt shr 4 - 1] of TGroupIconDirItem;

  end;

function GetResLang(hModule: Cardinal; lpType, lpName: PAnsiChar; var wLanguage: Word): Boolean;

function EnumLangs(hModule: Cardinal; lpType, lpName: PAnsiChar; wLanguage: Word; lParam: Integer): BOOL; stdcall;

begin

  PWord(lParam)^ := wLanguage;

  Result := False;

end;

begin

  wLanguage := 0;

  EnumResourceLanguages(hModule, lpType, lpName, @EnumLangs, Integer(@wLanguage));

  Result := True;

end;

  function IsIcon(P: Pointer; Size: Cardinal): Boolean;

  var

    ItemCount: Cardinal;

  begin

    Result := False;

    if Size < Cardinal(SizeOf(Word) * 3) then

      Exit;

    if (PChar(P)[0] = 'M') and (PChar(P)[1] = 'Z') then

      Exit;

    ItemCount := PIcoHeader(P).ItemCount;

    if Size < Cardinal((SizeOf(Word) * 3) + (ItemCount * SizeOf(TIcoItem))) then

      Exit;

    P := @PIcoHeader(P).Items;

    while ItemCount > Cardinal(0) do begin

      if (Cardinal(PIcoItem(P).Offset + PIcoItem(P).Header.ImageSize) < Cardinal(PIcoItem(P).Offset)) or

         (Cardinal(PIcoItem(P).Offset + PIcoItem(P).Header.ImageSize) > Cardinal(Size)) then

        Exit;

      Inc(PIcoItem(P));

      Dec(ItemCount);

    end;

    Result := True;

  end;

var

  H: THandle;

  M: HMODULE;

  R: HRSRC;

  Res: HGLOBAL;

  GroupIconDir, NewGroupIconDir: PGroupIconDir;

  I: Integer;

  wLanguage: Word;

  F: TFileStream;

  Ico: PIcoHeader;

  N: Cardinal;

  NewGroupIconDirSize: LongInt;

begin

  if Win32Platform <> VER_PLATFORM_WIN32_NT then

    ShowMessage('Somete Plataformas NT');

  Ico := nil;

  try

    F := TFileStream.Create(IcoFileName, FmOpenRead);

    try

      N := F.Size;

      if Cardinal(N) > Cardinal($100000) then  { sanity check }

        ShowMessage('Tamanho de Icone não suportado');

      GetMem(Ico, N);

      F.ReadBuffer(Ico^, N);

    finally

      F.Free;

    end;

    if not IsIcon(Ico, N) then

      ShowMessage('Formato de icone desconhecido');

    H := BeginUpdateResource(PChar(FileName), False);

    if H = 0 then

      ShowMessage('Falhou no Passo (1)');

    try

      M := LoadLibraryEx(PChar(FileName), 0, LOAD_LIBRARY_AS_DATAFILE);

      if M = 0 then

        ShowMessage('Falhou no Passo (2)');

      try

        R := FindResource(M, 'MAINICON', RT_GROUP_ICON);

        if R = 0 then

          ShowMessage('Falhou no Passo (3)');

        Res := LoadResource(M, R);

        if Res = 0 then

          ShowMessage('Falhou no Passo (4)');

        GroupIconDir := LockResource(Res);

        if GroupIconDir = nil then

          ShowMessage('Falhou no Passo (5)');

        if not GetResLang(M, RT_GROUP_ICON, 'MAINICON', wLanguage) then

          ShowMessage('Falhou no Passo (6)');

        if not UpdateResource(H, RT_GROUP_ICON, 'MAINICON', wLanguage, nil, 0) then

          ShowMessage('Falhou no Passo (7)');

        for I := 0 to GroupIconDir.ItemCount-1 do begin

          if not GetResLang(M, RT_ICON, MakeIntResource(GroupIconDir.Items[I].Id), wLanguage) then

            ShowMessage('Falhou no Passo (8)');

          if not UpdateResource(H, RT_ICON, MakeIntResource(GroupIconDir.Items[I].Id), wLanguage, nil, 0) then

            ShowMessage('Falhou no Passo (9)');

        end;

        NewGroupIconDirSize := 3*SizeOf(Word)+Ico.ItemCount*SizeOf(TGroupIconDirItem);

        GetMem(NewGroupIconDir, NewGroupIconDirSize);

        try

          NewGroupIconDir.Reserved := GroupIconDir.Reserved;

          NewGroupIconDir.Typ := GroupIconDir.Typ;

          NewGroupIconDir.ItemCount := Ico.ItemCount;

          for I := 0 to NewGroupIconDir.ItemCount-1 do begin

            NewGroupIconDir.Items[I].Header := Ico.Items[I].Header;

            NewGroupIconDir.Items[I].Id := I+1; //assumes that there aren't any icons left

          end;

          for I := 0 to NewGroupIconDir.ItemCount-1 do

            if not UpdateResource(H, RT_ICON, MakeIntResource(NewGroupIconDir.Items[I].Id), 1033, Pointer(DWORD(Ico) + Ico.Items[I].Offset), Ico.Items[I].Header.ImageSize) then

              ShowMessage('Falhou no Passo (10)');

          if not UpdateResource(H, RT_GROUP_ICON, 'MAINICON', 1033, NewGroupIconDir, NewGroupIconDirSize) then

            ShowMessage('Falhou no Passo (11)');

        finally

          FreeMem(NewGroupIconDir);

        end;

      finally

        FreeLibrary(M);

      end;

    except

      EndUpdateResource(H, True);  { discard changes }

      raise;

    end;

    if not EndUpdateResource(H, False) then

      ShowMessage('Falhou no Passo (12)');

  finally

    FreeMem(Ico);

  end;

end;