В Vista и выше был добавлен ряд новых функций, которые делают эту задачу тривиальной. Наиболее подходящая функция здесь: LoadIconWithScaleDown.
Эта функция сначала выполняет поиск файла значков с точно таким же размером. Если совпадение не найдено, то, если оба значения cx и cy не соответствуют одному из стандартных размеров значков - 16, 32, 48 или 256 пикселей, выбирается следующий по значению значок, а затем уменьшается до желаемого размера. Например, если приложение с позывным запрашивает значок с размером x 40 пикселей, используется значок с 48 пикселями, который уменьшается до 40 пикселей. Напротив, функция LoadImage выбирает 32-пиксельный значок и масштабирует его до 40 пикселей.
Если функция не может найти значок большего размера, по умолчанию используется стандартное поведение поиска следующего наименьшего значка и его масштабирования до нужного размера.
По моему опыту, эта функция отлично справляется с масштабированием, и результаты не показывают признаков алиасинга.
Для более ранних версий Windows, насколько мне известно, нет ни одной функции, которая могла бы адекватно выполнить эту задачу. Результаты, полученные из LoadImage, имеют очень низкое качество. Вместо этого лучший подход, который я нашел, заключается в следующем:
- Изучите доступные изображения в ресурсе, чтобы найти изображение с наибольшим размером, который меньше требуемого размера значка.
- Создайте новый значок нужного размера и инициализируйте его, чтобы он был полностью прозрачным.
- Поместите меньший значок из ресурса в центр нового (большего) значка.
Это означает, что вокруг значка будет небольшая прозрачная рамка, но обычно она достаточно мала, чтобы быть незначительной. Идеальный вариант - использовать код, который может уменьшаться, как LoadIconWithScaleDown, но писать его нетривиально.
Итак, без лишних слов, вот код, который я использую.
unit uLoadIconResource;
interface
uses
SysUtils, Math, Classes, Windows, Graphics, CommCtrl;
function LoadIconResourceSize(const ResourceName: string; IconSize: Integer): HICON;//will not throw an exception
function LoadIconResourceMetric(const ResourceName: string; IconMetric: Integer): HICON;
implementation
function IconSizeFromMetric(IconMetric: Integer): Integer;
begin
case IconMetric of
ICON_SMALL:
Result := GetSystemMetrics(SM_CXSMICON);
ICON_BIG:
Result := GetSystemMetrics(SM_CXICON);
else
raise EAssertionFailed.Create('Invalid IconMetric');
end;
end;
procedure GetDIBheaderAndBits(bmp: HBITMAP; out bih: BITMAPINFOHEADER; out bits: Pointer);
var
pbih: ^BITMAPINFOHEADER;
bihSize, bitsSize: DWORD;
begin
bits := nil;
GetDIBSizes(bmp, bihSize, bitsSize);
pbih := AllocMem(bihSize);
Try
bits := AllocMem(bitsSize);
GetDIB(bmp, 0, pbih^, bits^);
if pbih.biSize<SizeOf(bih) then begin
FreeMem(bits);
bits := nil;
exit;
end;
bih := pbih^;
Finally
FreeMem(pbih);
End;
end;
function CreateIconFromSmallerIcon(IconSize: Integer; SmallerIcon: HICON): HICON;
procedure InitialiseBitmapInfoHeader(var bih: BITMAPINFOHEADER);
begin
bih.biSize := SizeOf(BITMAPINFOHEADER);
bih.biWidth := IconSize;
bih.biHeight := 2*IconSize;//height of xor bitmap plus height of and bitmap
bih.biPlanes := 1;
bih.biBitCount := 32;
bih.biCompression := BI_RGB;
end;
procedure CreateXORbitmap(const sbih, dbih: BITMAPINFOHEADER; sptr, dptr: PDWORD);
var
line, xOffset, yOffset: Integer;
begin
xOffset := (IconSize-sbih.biWidth) div 2;
yOffset := (IconSize-sbih.biHeight) div 2;
inc(dptr, xOffset + IconSize*yOffset);
for line := 0 to sbih.biHeight-1 do begin
Move(sptr^, dptr^, sbih.biWidth*SizeOf(DWORD));
inc(dptr, IconSize);//relies on the fact that no padding is needed for RGBA scanlines
inc(sptr, sbih.biWidth);//likewise
end;
end;
var
SmallerIconInfo: TIconInfo;
sBits, xorBits: PDWORD;
xorScanSize, andScanSize: Integer;
xorBitsSize, andBitsSize: Integer;
sbih: BITMAPINFOHEADER;
dbih: ^BITMAPINFOHEADER;
resbitsSize: DWORD;
resbits: Pointer;
begin
Result := 0;
Try
if not GetIconInfo(SmallerIcon, SmallerIconInfo) then begin
exit;
end;
Try
GetDIBheaderAndBits(SmallerIconInfo.hbmColor, sbih, Pointer(sBits));
if Assigned(sBits) then begin
Try
if (sbih.biWidth>IconSize) or (sbih.biHeight>IconSize) or (sbih.biPlanes<>1) or (sbih.biBitCount<>32) then begin
exit;
end;
xorScanSize := BytesPerScanline(IconSize, 32, 32);
Assert(xorScanSize=SizeOf(DWORD)*IconSize);
andScanSize := BytesPerScanline(IconSize, 1, 32);
xorBitsSize := IconSize*xorScanSize;
andBitsSize := IconSize*andScanSize;
resbitsSize := SizeOf(BITMAPINFOHEADER) + xorBitsSize + andBitsSize;
resbits := AllocMem(resbitsSize);//AllocMem zeroises the memory
Try
dbih := resbits;
InitialiseBitmapInfoHeader(dbih^);
xorBits := resbits;
inc(PByte(xorBits), SizeOf(BITMAPINFOHEADER));
CreateXORbitmap(sbih, dbih^, sBits, xorBits);
//don't need to fill in the mask bitmap when using RGBA
Result := CreateIconFromResourceEx(resbits, resbitsSize, True, $00030000, IconSize, IconSize, LR_DEFAULTCOLOR);
Finally
FreeMem(resbits);
End;
Finally
FreeMem(sBits);
End;
end;
Finally
if SmallerIconInfo.hbmMask<>0 then begin
DeleteObject(SmallerIconInfo.hbmMask);
end;
if SmallerIconInfo.hbmColor<>0 then begin
DeleteObject(SmallerIconInfo.hbmColor);
end;
End;
Finally
DestroyIcon(SmallerIcon);
End;
end;
function LoadIconResourceSize(const ResourceName: string; IconSize: Integer): HICON;//will not throw an exception
function LoadImage(IconSize: Integer): HICON;
begin
Result := Windows.LoadImage(HInstance, PChar(ResourceName), IMAGE_ICON, IconSize, IconSize, LR_DEFAULTCOLOR);
end;
type
TGrpIconDir = packed record
idReserved: Word;
idType: Word;
idCount: Word;
end;
TGrpIconDirEntry = packed record
bWidth: Byte;
bHeight: Byte;
bColorCount: Byte;
bReserved: Byte;
wPlanes: Word;
wBitCount: Word;
dwBytesInRes: DWORD;
wID: WORD;
end;
var
i, BestAvailableIconSize, ThisSize: Integer;
ResourceNameWide: WideString;
Stream: TResourceStream;
IconDir: TGrpIconDir;
IconDirEntry: TGrpIconDirEntry;
begin
//LoadIconWithScaleDown does high quality scaling and so we simply use it if it's available
ResourceNameWide := ResourceName;
if Succeeded(LoadIconWithScaleDown(HInstance, PWideChar(ResourceNameWide), IconSize, IconSize, Result)) then begin
exit;
end;
//XP: find the closest sized smaller icon and draw without stretching onto the centre of a canvas of the right size
Try
Stream := TResourceStream.Create(HInstance, ResourceName, RT_GROUP_ICON);
Try
Stream.Read(IconDir, SizeOf(IconDir));
Assert(IconDir.idCount>0);
BestAvailableIconSize := high(BestAvailableIconSize);
for i := 0 to IconDir.idCount-1 do begin
Stream.Read(IconDirEntry, SizeOf(IconDirEntry));
Assert(IconDirEntry.bWidth=IconDirEntry.bHeight);
ThisSize := IconDirEntry.bHeight;
if ThisSize=0 then begin//indicates a 256px icon
continue;
end;
if ThisSize=IconSize then begin
//a perfect match, no need to continue
Result := LoadImage(IconSize);
exit;
end else if ThisSize<IconSize then begin
//we're looking for the closest sized smaller icon
if BestAvailableIconSize<IconSize then begin
//we've already found one smaller
BestAvailableIconSize := Max(ThisSize, BestAvailableIconSize);
end else begin
//this is the first one that is smaller
BestAvailableIconSize := ThisSize;
end;
end;
end;
if BestAvailableIconSize<IconSize then begin
Result := CreateIconFromSmallerIcon(IconSize, LoadImage(BestAvailableIconSize));
if Result<>0 then begin
exit;
end;
end;
Finally
FreeAndNil(Stream);
End;
Except
;//swallow because this routine is contracted not to throw exceptions
End;
//final fallback: make do without
Result := 0;
end;
function LoadIconResourceMetric(const ResourceName: string; IconMetric: Integer): HICON;
begin
Result := LoadIconResourceSize(ResourceName, IconSizeFromMetric(IconMetric));
end;
end.
Использование этих функций совершенно очевидно. Они предполагают, что ресурс находится в том же модуле, что и код. Код может быть легко обобщен для получения HMODULE в случае, если вам нужна поддержка для этого уровня общности.
Позвоните LoadIconResourceMetric, если вы хотите загрузить значки размером, равным маленькому значку системы или большому значку системы. Параметр IconMetric должен быть либо ICON_SMALL, либо ICON_BIG. Для панелей инструментов, меню и значков уведомлений следует использовать ICON_SMALL.
Если вы хотите указать размер иконки в абсолютном выражении, используйте LoadIconResourceSize.
Эти функции возвращают HICON. Конечно, вы можете присвоить это свойству Handle экземпляра TIcon. Скорее всего, вы захотите добавить в список изображений. Самый простой способ сделать это - вызвать ImageList_AddIcon, передав Handle экземпляра TImageList.
Примечание 1: В более старых версиях Delphi LoadIconWithScaleDown не определено в CommCtrl. Для таких версий Delphi вам нужно позвонить GetProcAddress, чтобы загрузить его. Обратите внимание, что это API-интерфейс только для Unicode, поэтому вы должны отправить ему PWideChar в качестве имени ресурса. Вот так: LoadIconWithScaleDown(..., PWideChar(WideString(ResourceName)),...).
Примечание 2: Определение LoadIconWithScaleDown неверно. Если вы позвоните после инициализации библиотеки общих элементов управления, у вас не возникнет проблем. Однако, если вы вызываете функцию на ранних этапах жизненного цикла вашего процесса, то LoadIconWithScaleDown может дать сбой. Я только что отправил QC # 101000 , чтобы сообщить об этой проблеме. Опять же, если вы страдаете от этого, вы должны позвонить GetProcAddress самостоятельно.