Überlagern zweier Bilder klappt nicht

Für Probleme bezüglich Grafik, Audio, GL, ACS, ...
Antworten
reneka
Beiträge: 7
Registriert: Do 3. Mär 2016, 09:25
OS, Lazarus, FPC: MAC OS 10.10.5 / Lazarus 1.4.4 / FPC 2.6.4
CPU-Target: 64Bit

Überlagern zweier Bilder klappt nicht

Beitrag von reneka »

Seit Tagen versuche ich, zwei Bilder zu überlagern. Was unter Delphi mit BitBlt klapp, funktioniert mit Lazarus (MAC OS) leider nicht. BitBlt gibt es zwar, aber die Option SRCAND ist ohne Effekt. Nach längerem Suchen und probieren bin ich auf diesen Link für ein fading Beispiel gestoßen: http://wiki.freepascal.org/Developing_with_Graphics/de#Zeichnen_auf_eine_Bitmap_in_TImage. Das sieht schon mal sehr viel versprechend aus, funktioniert unter Windows mit Delphi auch hervorragend: http://www.delphipraxis.net/32613-2-bitmaps-miteinander-verschmelzen-ueberlagern.html. Da beide Bilder nur zu 50% eingefügt werden sehen sie etwas blass aus, das stört aber erst einmal nicht. Viel dramatischer ist, dass dieses Blending unter Lazarus bei 80% aufhört: https://picasaweb.google.com/113319258114718881933/Lazarusproblem#6257710105623336210. Die Bilder 1 und 2 zeigen, dass die Kurven bis zum rechten Rand reichen. Ich kann es auch "umdrehen". Dann wird die untere Linie durchgängig dargestellt und die obere hört an genau der gleichen Stelle auf. An der Abbruchstelle sieht man auch, dass die eine Bildhälfte zu 100% weitergezeichnet wird (kräftigere Farbe) - als ob das fading plötzlich aufhört.

Warum? Was passiert hier?

Hier noch etwas Code:

Code: Alles auswählen

 
  TRGBTripleArray = array[0.. 32767] of TRGBTriple; // sollte für eine Zeile reichen
  PRGBTripleArray = ^TRGBTripleArray;
  ...
  var Row1, Row2, RowD: PRGBTripleArray;
  ...  // Src1 ist die obere Linie, Src2 die untere.
  IntfImg1 := TLazIntfImage.Create(0, 0);
  IntfImg1.LoadFromBitmap(Src1.Handle, Src1.MaskHandle);
 
  IntfImg2 := TLazIntfImage.Create(0, 0);
  IntfImg2.LoadFromBitmap(Src2.Handle, Src2.MaskHandle);
 
  IntfImgD := TLazIntfImage.Create(0, 0);
  IntfImgD.LoadFromBitmap(Src1.Handle, Src1.MaskHandle);
 
  Alpha := 127;
  nAlpha := not Alpha;
 
  for py := 0 to IntfImg1.Height-1 do
  begin
    Row1 := IntfImg1.GetDataLineStart(py);
    Row2 := IntfImg2.GetDataLineStart(py);
    RowD := IntfImgD.GetDataLineStart(py); // nur zum Test, es geht auch ohne - dann in Schleife gleich in Row1 oder Row2
    for px := 0 to IntfImg1.Width-1 do
    begin
      RowD^[px].rgbtRed := (Row1^[px].rgbtRed * nAlpha + Row2^[px].rgbtRed * Alpha) shr 8;
      RowD^[px].rgbtGreen := (Row1^[px].rgbtGreen * nAlpha + Row2^[px].rgbtGreen * Alpha) shr 8;
      RowD^[px].rgbtBlue := (Row1^[px].rgbtBlue * nAlpha + Row2^[px].rgbtBlue * Alpha) shr 8;
    end;
  end;
 
  IntfImgD.CreateBitmaps(ImgHandle, ImgMaskHandle, false);
  TempBitmap := TBitmap.Create;
  TempBitmap.Handle := ImgHandle;
  TempBitmap.MaskHandle := ImgMaskHandle;
 
  PaintBox.Canvas.Draw(0, 0, TempBitmap);
  ...
 


Leider habe ich den Debugger unter MAC-OS nicht zum laufen bekommen. Somit ist es schwer, zur Laufzeit Untersuchungen durchführen zu können.

Viele Grüße
René
MAC OS 10.10.5 / Lazarus 1.4.4 / FPC 2.6.4

Michl
Beiträge: 2505
Registriert: Di 19. Jun 2012, 12:54

Re: Überlagern zweier Bilder klappt nicht

Beitrag von Michl »

Wenn ich mir das Bild so anschaue, denke ich, dass das Offset nicht richtig berechnet wird. Vermutlich hast du ein Bild mit vier Farbkanälen geladen, du berechnest das Offset aber nur für drei Farben. Versuche mal statt TRGBTriple, TRGBQuad zu nehmen.

Code: Alles auswählen

type
  TLiveSelection = (lsMoney, lsChilds, lsTime);
  TLive = Array[0..1] of TLiveSelection; 

reneka
Beiträge: 7
Registriert: Do 3. Mär 2016, 09:25
OS, Lazarus, FPC: MAC OS 10.10.5 / Lazarus 1.4.4 / FPC 2.6.4
CPU-Target: 64Bit

Re: Überlagern zweier Bilder klappt nicht

Beitrag von reneka »

Ich "male" die Bilder vorher direkt auf den Canvas mit MoveTo/ LineTo.
Und ja, das könnte Sinn machen, andere Implementierungen gehen auch von 4 Kanälen aus:

Code: Alles auswählen

 
TARGB = packed record
    case Byte of
      1: (B, G, R, A: Byte);
      2: (Color: LongWord);
    end;
 


Ich werde das bei Gelegenheit mal probieren.
MAC OS 10.10.5 / Lazarus 1.4.4 / FPC 2.6.4

reneka
Beiträge: 7
Registriert: Do 3. Mär 2016, 09:25
OS, Lazarus, FPC: MAC OS 10.10.5 / Lazarus 1.4.4 / FPC 2.6.4
CPU-Target: 64Bit

Re: Überlagern zweier Bilder klappt nicht

Beitrag von reneka »

Michl hat geschrieben:Versuche mal statt TRGBTriple, TRGBQuad zu nehmen.

Ja, das war's. Vielen Dank.
MAC OS 10.10.5 / Lazarus 1.4.4 / FPC 2.6.4

Antworten