PNG in TImage falsch dargestellt

[Rolf Frei]

Mit der PNG Unit von D7 kann man transparente PNG problemlos laden und anzeigen. Dass das in Rio nicht mehr geht hat ganz andere Gründe. Da hat nämlich irgend ein Witzbold einfach den transparenten Teil auf fix schwarz gesetzt. Keine Ahung was man damit errreichen wollte, aber auf jeden Fall kann man so keine transparentten PNG's mehr an eine Bitmap assignen. Die Hintergrundfarbe müsste auf jeden Fall vom Anwender bestimmt werden und nciht fix Schwarz sein. In meinem Fall will ich da nämlich weiss als Hintergrundfarbe und nicht schwarz. Dafür müsste es ein Property geben.

Habe noch eine Beispiel PNG angehängt, die einen Alphchannel hat und transparent sein sollte. Dieses wird nun fix mit schwarzem Hintergrund angezeigt, wenn es an ein Bitmap assigned wird.

Das ist der entsprechende Code in der alten D7 PNGImage unit, der einwandfrei mit PNG's mit einem Alphachannel funktioniert:

Delphi-Quellcode:

**** PNGImage von D7 ****

{Assigns this TPNGImage to another object}
procedure TPNGImage.AssignTo(Dest: TPersistent);
{$IFDEF UseDelphi}
  function DetectPixelFormat: TPixelFormat;
  begin
    with Header do
    begin
      {Always use 24bits for partial transparency}
      if TransparencyMode = ptmPartial then
        DetectPixelFormat := pf24bit
      else
        case BitDepth of
          {Only supported by COLOR_PALETTE}
          1: DetectPixelFormat := pf1bit;
          2, 4: DetectPixelFormat := pf4bit;
          {8 may be palette or r, g, b values}
          8, 16:
            case ColorType of
              COLOR_RGB, COLOR_GRAYSCALE: DetectPixelFormat := pf24bit;
              COLOR_PALETTE: DetectPixelFormat := pf8bit;
              else raise Exception.Create('');
            end {case ColorFormat of}
          else raise Exception.Create('');
        end {case BitDepth of}
    end {with Header}
  end;
var
  TRNS: TChunkTRNS;
{$ENDIF}
begin
  {If the destination is also a TPNGImage make it assign}
  {this one}
  if Dest is TPNGImage then
    TPNGImage(Dest).AssignPNG(Self)
  {$IFDEF UseDelphi}
  {In case the destination is a bitmap}
  else if (Dest is TBitmap) and HeaderPresent then
  begin
    {Copies the handle using CopyImage API}
    TBitmap(Dest).PixelFormat := DetectPixelFormat;
    TBitmap(Dest).Width := Width;
    TBitmap(Dest).Height := Height;

    if Palette <> 0 then
      TBitmap(Dest).Palette := CopyPalette(Palette);

    if (TransparencyMode = ptmBit) then
    begin
      TRNS := Chunks.ItemFromClass(TChunkTRNS) as TChunkTRNS;
      TBitmap(Dest).TransparentColor := TRNS.TransparentColor;
      TBitmap(Dest).Transparent := True;
      SetStretchBltMode(TBitmap(Dest).Canvas.Handle, COLORONCOLOR);
      StretchDiBits(TBitmap(Dest).Canvas.Handle, 0, 0, Width, Height, 0, 0,
        Width, Height, Header.ImageData,
        pBitmapInfo(@Header.BitmapInfo)^, DIB_RGB_COLORS, SRCCOPY)

    end {if (TransparencyMode = ptmBit)}
    else
      TBitmap(Dest).Canvas.Draw(0, 0, Self);
  end
  else
    {Unknown destination kind}
    inherited AssignTo(Dest);
  {$ENDIF}
end;

Dieser Code wurde in Rio (oder auch schon füher), so abgeändert, dass da fix schwarz als Hintergrund verwendet wird. Folgende 2 Zeilen wurde da eingefügt, die nun den Effekt haben, das der Alpahachannel ncht merh funktioniert und alles, was transparent sein sollte, nun schwarz ist. (siehe ungefähr in der Mitte des Quelcodes)

