TBitmap mit Maske aber ohne Transparent Color .. [Gelöst]

[corpsman]

Hallo Zusammen,

ich möchte hier eine Graphik in eine TPaintBox malen, das macht man Bekanntlich so:

Code: Alles auswählen

var Bmp:TBitmap;
Procedure TForm1.PaintBox1Paint(Sender: TObject);
Begin
  PaintBox1.Canvas.Draw(0, 0, Bmp);
End;

Meine Graphik soll aber "Maskiert" sein, sprich nicht jeder Pixel soll sichtbar sein, sondern nur bestimmte. Die Maske kann man z.B. so erstellen:

Code: Alles auswählen

  // Eine Kreismaske erzeugen, durch indem alle Pixel = clfuchsia zur Maske werden
  bmp.canvas.brush.color := clfuchsia;
  bmp.canvas.rectangle(-1,-1, bmp.width+1, bmp.height+1);
  bmp.canvas.pen.color := clwhite;
  bmp.canvas.brush.color := clwhite;
  bmp.canvas.Ellipse(0,0, bmp.width, bmp.height);
  Bmp.Mask(clfuchsia);

  // Die Maske ist erstellt, ein erneutes Rectangle beschreibt nur die nicht Maskierten Pixel, man sieht also einen Roten Kreis und kein Rotes Rechteck  
  bmp.canvas.pen.color := clred;
  bmp.canvas.brush.color := clred;
  bmp.canvas.rectangle(0,0, bmp.width, bmp.height);  

Das alles Funktioniert wunderbar, nun will ich aber meine Graphik Pixelweise "anpassen" also mache ich folgendes:

Code: Alles auswählen

Var
  intf: TLazIntfImage;
  x, y: Integer;
Begin
  intf := Bmp.CreateIntfImage;
  For x := 0 To Bmp.Width - 1 Do Begin
    For y := 0 To Bmp.Height - 1 Do Begin
        intf.Colors[x, y] := TColorToFPColor(clLime);
    End;
  End;
  Bmp.LoadFromIntfImage(intf); // -- Das Zerstört die vorher erstellte Maske und wir sehen ein Grünes Rechteck und keinen Kreis, wie er in der Maske stand.
  intf.free;
End;                    

Wie im Kommentar schon geschrieben, macht das Bmp.LoadFromIntfImage meine Maske kaputt, die ich vorher gemacht habe.

Mittels bmp.TransparentColor := clfuchsia; und bmp.Transparent := true; kann ich nicht arbeiten, da mein User beliebige Farben eingeben darf und clFuchsia gehört da dazu

Was ich auch schon ausprobiert habe, ist mir zu merken wo die maske markiert hat und da dann clDefault hin zu schreiben, aber das wird immer zu schwarz aufgelöst..

Hat einer von Euch eine Idee, wie man das richtig realisieren kann ?

[theo]

Vielleicht mit Alpha Blending?
BGRABitmap soll das gut unterstützen.
Es gibt aber auch: https://lazarus-ccr.sourceforge.io/docs ... blend.html
Im Prinzip ist das vierte Byte jedes Pixels hier einfach die "Maske", bzw. der Alphawert.
https://en.wikipedia.org/wiki/RGBA_color_model

[wp_xyz]

Die Maske ist weiterhin vorhanden, die Information darüber scheint aber in bmp.LoadFromIntfImage nicht anzukommen:

Code: Alles auswählen

procedure TRasterImage.LoadFromIntfImage(IntfImage: TLazIntfImage);
var
  ImgHandle, ImgMaskHandle: HBitmap;
begin
  IntfImage.CreateBitmaps(ImgHandle, ImgMaskHandle, not IntfImage.HasMask);
  SetHandles(ImgHandle, ImgMaskHandle);
end; 

Wenn ich CreateBitmaps (ohne den optionalen dritten Parameter) und SetHandles direkt in dein Programm einsetze, erhalte ich einen grünen Kreis, statt ein grünes Rechteck, also: die Maske ist weiterhin aktiv:

Code: Alles auswählen

procedure TForm1.Button1Click(Sender: TObject);
Var
  intf: TLazIntfImage;
  x, y: Integer;
  bmpHandle, maskHandle: THandle;
Begin
  intf := Bmp.CreateIntfImage;
  For x := 0 To Bmp.Width - 1 Do Begin
    For y := 0 To Bmp.Height - 1 Do Begin
        intf.Colors[x, y] := TColorToFPColor(clLime);
    End;
  End;
  
  // DAS FUNKTIONIERT: 
  intf.CreateBitmaps(bmpHandle, maskHandle);
  bmp.SetHandles(bmpHandle, maskHandle);
  
//  Bmp.LoadFromIntfImage(intf); // -- Das Zerstört die vorher erstellte Maske und wir sehen ein Grünes Rechteck und keinen Kreis, wie er in der Maske stand.
  intf.free;

  Paintbox1.Invalidate;
end; 

In Bmp.LoadfromIntfImage gibt IntfImage.HasMask den Wert false zurück, was wiederum daran liegt, dass die interne Variable FMaskSet nicht auf true gesetzt worden ist. Sucht man im Code, wo FMaskSet gesetzt wird, so erfolgt dies nur in CopyPixels, in IntfImage.LoadFromBitmap (und dem von dort aufgerufenen SetRawImage) fehlt das. Wenn ich das explizit in TLazIntfImage.setRawImage einbaue, funktioniert auch dein Original-Code:

Code: Alles auswählen

procedure TLazIntfImage.SetRawImage(const ARawImage: TRawImage; ADataOwner: Boolean);
var
  Desc: TRawImageDescription absolute ARawImage.Description;
begin
  if FRawImage.IsEqual(ARawImage) then Exit;

  BeginUpdate;
  try
    FreeData;
    FRawImage := ARawImage;
    FDataOwner := ADataOwner;
    SetSize(Desc.Width, Desc.Height);
    FCreateAllDataNeeded := False;
    New(FLineStarts);
    FLineStarts^.Init(Width, Height, Desc.BitsPerPixel, Desc.LineEnd, Desc.LineOrder);
    New(FMaskLineStarts);
    FMaskLineStarts^.Init(Width, Height, Desc.MaskBitsPerPixel, Desc.MaskLineEnd, Desc.LineOrder);
    FMaskSet := ARawImage.IsMasked(true);   // <---- NEU 
    ChooseGetSetColorFunctions;
  finally
    EndUpdate;
  end;
end;

Bin nur nicht sicher, ob man ARawImage.IsMasked unbedingt mit Argument true (ATestPixels) aufrufen muss, was sicher ein bisschen Zeit kostet.

[corpsman]

@wp_xyz
Danke, deine vorgeschlagene Lösung funktioniert in meiner "echten" Anwendung nun auch und kann hier bestaunt werden (der Slider des Gradienten hat Links und Rechts Abrundungen die nun mittels der Maske realisiert sind, was man aber nur sieht, wenn man die Ringe zur seite schiebt ).

[wp_xyz]

Habe nun den Fix auf Laz/main committet (allerdings mit ARawImage.IsMasked(false)), Backport zu Fixes erfolgt in ein paar Tagen - vielleicht gibt es ja doch Nebeneffekte.

Zur Dokumentation über das "warum & wieso" habe ich einen Bug-Report geschrieben: https://gitlab.com/freepascal.org/lazar ... sues/42010