Lazarus

Programming => Graphics => Graphics and Multimedia => BGRABitmap and LazPaint => Topic started by: dcelso on February 01, 2013, 02:36:34 pm

Title: Error opening 32bits .bmp in TBGRABitmap.
Post by: dcelso on February 01, 2013, 02:36:34 pm
Hello, I generated a 32 bits .bmp using The GIMP, to do it I pain something lines, I add somethin parts to  transparent channel in layer menu. And save it as .bmp.

The result is an image 32 bit RGBA (8 for each channel) .bmp. If I open it with paint, xvnview and others image viewers or image editor the reprentation is the same of GIMP. But if I open it In a TBGRABitmap I optain a grayscale image instead of the correct image.
I tryed to open it with a normal TBitmap optaining same results.
If I open it with gimp an save it as .png then TBitmap an TBGRABitmap open it correctly. It seams a bug of the reader of a .bmp.
I attach a 32bit .bmp with this problem

Im using BGRABitmap v6.4
Title: Re: Error opening 32bits .bmp in TBGRABitmap.
Post by: circular on February 01, 2013, 02:39:49 pm
BGRABitmap has its own 32-bit bmp reader. Apparently, it may not be used in this case.

Can you debug step by step what happens when you load the bitmap, to know which methods are used ?

At some point, it should go through LoadAsBmp32 function.
Title: Re: Error opening 32bits .bmp in TBGRABitmap.
Post by: dcelso on February 01, 2013, 02:44:56 pm
 :o, then can be the conversion to TBitmap.
My example is very simple, a TImage that using a Shelllistview and a TBGRABitmap, can do a preview of the selected image.
Is the next.
Form:
Code: [Select]
object Form1: TForm1
  Left = 215
  Height = 444
  Top = 126
  Width = 621
  Caption = 'Form1'
  ClientHeight = 444
  ClientWidth = 621
  LCLVersion = '1.1'
  object Image1: TImage
    Left = 8
    Height = 202
    Top = 192
    Width = 258
  end
  object BitBtn1: TBitBtn
    Left = 288
    Height = 30
    Top = 192
    Width = 75
    Caption = 'BitBtn1'
    TabOrder = 0
  end
  object Label1: TLabel
    Left = 299
    Height = 15
    Top = 258
    Width = 34
    Caption = 'Label1'
    ParentColor = False
  end
  object ShellListView1: TShellListView
    Left = 16
    Height = 150
    Top = 8
    Width = 560
    Color = clDefault
    TabOrder = 1
    ViewStyle = vsReport
    OnChange = ShellListView1Change
    OnSelectItem = ShellListView1SelectItem
    ObjectTypes = [otNonFolders]
    Root = 'Z:\imagenes'
  end
end
code
Code: [Select]
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  Buttons, StdCtrls, ShellCtrls, ComCtrls,
  BGRABitmap, BGRABitmapTypes ;

