FCL-Image and Alpha [resolved]

[theo]

So I guess I expected overlaying instead of actual blending.

I don't know exactly how that should work.
Please have a look at unit opbitmap.pas.
The blending procedure is "BlendColors".
The code should be easy to understand.
Try to change the code to suit your needs and show me the result please ;-)

 

[daz]

Well, on this wikipedia page: http://en.wikipedia.org/wiki/Alpha_compositing scroll down to where it says "The over operator is, in effect, the normal painting operation (see Painter's algorithm). The in operator is the alpha compositing equivalent of clipping."

I tried to implement that formula as

Code: [Select]

procedure BlendColors(SPix, DPix: PPixel32);
var alp1, alp2: integer;
begin
  if SPix^.Alpha = AlphaTransparent then exit else
    if SPix^.Alpha = AlphaOpaque then
      DPix^ := SPix^ else
    begin
      alp1 := SPix^.Alpha;
      alp2 := $FF-alp1;
      DPix^.Red := ((DPix^.Red * alp2)*($FF-alp1) + (SPix^.Red * alp1));
      DPix^.Green := ((DPix^.Green * alp2)*($FF-alp1) + (SPix^.Green * alp1));
      DPix^.Blue := ((DPix^.Blue * alp2)*($FF-alp1) + (SPix^.Blue * alp1)); 
    end;
end;
But that didn't work as expected. I'm still confused as to your method of determining what the second alpha should be -- why should it be the difference of the max alpha and the first layers alpha? I thought it would make sense for it to be the sum of the 2 alpha layers (SPix^.alpha+DPix^.alpha) but that yielded the same results.

I suppose I'm happy enough to found a reference to this "over" method and formula, even though the actual proper implementation of it in this case eludes me.

[theo]

Does this suit your taste?

Code: [Select]

procedure BlendColors(SPix, DPix: PPixel32);
var FA,SA,DA: byte;
begin
  if SPix^.Alpha = AlphaTransparent then exit else
    if SPix^.Alpha = AlphaOpaque then
      DPix^ := SPix^ else
    begin
      FA := SPix^.Alpha + (($FF-SPix^.Alpha)*DPix^.Alpha) div $FF;
      if (FA=0) then SA:=0 else SA:=(SPix^.Alpha*$FF) div FA;
      DA := $FF-SA;
      DPix^.Red := (DPix^.Red * DA + SPix^.Red * SA) div $FF;
      DPix^.Green := (DPix^.Green * DA + SPix^.Green * SA) div $FF;
      DPix^.Blue := (DPix^.Blue * DA + SPix^.Blue * SA) div $FF;
      DPix^.Alpha:=(FA);
  end;
end;


[daz]

Does this suit your taste?

Code: [Select]

procedure BlendColors(SPix, DPix: PPixel32);
var FA,SA,DA: byte;
begin
  if SPix^.Alpha = AlphaTransparent then exit else
    if SPix^.Alpha = AlphaOpaque then
      DPix^ := SPix^ else
    begin
      FA := SPix^.Alpha + (($FF-SPix^.Alpha)*DPix^.Alpha) div $FF;
      if (FA=0) then SA:=0 else SA:=(SPix^.Alpha*$FF) div FA;
      DA := $FF-SA;
      DPix^.Red := (DPix^.Red * DA + SPix^.Red * SA) div $FF;
      DPix^.Green := (DPix^.Green * DA + SPix^.Green * SA) div $FF;
      DPix^.Blue := (DPix^.Blue * DA + SPix^.Blue * SA) div $FF;
      DPix^.Alpha:=(FA);
  end;
end;


That works marvelously I think this should be the default blend mode, as it's a simple overlay and is what most graphics applications use when you have 2 partially transparent layers.

[theo]

I think this should be the default blend mode

OK. have fun.

[circular]

TBGRABitmap doesn't work for me on Ubuntu 10.04 with FPC 2.5.1 :

bgragtkbitmap.pas(41,17) Error: There is no method in an ancestor class to be overridden: "TBGRAGtkBitmap.Draw(TCanvas,LongInt,LongInt,Boolean="TRUE");"
bgragtkbitmap.pas(42,17) Error: There is no method in an ancestor class to be overridden: "TBGRAGtkBitmap.Draw(TCanvas,TRect,Boolean="TRUE");"
bgragtkbitmap.pas(48,1) Fatal: There were 2 errors compiling module, stopping

Hello, I wrote BGRABitmap. What is happening here is strange. I have tried it on both Linux and Windows.

Maybe you are using directly BGRAGtkBitmap instead of BGRABitmap. In the uses clause, you should put "bgrabitmap" and "bgrabitmaptypes", and then use the TBGRABitmap class.

Both procedures in th error messages seem well defined. In bgragktbitmap :

procedure Draw(ACanvas: TCanvas; x,y: integer; Opaque: boolean= True); override;
procedure Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean= True); override;

And in bgradefaultbitmap :

procedure Draw(ACanvas: TCanvas; x,y: integer; Opaque: boolean= True); virtual;
procedure Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean= True); virtual;

Does someone else have this problem on Linux ?

Code: [Select]

uses ..., Graphics, BGRABitmapTypes, BGRABitmap;

procedure MergeImages(FirstFileName, SecondFileName, CombinedFileName: string);
var
  First: TBGRABitmap;
  Second: TBGRABitmap;
begin
  Second := TBGRABitmap.Create(SecondFileName);
  First := TBGRABitmap.Create(FirstFileName);
  First.Bitmap.Canvas.CopyRect(
    Rect(0, 0, First.Width, First.Height),
    Second.Bitmap.Canvas,
    Rect(0, 0, Second.Width, Second.Height)
  );
  First.SaveToFile(CombinedFileName);
  First.Destroy;
  Second.Destroy;
end;

MergeImages('First.png', 'Second.png', 'Combined.png');


This is not the best way. You should write instead :

Code: [Select]

uses ..., Graphics, bgrabitmaptypes, bgrabitmap;

procedure MergeImages(FirstFileName, SecondFileName, CombinedFileName: string);
var
  First: TBGRABitmap;
  Second, SecondResample: TBGRABitmap;
begin
  First := TBGRABitmap.Create(FirstFileName);

  Second := TBGRABitmap.Create(SecondFileName);
  SecondResample := Second.Resample(First.Width,First.Height) as TBGRABitmap; //fine resample
  Second.Free;

  First.PutImage(0,0, SecondResample, dmDrawWithTransparency); //fast putimage
  SecondResample.Free;

  First.SaveToFile(CombinedFileName);
  First.Free;
end;

MergeImages('First.png', 'Second.png', 'Combined.png');