<ort>Niebardzo </ort>wiem, jak Tobie pomóc. Sprawdziłem Twój kod dla mojego execa który posiada jako ikonkę faviconkę ze
strony chomikuj.pl. W oryginale ikonka ma zielone tło i zajmuje ponad 3 KB, po wydobyciu tym kodem co podałeś,
ma ona brzydkie kolory i zółte tło oraz zajmuje tyle co standardowa ikonka z mała ilością kolorów czyli 766 bajtów.
Jedyne co mogę doradzić to skorzystanie z poniższego kodu, ktory tworzy prawidłową ikonkę taką jak źródłowa z
pliku exe. W oryginale ta procedura była umieszczona chyba na swissdelphicenter, a wykorzystałem ją też w swoim
programie ktory konwertuje bitmapy na ikonki. Innego sposobu nie znam. Może ten będzie Tobie też odpowiadał :)
procedure HiBmpAsIcon(const Bmp : TBitmap; const Icon : string; const SmallIcon : Boolean;
const Transparent : Boolean; const X, Y : Integer);
type
TIconDirEntry = packed record
bWidth : Byte;
bHeight : Byte;
bColorCount : Byte;
bReserved : Byte;
wPlanes : Word;
wBitCount : Word;
dwBytesInRes : DWord;
dwImageOffset : DWord;
end;
TIcondir = packed record
idReserved : Word;
idType : Word;
idCount : Word;
IdEntries : array[1..20] of TIconDirEntry;
end;
var
PBI, MPBI : PBitmapInfo;
IHS, MIHS, ImageSize, MImageSize : DWord;
bmBuffer, MaskBuffer : Pointer;
TID : TIconDir;
TBIH : TBitmapInfoHeader;
Bmx, Bmm : TBitmap;
TranspCol : TColor;
I, J : Integer;
begin
Bmx := TBitmap.Create;
Bmm := TBitmap.Create;
try
if SmallIcon then begin
Bmx.Width := GetSystemMetrics(SM_CXSMICON);
Bmx.Height := GetSystemMetrics(SM_CYSMICON);
end else begin
Bmx.Width := GetSystemMetrics(SM_CXICON);
Bmx.Height := GetSystemMetrics(SM_CYICON);
end;
bmx.pixelformat := pf24bit;
Bmx.Canvas.StretchDraw(Rect(0, 0, Bmx.Width, Bmx.Height), Bmp);
TranspCol := Bmx.Canvas.Pixels[X, Y];
Bmm.Assign(Bmx);
Bmm.Mask(TranspCol);
GetDIBSizes(Bmm.Handle, MIHS, MImageSize);
GetDIBSizes(Bmx.Handle, IHS, ImageSize);
MaskBuffer := AllocMem(MImageSize);
bmBuffer := AllocMem(ImageSize);
MPBI := AllocMem(MIHS);
PBI := AllocMem(IHS);
try
if Transparent then begin
for I := 0 to Bmx.Width - 1 do
for J := 0 to Bmx.Height - 1 do
if Bmx.Canvas.Pixels[I, J] = TranspCol then
Bmx.Canvas.Pixels[I, J] := 0;
with MPBI^.bmiHeader do begin
biSize := SizeOf(TBitmapInfoHeader);
biWidth := Bmm.Width;
biHeight := Bmm.Height;
biPlanes := 1;
biBitCount := 1;
biCompression := BI_RGB;
biSizeImage := MImageSize;
biXPelsPerMeter := 0;
biYPelsPerMeter := 0;
biClrUsed := 2;
biClrImportant := 2;
end;
GetDIBits(Bmm.Canvas.Handle, Bmm.Handle, 0, Bmm.height, MaskBuffer, MPBI^, DIB_RGB_COLORS);
end;
with PBI^.bmiHeader do begin
biSize := SizeOf(TBitmapInfoHeader);
biWidth := Bmx.Width;
biHeight := Bmx.Height;
biPlanes := 1;
biBitCount := 24;
biCompression := BI_RGB;
biSizeImage := ImageSize;
biXPelsPerMeter := 0;
biYPelsPerMeter := 0;
biClrUsed := 0;
biClrImportant := 0;
end;
GetDIBits(Bmx.Canvas.Handle, Bmx.Handle, 0, Bmx.Height, bmBuffer, PBI^, DIB_RGB_COLORS);
with TBIH do begin
biSize := 40;
biWidth := Bmx.Width;
biHeight := Bmx.Height * 2;
biPlanes := 1;
biBitCount := 24;
biCompression := 0;
biSizeImage := ImageSize;
biXPelsPerMeter := 0;
biYPelsPerMeter := 0;
biClrUsed := 0;
biClrImportant := 0;
end;
with TID do begin
idReserved := 0;
idType := 1;
idCount := 1;
with idEntries[1] do begin
bWidth := bmx.width;
bHeight := bmx.height;
bColorCount := 0;
bReserved := 0;
wPlanes := 1;
wBitCount := 24;
dwBytesInRes := SizeOf(TBitmapInfoHeader) + TBIH.biSizeImage + MImageSize;
dwImageOffset := 6 + TID.idCount * SizeOf(TIconDirEntry);
end;
end;
with TFileStream.Create(Icon, fmCreate) do try
Write(TID, 6 + TID.idCount * SizeOf(TIconDirEntry));
Write(TBIH, SizeOf(TBitmapInfoheader));
Write(bmBuffer^, TBIH.biSizeImage);
Write(maskBuffer^, MImageSize);
finally
Free;
end;
finally
FreeMem(MaskBuffer);
FreeMem(bmBuffer);
FreeMem(MPBI);
FreeMem(PBI);
end;
finally
Bmx.free;
Bmm.free;
end;
end;
Przykład użycia:
var
Ico : TIcon;
Bmp : TBitmap;
FileInfoz : SHFILEINFO;
begin
Ico := TIcon.Create;
Bmp := TBitmap.Create;
FillChar(FileInfoz, SizeOf(FileInfoz), #0);
SHGetFileInfo(PAnsichar('D:\test.exe'), 0, Fileinfoz, SizeOf(Fileinfoz),
SHGFI_ICON or SHGFI_LARGEICON or SHGFI_SHELLICONSIZE or SHGFI_SYSICONINDEX or
SHGFI_TYPENAME or SHGFI_DISPLAYNAME);
Ico.Handle := Copyicon(Fileinfoz.hIcon);
Image1.Picture.Icon := Ico;
Bmp.Height := Ico.Height;
Bmp.Width := Ico.Width;
Bmp.Canvas.Draw(0, 0, Ico);
HiBmpAsIcon(Bmp, 'D:\testowa_ikonka.ico', False, True, 0, 0);
Bmp.Free;
Ico.Free;
end;
(otoczka)