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.

[Uwe Raabe]

Soweit ich das sehe, wird auch beim Füllen der VirtualImageList das OnGetBitmap aufgerufen. Kannst du mal ein einfaches Beispiel bauen, mit dem sich das Problem reproduzieren lässt?

[BigAl]

Zitat von Uwe Raabe:

Soweit ich das sehe, wird auch beim Füllen der VirtualImageList das OnGetBitmap aufgerufen. Kannst du mal ein einfaches Beispiel bauen, mit dem sich das Problem reproduzieren lässt?

Hallo Uwe.

Das ist ja mein Problem. Beim Füllen der VirtualImageList wird OnGetBitmap verwendet. So solls ja auch sein. Aber die visuelle Komponente TVirtualImage nutzt OnGetBitmap nicht.

TVirtualImage nutzt ja die ImageCollection und leider nicht die VirtualImageList...

[Uwe Raabe]

OK, falsch gelesen...

Es ist in der Tat so, dass TVirtualImage kein Bitmap aus der Collection übernimmt, sondern einfach deren Draw-Routine aufruft und so den OnGetBitmap-Event umgeht. Das ist objektiv zumindest effizienter, da nicht erst ein Bitmap erstellt werden muss. Dummerweise fällt dein Anwendungsfall dann aber hinten runter.

[BigAl]

Ja. Leider.

Allerdings habe ich gesehen, dass "OnDraw" aufgerufen wird. Vielleicht kann man da was basteln.

Wäre halt super wenn TVirtualImage alternativ auf VirtualImageList und nicht nur auf ImageCollection verweisen könnte...

Trotzdem Danke Uwe!