TVirtualImage und TImageCollection OnGetBitmap

[BigAl]

Hallo,

ich nutze eine zentrale TImageCollection zum Verwalten meiner Symbole. Um dem jeweillgen aktiven Theme gerecht zu werden nutze ich OnGetBitmap. Darin werden die (einfarbigen) Symbole jeweils auf die aktuell gültige Farbe clWindowText angepasst. Da funktioniert in mehreren meiner Applikationen hervorragend.

Nun habe ich ein paar manuell platzierte Symbole, welche ich mit TVirtualImage hinzufügen möchte. Leider lädt TVirtualImage immer direkt aus der TImageCollection und umgeht OnGetBitmap. Hat irgendjemand eine Idee wie man TVirtualImage dazu bringen könnte die angepassten anstelle der originalen Bilder zu laden? Leider findet man zu TVirtualImage nicht wirklich viel. Sollte OnGetBitmap nicht immer aufgerufen werden wenn eine Image aus der Collection benötigt wird?

Falls es jemand interessiert. So sieht mein Code von OnGetBitmap aus:

Delphi-Quellcode:

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;

Obiger Code wird nur beim Start der Applikation oder beim Umschalten des aktuellen Theme einmal für jedes Image von TImageCollection aufgerufen.