TBitmap(Dest).Canvas.Brush.Color := 0;
TBitmap(Dest).Canvas.FillRect(Bounds(0,0,Width, Height));

Delphi-Quellcode:

**** PNGImage von 10.3 ***

{Assigns this TPngImage to another object}
procedure TPngImage.AssignTo(Dest: TPersistent);
{$IFDEF UseDelphi}
  function DetectPixelFormat: TPixelFormat;
  begin
    with Header do
    begin
      {Always use 24bits for partial transparency}
      if TransparencyMode = ptmPartial then
        DetectPixelFormat := pf24bit
      else
        case BitDepth of
          {Only supported by COLOR_PALETTE}
          1: DetectPixelFormat := pf1bit;
          2, 4: DetectPixelFormat := pf4bit;
          {8 may be palette or r, g, b values}
          8, 16:
            case ColorType of
              COLOR_RGB, COLOR_GRAYSCALE: DetectPixelFormat := pf24bit;
              COLOR_PALETTE: DetectPixelFormat := pf8bit;
              else raise Exception.Create('');
            end {case ColorFormat of}
          else raise Exception.Create('');
        end {case BitDepth of}
    end {with Header}
  end;
var
  TRNS: TChunkTRNS;
{$ENDIF}
begin
  {If the destination is also a TPngImage make it assign}
  {this one}
  if Dest is TPngImage then
    TPngImage(Dest).AssignPNG(Self)
  {$IFDEF UseDelphi}
  {In case the destination is a bitmap}
  else if (Dest is TBitmap) and HeaderPresent then
  begin
    TBitmap(Dest).SetSize(Width, Height);

    if (TransparencyMode = ptmPartial) then
    begin
      TBitmap(Dest).PixelFormat := pf32bit;
      TBitmap(Dest).AlphaFormat := afDefined;
// Die 2 folgenden Zeilen sind neu: Wer hat sich diesen Blödsinn überlegt?!
      TBitmap(Dest).Canvas.Brush.Color := 0;  // <<< zumindest das hier sollte vom Anwender wählbar sein, also als Property zur Verfügung stehen.
      TBitmap(Dest).Canvas.FillRect(Bounds(0,0,Width, Height));
    end
    else
    begin
      TBitmap(Dest).PixelFormat := DetectPixelFormat;
      TBitmap(Dest).AlphaFormat := afIgnored;
    end;

    if Palette <> 0 then
      TBitmap(Dest).Palette := CopyPalette(Palette);

    if (TransparencyMode = ptmBit) then
    begin
      TRNS := TChunkTRNS(Chunks.ItemFromClass(TChunkTRNS));
      TBitmap(Dest).TransparentColor := TRNS.TransparentColor;
      TBitmap(Dest).Transparent := True;
      SetStretchBltMode(TBitmap(Dest).Canvas.Handle, COLORONCOLOR);
      StretchDiBits(TBitmap(Dest).Canvas.Handle, 0, 0, Width, Height, 0, 0,
        Width, Height, Header.ImageData,
        pBitmapInfo(@Header.BitmapInfo)^, DIB_RGB_COLORS, SRCCOPY)

    end {if (TransparencyMode = ptmBit)}
    else
      TBitmap(Dest).Canvas.Draw(0, 0, Self);
  end
  else
    {Unknown destination kind}
    inherited AssignTo(Dest);
  {$ENDIF}
end;

Eine Zuweisung einer PNG mit Alphachannel an eine Bitmap mit Assign, wird deswegen immer mit schwarzem Hintergrund dargestellt. Mit der alten Unit von D7 funktioniert das noch tadellos und ist bei mir seit Jahren so im Einsatz, ohne dass ich da auf GDI+ oder ähnliches zugreiffen müsste. In Rio ist da was "kaputt" gemacht worden.