Bad functionality with 32 bits tbitmap (alpha channel) in linux.
lazarus / 39-Graphics

----------------------------------------------------------------------
dcelso · 2013-02-04 12:34

Hello to all,
I have problem porting a graphical aplication to linux lazarus.
I made an example to explain what happen to me.
It is a form with two timages and one button, the code is the next.
Code: [Select]unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
ExtCtrls,
  Buttons, GraphType, LCLType, LCLIntf, StdCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    Image1: TImage;
    Image2: TImage;
    procedure BitBtn1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }
function createMyBitmap1():TBitmap;
var
  RawImage: TRawImage;
  BitmapHandle, MaskHandle: HBitmap;
  Fdata : array [0..9999] of byte;
  i: integer;
begin
  RawImage.Init;
  RawImage.Description.Init_BPP32_B8G8R8A8_BIO_TTB(50, 50);
  RawImage.Description.LineOrder := riloTopToBottom;
  RawImage.Data:= PByte(FData);
  RawImage.DataSize:= 10000;
  // opaque pixels
  FillByte(fdata[0],10000,255);
  // transparent pixels
  for i:=1000 to 1999 do
    fdata[i*4+3]:=0;
  // semitransparent pixels
  for i:=0 to 999 do
    fdata[i*4+3]:=127;
  RawImage_CreateBitmaps(RawImage, BitmapHandle, MaskHandle, False);
  result := TBitmap.Create;
  result.Handle     := BitmapHandle;
  result.MaskHandle := MaskHandle;
  // ShowMessage(result.RawImage.Description.AsString);

end;

function createMyBitmap2():TBitmap;
var
  pData : PByte;
  i : Integer;
begin
  result := TBitmap.Create;
  result.PixelFormat:=pf32bit;
  result.RawImage.Description.MaskBitsPerPixel:=0;
  result.SetSize(50,50);
  result.BeginUpdate;
  result.RawImage.Description.AsString;

  pdata:=result.RawImage.data;
  // opaque pixels
  FillByte(pdata[0],10000,255);
  // transparent pixels
  for i:=1000 to 1999 do
    pdata[i*4+3]:=0;
  // semitransparent pixels
  for i:=0 to 999 do
    pdata[i*4+3]:=127;

  result.EndUpdate;
 // ShowMessage(result.RawImage.Description.AsString);


end;


procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  image1.Picture.Assign(createMyBitmap1());
  image2.Picture.Assign(createMyBitmap2());
end;

end.


This code works perfectly in windows. It show a box using, two
differents technicles, with 3 parts:
a white opaque part, a transparent part and a translucent (50%
transparent) part.
You can change the form1.color property to see the correct
funtionality of alpha channel.

In linux version have a collateral effect, don't show correctly the
translucid part, it only uses transparent or not transparent pixels,
skiiping translucent pixels.

Can Anyone with linux reproduce this effect?
anyone know the reason? can It  be solved?

----------------------------------------------------------------------
User137 · 2013-02-04 12:49

You had a memory leak at least, by never freeing the TBitmap. This
should correct it:
Code: [Select]procedure TForm1.BitBtn1Click(Sender: TObject);
var bmp1, bmp2: TBitmap;
begin
  bmp1:=createMyBitmap1();
  bmp2:=createMyBitmap2();
  image1.Picture.Assign(bmp1);
  image2.Picture.Assign(bmp2);
  bmp1.Free;
  bmp2.Free;
end;
Also, instead of Assign() command, have you tried the .Draw() ?

----------------------------------------------------------------------
dcelso · 2013-02-04 14:30

Same problem also skipping the use of timage to draw.
Code: [Select]unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
ExtCtrls,
  Buttons, GraphType, LCLType, LCLIntf, StdCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    Image1: TImage;
    Image2: TImage;
    procedure BitBtn1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }
function createMyBitmap1():TBitmap;
var
  RawImage: TRawImage;
  BitmapHandle, MaskHandle: HBitmap;
  Fdata : array [0..9999] of byte;
  i: integer;
begin
  RawImage.Init;
  RawImage.Description.Init_BPP32_B8G8R8A8_BIO_TTB(50, 50);
  RawImage.Description.LineOrder := riloTopToBottom;
  RawImage.Data:= PByte(FData);
  RawImage.DataSize:= 10000;
  // opaque pixels
  FillByte(fdata[0],10000,255);
  // transparent pixels
  for i:=1000 to 1999 do
    fdata[i*4+3]:=0;
  // semitransparent pixels
  for i:=0 to 999 do
    fdata[i*4+3]:=127;
  RawImage_CreateBitmaps(RawImage, BitmapHandle, MaskHandle, False);
  result := TBitmap.Create;
  result.Handle     := BitmapHandle;
  result.MaskHandle := MaskHandle;
//   ShowMessage(result.RawImage.Description.AsString);

end;

function createMyBitmap2():TBitmap;
var
  pData : PByte;
  i : Integer;
begin
  result := TBitmap.Create;
  result.PixelFormat:=pf32bit;
  result.RawImage.Description.MaskBitsPerPixel:=0;
  result.SetSize(50,50);
  result.BeginUpdate;
  result.RawImage.Description.AsString;

  pdata:=result.RawImage.data;
  // opaque pixels
  FillByte(pdata[0],10000,255);
  // transparent pixels
  for i:=1000 to 1999 do
    pdata[i*4+3]:=0;
  // semitransparent pixels
  for i:=0 to 999 do
    pdata[i*4+3]:=127;

  result.EndUpdate;
//  ShowMessage(result.RawImage.Description.AsString);


end;


procedure TForm1.BitBtn1Click(Sender: TObject);
var
  bmp: TBitmap;
begin
  bmp:=createMyBitmap1();
  image1.Picture.Assign(bmp);
  canvas.Draw(0,0,bmp);
  FreeAndNil(bmp);
  bmp:=createMyBitmap2();
  image2.Picture.Assign(bmp);
  canvas.Draw(100,0,bmp);
  FreeAndNil(bmp);
end;

end.