procedure TdmMain.ImageCollectionGetBitmap(ASourceImage: TWICImage; AWidth, AHeight: Integer;
out ABitmap: TBitmap);
// Make all images monochrome. Use the text color (clWindowText).
var
BufferImage: TWICImage;
TextColor: TColor;
R, G, B: Byte;
begin
ABitmap := TBitmap.Create;
if not TStyleManager.ActiveStyle.Enabled
then
begin
ABitmap.PixelFormat := pf32bit;
ABitmap.Canvas.Brush.Color := clBtnFace;
ABitmap.SetSize(AWidth, AHeight);
ABitmap.Canvas.StretchDraw(Rect(0, 0, AWidth, AHeight), ASourceImage);
end
else if (ASourceImage.Width = AWidth)
and (ASourceImage.Height = AHeight)
then
ABitmap.Assign(ASourceImage)
else
begin
BufferImage := ASourceImage.CreateScaledCopy(AWidth, AHeight, wipmHighQualityCubic);
try
ABitmap.Assign(BufferImage);
finally
BufferImage.Free;
end;
end;
if ABitmap.PixelFormat = pf32bit
then
ABitmap.AlphaFormat := afIgnored;
// convert the image to the current text color (only for images with alpha channel).
if ABitmap.PixelFormat = pf32bit
then
begin
// Get the text color of the current theme.
if StyleServices.Enabled
then
TextColor := StyleServices.GetSystemColor(clWindowText)
else
TextColor := clWindowText;
// Get the RGB part of the real text color.
TextColor := ColorToRGB(TextColor);
R := TextColor
shr 16
and $FF;
G := TextColor
shr 8
and $FF;
B := TextColor
shr 0
and $FF;
// Set all pixel to text color.
for var Y := 0
to ABitmap.Height - 1
do
begin
var
Pixel: PByteArray := ABitmap.ScanLine[Y];
for var X := 0
to ABitmap.Width - 1
do
begin
Pixel[X * 4 + 0] := R;
Pixel[X * 4 + 1] := G;
Pixel[X * 4 + 2] := B;
// Ignore (preserve) alpha. The image is only drawn by it's transparency...
// Pixel[X * 4 + 3]
end;
end;
end;
end;