type

  { TForm1 }

  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    Image1: TImage;
    Label1: TLabel;
    ShellListView1: TShellListView;
    procedure ShellListView1Change(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure ShellListView1SelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.ShellListView1Change(Sender: TObject; Item: TListItem;
  Change: TItemChange);
begin

end;

procedure TForm1.ShellListView1SelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
var
  bmp: TBGRABitmap;
begin
     bmp:= TBGRABitmap.Create;
     bmp.LoadFromFile(ShellListView1.Root+DirectorySeparator+item.Caption);
     image1.Picture.Assign(bmp);
     FreeAndNil(bmp);
end;

end.

Title: Re: Error opening 32bits .bmp in TBGRABitmap.
Post by: circular on February 01, 2013, 02:54:38 pm
Oh there is misunderstanding. By debug step by step, I mean that you put a breakpoint on the line that loads the file by clicking on the gutter on the left of the line, to make it appear red, which means the breakpoint is set. Then run the program, try to load the file, and when it stops on that breakpoint, use F7 and F8 to explore what is going on.
Title: Re: Error opening 32bits .bmp in TBGRABitmap.
Post by: dcelso on February 01, 2013, 03:03:32 pm
 :o, I understand to you, but I have installe the package instead of the code so I cannot enter in the code of bgrabitmap,but it doesnt crash in any line. I only have four lines in my code.

     bmp:= TBGRABitmap.Create;
     bmp.LoadFromFile(ShellListView1.Root+DirectorySeparator+item.Caption);
     image1.Picture.Assign(bmp);
     FreeAndNil(bmp);

Title: Re: Error opening 32bits .bmp in TBGRABitmap.
Post by: circular on February 01, 2013, 03:08:02 pm
Ok, so go Package > Open loaded package, and choose BGRABitmapPack.
The package window should pop up. Go to Options.
In Code Generation, deactivate compiler optimizations. Level 1 is ok, make sure to uncheck "store variable in registers".
Then go in Linking options, and check "generate debug information" or something like that.
Finally click Ok, save and close the package.
Title: Re: Error opening 32bits .bmp in TBGRABitmap.
Post by: dcelso on February 01, 2013, 05:26:09 pm
the same happens with your example, ported to open this image.
Code: [Select]
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, BGRABitmap, BGRABitmapTypes;

type

  {  TForm1 }

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { private declarations }
  public
    img :TBGRABitmap;
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
   img := TBGRABitmap.Create('32bits (2).bmp');
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
   img.Draw(canvas,0,0,false);
end;

end.

Show a blacked image.
Title: Re: Error opening 32bits .bmp in TBGRABitmap.
Post by: dcelso on February 02, 2013, 06:36:53 pm
Hi, circular.
I'm testing your new version of BGRABitmap 6.5 with this image 32bits.bmp, create with gimp.
Open it in bgrabitmap and printing using his method draw. Paint the pixels of the centered box when the have his alpha channel equal to 0, so must be not painted.
Code: [Select]
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, BGRABitmap, BGRABitmapTypes;

type

  {  TForm1 }

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { private declarations }
  public
    img :TBGRABitmap;
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
   img := TBGRABitmap.Create('32bits.bmp');
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  bmp: tbitmap;
begin
   img.Draw(canvas,0,0,false);

end;

end.

Only happens with .bmps images, if I open it with gimp and save it in .png format. Bgrabitmap pain it correctly using this same image.
Title: Re: Error opening 32bits .bmp in TBGRABitmap.
Post by: circular on February 02, 2013, 07:04:52 pm
Ok it's fixed on subversion (changes applied to bgrabitmaptypes.pas)
Title: Re: Error opening 32bits .bmp in TBGRABitmap.
Post by: dcelso on February 02, 2013, 07:22:54 pm
 :o, very fast.
I will test now.
Thanks.
Title: Re: Error opening 32bits .bmp in TBGRABitmap.
Post by: dcelso on February 02, 2013, 07:38:43 pm
It's perfect, Solved. You are the best. ;)
But, still continues the problem to convert it to a bitmap, misteriously the alpha channel is converted to 1bit (ie, pixel visible or not visible). In this case is indifferent of the type image loaded, ie, it happens in .bmps and .pngs.
Code: [Select]
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, BGRABitmap, BGRABitmapTypes;

type

  {  TForm1 }

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { private declarations }
  public
    img :TBGRABitmap;
    img2 :TBGRABitmap;
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
   img := TBGRABitmap.Create('32bits4.bmp');
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  bmp: tbitmap;
begin
   img.Draw(canvas,0,0,false);

   bmp:= TBitmap.create;

   bmp.Assign(img.Bitmap);

   canvas.Draw(0,100,bmp);

   FreeAndNil(bmp);

end;

end.

Title: Re: Error opening 32bits .bmp in TBGRABitmap.
Post by: dcelso on February 02, 2013, 07:48:25 pm
going steb by step i have come to
Code: [Select]
procedure TBGRADefaultBitmap.RebuildBitmap;
var
  RawImage: TRawImage;
  BitmapHandle, MaskHandle: HBitmap;
begin
  if FBitmap <> nil then
    FBitmap.Free;

  FBitmap := TBitmapTracker.Create(self);

  if (FWidth > 0) and (FHeight > 0) then
  begin
    RawImage.Init;
    RawImage.Description.Init_BPP32_B8G8R8A8_BIO_TTB(FWidth, FHeight);
    RawImage.Description.LineOrder := FLineOrder;
    RawImage.Data     := PByte(FData);
    RawImage.DataSize := FWidth * FHeight * sizeof(TBGRAPixel);
    if not RawImage_CreateBitmaps(RawImage, BitmapHandle, MaskHandle, False) then
      raise FPImageException.Create('Failed to create bitmap handle');
    FBitmap.Handle     := BitmapHandle;
    FBitmap.MaskHandle := MaskHandle;
  end;

  FBitmap.Canvas.AntialiasingMode := amOff;
  FBitmapModified := False;
end;
I thing that the problem may be any method or property involved in this function.
for example, antialiasingmode, or maskhandle, or lineorder.
although, can be a problem of RawImage_CreateBitmaps from lazarus. :'(.
Title: Re: Error opening 32bits .bmp in TBGRABitmap.
Post by: circular on February 02, 2013, 07:49:08 pm
Well, I suppose there's nothing I can do about this. I suppose that when the bitmap is assigned, the RGB values are duplicated, and the alpha value is duplicated as a mask (1-bit). I don't know.

The code you found is ok. It gives the Bitmap property, which you can use to draw it with alpha on Windows.

Anyway, in general the LCL does not handle 8-bit alpha channels. So you should not even write something like :
Code: [Select]
procedure TForm1.FormPaint(Sender: TObject);
begin
   canvas.Draw(0,0,img.Bitmap);  // <- this does not work on Linux
end;

But instead :
Code: [Select]
procedure TForm1.FormPaint(Sender: TObject);
begin
   img.Draw(canvas,0,0,false);
end;

If you want a Bitmap for the LCL, you should use
Code: [Select]
var
  bmp: TBitmap;
begin
  bmp := img.MakeBitmapCopy(clBtnFace);
  ...
  bmp.Free;
end;
Title: Re: Error opening 32bits .bmp in TBGRABitmap.
Post by: dcelso on February 02, 2013, 09:28:36 pm
LCL works well with alphas in windows.
Your solution is not good for me, I need copy alpha channel to tbitmap,too. Your solution does not do it. only is good to show a preview.
 :'(
The same example in windows works perfectly.
TinyPortal © 2005-2018