Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Multimedia (https://www.delphipraxis.net/16-multimedia/)
-   -   Delphi PNG Semitransparenz aus Schwarz/Grau/weiß etc berechnen (https://www.delphipraxis.net/157526-png-semitransparenz-aus-schwarz-grau-weiss-etc-berechnen.html)

Memnarch 14. Jan 2011 22:05

PNG Semitransparenz aus Schwarz/Grau/weiß etc berechnen
 
Nabend, ich mal wieder^^.

Eigentlich suchte ich nach einem prog, das wie GIMP eine Farbe(zb weiß) für transparenz nimt und damit auch semitransparenz erstellen kann.
Wnen ich in Gimp z.B nen gradient von schwarz nach weiß habe und weiß als "Transparenz aus Farbe" nutze, erhalte ich einen Alphatransparenz verlauf von durchsichtig nach undurchsichtig.

Problem: Ich habe hunderte von files, da gehts schlecht per hand. Alle batch process Programme die ich fand konnten nur Durchsichtig/Undurchsichtig aber keine Semitransparenz erstellen.

Also dachte ich es wäre super dass dan vllt in Delphi zu erledigen(außer einer hat son prog für mich^^). Das ganze brauch natürlich nicht in echtzeit sein, dafür sinds zuviele, aber ich möchte ne schöne Semitransparenz berechnen.

Also mit scanline&co komme ich ja nun an die Daten der Pixel. Aber irgendwie komm ich noch nicht ganz weiter. Was muss ich machen um z.B. bei einem PNG das noch keinen hat, den alphakanal hinzuzufügen/aktivieren?

MFG
Memnarch

Bummi 14. Jan 2011 22:56

AW: PNG Semitransparenz aus Schwarz/Grau/weiß etc berechnen
 
Die beiliegende Routine dient dazu BMP's mit Alphakanalinfo's in PNG's zu speichern.
Nicht ganz das was Du brauchst, aber Du kannst erkennen wie es funktioniert und es für Deine Zwecke umschreiben.
Delphi-Quellcode:
function PNG4TransparentBitMap(bmp:TBitmap):TPNGImage;
//201011 Thomas Wassermann
var
  x, y:Integer;
  vBmpRGBA: ^TRGBAArray;
  vPngRGB: ^TRGB;
begin
  Result := TPNGImage.CreateBlank(COLOR_RGBALPHA, 8, bmp.Width , bmp.Height);
  Result.CreateAlpha;
  Result.Canvas.CopyMode:= cmSrcCopy;
  Result.Canvas.Draw(0,0,bmp);

  for y := 0 to pred(bmp.Height) do begin
    vBmpRGBA := bmp.ScanLine[y];
    vPngRGB:= Result.Scanline[y];

    for x := 0 to pred(bmp.width) do begin
      Result.AlphaScanline[y][x] := vBmpRGBA[x].A;
      if bmp.AlphaFormat in [afDefined,afPremultiplied] then begin
        if vBmpRGBA[x].A <> 0 then begin
          vPngRGB^.b:= round(vBmpRGBA[x].b/vBmpRGBA[x].A*255);
          vPngRGB^.r:= round(vBmpRGBA[x].r/vBmpRGBA[x].A*255);
          vPngRGB^.g:= round(vBmpRGBA[x].g/vBmpRGBA[x].A*255);
        end else begin
          vPngRGB^.b:= round(vBmpRGBA[x].b*255);
          vPngRGB^.r:= round(vBmpRGBA[x].r*255);
          vPngRGB^.g:= round(vBmpRGBA[x].g*255);
        end;
      end;
      inc(vPngRGB);
    end;
  end;

Memnarch 15. Jan 2011 16:50

AW: PNG Semitransparenz aus Schwarz/Grau/weiß etc berechnen
 
Vielen dank, werde ich mir merken :)

Zwischenzeitlich bin ich auch auf den Trichter gekommen einfach alles in Vegas reinzuwerfen und da die Alpha Maske berechnen zu lassen :D.
Da bekomm ich dan auch klase semitransparenz^^"

Aber obiges beispiel kommt aufjedenfall in meine schnippselsammlung ;)

MFG
Memnarch

Namenloser 15. Jan 2011 17:23

AW: PNG Semitransparenz aus Schwarz/Grau/weiß etc berechnen
 
Liste der Anhänge anzeigen (Anzahl: 1)
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.


Alle Zeitangaben in WEZ +1. Es ist jetzt 05:46 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz