PNG Semitransparenz aus Schwarz/Grau/weiß etc berechnen

[Namenloser]

Diesen Code habe ich mal geschrieben. Genutzt wird hier TBitmap32 aus der Graphics32-Bibliothek, sollte sich aber einfach auf das Standard-TBitmap umschreiben lassen:

Delphi-Quellcode:

function RestoreOriginalValue(const ValueOnBlack, ValueOnWhite: integer;
  MaxValue: integer; Alpha: integer; MaxAlpha: integer): integer; inline;
// Meine Herleitung, die hier aber nicht verwendet wird, weil sie als Ergebnis Mist liefert (s.u.)
// I    d1 = c0*a + c1*(1-a)
// II   d2 = c0*a + c2*(1-a)
//
//      d1 = c0*a + c1*(1-a) | -c1*(1-a)
// III  d1-c1*(1-a) = c0*a
//
//      d2 = c0*a + c2*(1-a) | -c2*(1-a)
// IV   d2-c2*(1-a) = c0*a
//
// III + IV
//      d1 - c1*(1-a) + d2 - c2*(1-a)        = 2*c0*a
//      d1 + d2 - (1-a)(c1+c2)               = 2*c0*a  | /2
//      (d1 + d2 - (1-a)(c1+c2))/(2a)        = c0
//var
//  Tmp: double;
begin
  if IsZero(Alpha) then
    raise Exception.Create('Cannot define Color because alpha=0')
  else
  begin
// Meine selbst hergleitete Formel, die schlechte Ergebnisse liefert:
//    Tmp := (ValueOnBlack + ValueOnWhite - MaxValue + Alpha)*MaxAlpha/(2*Alpha);
//    Result := Round(Tmp);
// Von ZScreen geklaute Formel[*]:
    Result := (ValueOnBlack * MaxValue) div Alpha;
  end;
//[*] http://code.google.com/p/zscreen/source/browse/trunk/GraphicsManagerLib/GraphicsMgr.cs#668
end;

function RestoreTransparentColor(const ColorOnBlack: TRGB;
  const ColorOnWhite: TRGB): TRGBA; inline; overload;
var
  AlphaValue: int64;
  A: byte;
begin
  AlphaValue := 255 - (ColorOnWhite.R-ColorOnBlack.R +
                       ColorOnWhite.G-ColorOnBlack.G +
                       ColorOnWhite.B-ColorOnBlack.B ) div 3;
  A := Byte(min(255, max(0,AlphaValue)));
  Result.A := A;
  Result.R := RestoreOriginalValue(ColorOnBlack.R, ColorOnWhite.R, 255, A, 255);
  Result.G := RestoreOriginalValue(ColorOnBlack.G, ColorOnWhite.G, 255, A, 255);
  Result.B := RestoreOriginalValue(ColorOnBlack.B, ColorOnWhite.B, 255, A, 255);
end;

function RestoreTransparentColor(const ColorOnBlack: TColor32;
  const ColorOnWhite: TColor32): TColor32; inline; overload;
var
  AlphaValue: int64;
  A: byte;
  R1,G1,B1,
  R2,G2,B2: byte;
begin
  R1 := GetRValue(ColorOnWhite);
  G1 := GetGValue(ColorOnWhite);
  B1 := GetBValue(ColorOnWhite);
  R2 := GetRValue(ColorOnBlack);
  G2 := GetGValue(ColorOnBlack);
  B2 := GetBValue(ColorOnBlack);
  AlphaValue := 255 - (R1-R2 + G1-G2 + B1-B2 ) div 3;
  A := Byte(min(255, max(0,AlphaValue)));
  if A = 255 then
    Result := SetAlpha(ColorOnBlack,255) // oder ColorOnWhite...
  else if A>0 then
  begin
    Result := Color32(
      RestoreOriginalValue(B2, B1, 255, A, 255),
      RestoreOriginalValue(G2, G1, 255, A, 255),
      RestoreOriginalValue(R2, R1, 255, A, 255),
      R2-R1+255
    );
  end
  else
    Result := Gray32(0,0);
end;

procedure RestoreAlphaChannel(const BmpBlack, BmpWhite: TBitmap32;
  const Dest: TBitmap32);
var
  PtrBlack,
  PtrWhite,
  PtrDest: PColor32;
  EndPtr: PColor32;
begin
  if (BmpBlack.Width <> BmpWhite.Width) or (BmpBlack.Height <> BmpWhite.Height) then
    Exception.Create('Bitmaps have different sizes');
  Dest.SetSize(bmpBlack.Width, BmpBlack.Height);
  PtrBlack := BmpBlack.PixelPtr[0,0];
  PtrWhite := BmpWhite.PixelPtr[0,0];
  PtrDest  := Dest.PixelPtr[0,0];
  EndPtr := BmpBlack.PixelPtr[BmpBlack.Width-1, BmpBlack.Height-1];
  while PtrBlack <> EndPtr do
  begin
    PtrDest^ := RestoreTransparentColor(PtrBlack^, PtrWhite^);
    inc(PtrBlack);
    inc(PtrWhite);
    inc(PtrDest);
  end;
end;

Im Anhang eine kleine Demo-Anwendung dazu. Man kann u.a. einen Screenshot des Formulars erstellen und die Alphatransparenz des Aero-Rahmens wiederherstellen. Super dokumentiert ist der Code jetzt nicht, aber ich denke, man kann ihn als Grundlage benutzen.