PNG mit Alpha Kanal erstellen [Gelöst]

Für Probleme bezüglich Grafik, Audio, GL, ACS, ...
Antworten
corpsman
Beiträge: 1122
Registriert: Sa 28. Feb 2009, 08:54
OS, Lazarus, FPC: Linux Mint Mate, Lazarus SVN Trunk, FPC 3.0
CPU-Target: 64Bit
Wohnort: Stuttgart
Kontaktdaten:

PNG mit Alpha Kanal erstellen [Gelöst]

Beitrag von corpsman »

Servus miteinander,

gemäß diesem Beitrag: https://forum.lazarus.freepascal.org/in ... ic=35424.0

kann man wie folgt ein png mit Alpha Kanal erstelllen:

Code: Alles auswählen

 
Procedure TForm1.Button6Click(Sender: TObject);
Var
  b, a, d: TBitmap;
  Source, Alpha, Dest: TLazIntfImage;
  SColor, AColor: TFPColor;
  ImgHandle, ImgMaskHandle: HBitmap;
  p: TPortableNetworkGraphic;
  i, j: Integer;
Begin
  If SaveDialog2.Execute Then Begin
    b := TBitmap.Create;
    b.Assign(Image1.Picture.Bitmap); // Das Quellbild ohne Alpha
    a := TBitmap.Create;
    // Das war Falsch -- a.Assign(Image1.Picture.Bitmap); // Der Alphakanal des Quellbildes
    a.Assign(Image2.Picture.Bitmap); // Der Alphakanal des Quellbildes
    If (a.Width <> b.Width) Or (a.Height <> b.Height) Then Begin
      ShowMessage('Error alphamask and normal image differ in size.');
      a.free;
      b.Free;
      exit;
    End;
    d := TBitmap.Create;
    d.Width := a.Width;
    d.Height := a.Height;
 
    source := TLazIntfImage.Create(0, 0);
    Source.LoadFromBitmap(b.Handle, b.MaskHandle);
 
    Alpha := TLazIntfImage.Create(0, 0);
    Alpha.LoadFromBitmap(a.Handle, a.MaskHandle);
 
    Dest := TLazIntfImage.Create(0, 0, [riqfRGB, riqfAlpha]);
    Dest.SetSize(a.Width, a.Height);
 
    For i := 0 To a.Width - 1 Do Begin
      For j := 0 To a.Height - 1 Do Begin
        SColor := Source.Colors[i, j];
        AColor := Alpha.Colors[i, j];
        SColor.alpha := AColor.red; // Egal ist ja eh Graustufen
        Dest.Colors[i, j] := SColor;
      End;
    End;
 
    Dest.CreateBitmaps(ImgHandle, ImgMaskHandle, false);
 
    d.Handle := ImgHandle;
    d.MaskHandle := ImgMaskHandle;
 
    p := TPortableNetworkGraphic.Create;
    p.Assign(d);
    p.SaveToFile(SaveDialog2.FileName);
    p.free;
    d.free;
    a.Free;
    b.Free;
    source.free;
    Alpha.free;
    Dest.free;
  End;
End;     
 


Bei mir ist das Zielbild aber einfach nur Weiß, was habe ich falsch gemacht ?

[Edit]
Copy Paste Fehler 2 mal Image1
--
Just try it

Antworten