Lazarus
Programming => Graphics => Graphics and Multimedia => BGRABitmap and LazPaint => Topic started 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
-
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.
-
: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:
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
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.
-
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.
-
: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);
-
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.
-
the same happens with your example, ported to open this image.
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.
-
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.
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.
-
Ok it's fixed on subversion (changes applied to bgrabitmaptypes.pas)
-
:o, very fast.
I will test now.
Thanks.
-
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.
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.
-
going steb by step i have come to
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. :'(.
-
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 :
procedure TForm1.FormPaint(Sender: TObject);
begin
canvas.Draw(0,0,img.Bitmap); // <- this does not work on Linux
end;
But instead :
procedure TForm1.FormPaint(Sender: TObject);
begin
img.Draw(canvas,0,0,false);
end;
If you want a Bitmap for the LCL, you should use
var
bmp: TBitmap;
begin
bmp := img.MakeBitmapCopy(clBtnFace);
...
bmp.Free;
end;
-
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.