Lazarus
Programming => Graphics => Graphics and Multimedia => BGRABitmap and LazPaint => Topic started by: Dibo on November 26, 2011, 07:25:39 pm
-
Hi,
Have TBGRABitmap some kind of layers functionality? For example: I am adding new image by BGRA.PutImage(). Can I somehow change order or visibility of "layers" added by this method?
Regards.
-
I think that it doesn't have. But you can add Layers with using multiple bgrabitmap in memory.
One for the background, the biggest bitmap where to put all the layers, the others for each visual object you have. For example:
bgra1_ transparent background 640x480 << this is the final bitmap
bgra2_ a picture with an sky and a floor << resample to 640x480 to fit
bgra3_ a drawing of a tree 300x400 at pos 170,40 << put in the position you want
manage with something like:
TBGRALayerPosition = record
x, y: integer;
Source: TBGRACustomBitmap;
mode: TDrawMode;
AOpacity: byte;
end;
TBGRALayerPositions = array of TBGRALayerPosition;
this is an example with a bgravirtualscreen and two rectangles. Every time you update the virtualscreen the order of the layers will switch (is a public boolean variable in the form), the black square in bottom and the red in top, the black in top and the red in bottom.
procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
var
layers: TBGRALayerPositions;
bgra_2, bgra_3: TBGRABitmap;
o,p,i: integer;
begin
SetLength(layers,2);
bgra_2 := TBGRABitmap.Create(100,100, BGRABlack);
bgra_3 := TBGRABitmap.Create(100,100, BGRA(255,0,0,255));
if switch then
begin
o := 1;
p := 0;
switch := not switch;
end
else
begin
o := 0;
p := 1;
switch := not switch;
end;
with layers[o]do
begin
x := 10;
y := 10;
mode := dmSet;
AOpacity := 255;
Source := bgra_2;
end;
with layers[p]do
begin
x := 50;
y := 50;
mode := dmSet;
AOpacity := 255;
Source := bgra_3;
end;
for i:=0 to High(layers) do
Bitmap.PutImage(layers[i].x, layers[i].y, layers[i].Source, layers[i].mode, layers[i].AOpacity);
bgra_2.Free;
bgra_3.Free;
end;
you only need to change the order of the addition in the array and that's all.
Of course it needs to be well coded with usefull procedures, object oriented...
-
It is also possible to use BlendImage to use special blending operations. I'm working on a class according to the proposition you've made Lainz.
-
Here is a new version (5.3) of BGRABitmap with layer support (in BGRALayers) :
http://sourceforge.net/projects/lazpaint/files/src/
How to use :
layers := TBGRALayeredBitmap.Create(640,480);
layers.AddLayer(someBmp,128);
layers.AddLayerFromFile('filename1');
layers.LayerOpacity[layers.AddLayerFromFile('filename1')] := 128;
...
layers.Draw(bmp,0,0);
...
layers.free;
-
Amazing you're really fast.
-
Well, sometimes, i've got the inspiration and support, then I can go pretty fast, and I just write programs like I am talking. Sometimes my fingers struggle to follow. :D
-
i hope this layer functionality will be added to LazPaint too so that i can forget about Paint .NET already :)
-
I have written a short program to test the concept of having a drawing cursor rubber banding a drawing element (simple lines in this test case) on one layer while the drawn elements are on another. It seems to work fine. It is much faster than storing the lines' coordinates in an array and redrawing everything each time the mouse moves a pixel.
I fill the cursor layer with white to erase the old line each time the mouse is moved because I couldn't find a simple way to just clear the layer. Perhaps I am missing something? Yes, probably so! ::)
I have minimal experience with graphics, and OOP for that matter, and this is my first attempt at using layers.
Please tell me what you think.
Thanks.
unit uMain;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
BGRABitMap, BGRABitMapTypes;
type
{ TForm1 }
TForm1 = class(TForm)
StatusBar1: TStatusBar;
procedure FormCreate(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormPaint(Sender: TObject);
private
image, mainLayer, cursorLayer: TBGRABitmap;
procedure PaintImage;
{ private declarations }
public
{ public declarations }
end;
var
Form1 : TForm1;
x1, y1, x2, y2, count : Integer;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.Width := 800;
Form1.Height := 600;
image := TBGRABitmap.Create(800,600,BGRAWhite); //create a 800x600 image
cursorLayer := TBGRABitmap.Create(image.Width,image.Height);
mainLayer := TBGRABitmap.Create(image.Width,image.Height);
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
x1 := x; // Store the line's starting point
y1 := y;
end;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ssLeft in Shift then // Mouse is moving with left button down
begin
cursorLayer.Fill(BGRAWhite); // Erase the line since the mouse has moved
x2 := x; // Get the new coordinates for the cursor end
y2 := y;
// Draw the line with the new coordinates
cursorLayer.DrawLineAntiAlias(x1,y1,x2,y2,BGRABlack,1.5);
// Put it on the image
image.PutImage(0,0,cursorLayer,dmDrawWithTransparency);
// Now put rest of the drawing back on the image
image.PutImage(0,0,mainLayer,dmDrawWithTransparency);
PaintImage;
end;
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
// Draw the completed line on the main layer
mainLayer.DrawLineAntiAlias(x1,y1,x2,y2,BGRABlack,1.5);
// Might as well count the lines
inc(count);
StatusBar1.Panels[0].Text :=IntToStr(count) + ' lines';
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
PaintImage;
end;
procedure TForm1.PaintImage;
begin
image.Draw(Canvas,0,0,True);
end;
end.
-
So, in fact you draw the layer with the current line under the main image ? Doing this way, it may happen that you don't see that you are drawing something. You can instead draw the layer with the current line above it. To do so, use FillTransparent instead, so that only the line is drawn over.
-
I tried cursorLayer.FillTransparent and also cursorLayer.Fill(BGRAPixelTransparent).
Both built with no problems, but neither one erased the old cursor lines, which I don't understand. I also tried reversing the order of
image.PutImage(0,0,cursorLayer,dmDrawWithTransparency);
// Now put rest of the drawing back on the image
image.PutImage(0,0,mainLayer,dmDrawWithTransparency);
which is what I assume you meant. That also made no difference when used with FillTransparent, but reversing them does cause problems with Fill(BGRAWhite).
I have tried drawing over 500 lines with no apparent issues due to the order.
Your thoughts?
-
Okay, I think I have it now. I needed to wipe the image itself in the OnMouseMove event, which I wasn't doing. FillTransparent now works on the cursorLayer, and I now have the cursor's rubber banding on top of the previous lines, instead of below them. I changed the rubber band to red to confirm it.
The changed code is below. Thanks for your assistance. BGRABitMap is a great thing. 8)
unit uMain;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
BGRABitMap, BGRABitMapTypes;
type
{ TForm1 }
TForm1 = class(TForm)
StatusBar1: TStatusBar;
procedure FormCreate(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormPaint(Sender: TObject);
private
image, mainLayer, cursorLayer: TBGRABitmap;
procedure PaintImage;
{ private declarations }
public
{ public declarations }
end;
var
Form1 : TForm1;
x1, y1, x2, y2, count : Integer;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.Width := 800;
Form1.Height := 600;
image := TBGRABitmap.Create(800,600,BGRAWhite); //create a 800x600 image
cursorLayer := TBGRABitmap.Create(image.Width,image.Height);
mainLayer := TBGRABitmap.Create(image.Width,image.Height);
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
x1 := x; // Store the line's starting point
y1 := y;
end;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ssLeft in Shift then // Mouse is moving with left button down
begin
// Erase the line since the mouse has moved
cursorLayer.FillTransparent;
image.Fill(BGRAWhite);
image.PutImage(0,0,mainLayer,dmDrawWithTransparency);
// Get the new coordinates for the cursor end of the line
x2 := x;
y2 := y;
// Draw the line with the new coordinates
cursorLayer.DrawLineAntiAlias(x1,y1,x2,y2, BGRA(255,0,0),1.5);
// Put it on the image
image.PutImage(0,0,cursorLayer,dmDrawWithTransparency);
PaintImage;
end;
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
// Draw the completeed line on the main layer
mainLayer.DrawLineAntiAlias(x1,y1,x2,y2,BGRABlack,1.5);
// Might as well count the lines
inc(count);
StatusBar1.Panels[0].Text :=IntToStr(count) + ' lines';
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
PaintImage;
end;
procedure TForm1.PaintImage;
begin
image.Draw(Canvas,0,0,True);
end;
end.
-
Cool. Thanks.
Now your code works on Windows, but may not work on other platforms, for example on MacOS, because of the way form Canvas is available. It is guaranted to be available only in an OnPaint event. So you should not call PaintImage directly, but instead call Invalidate or Repaint, which will call OnPaint. But then you get a flickering, so you need to prevent background to be cleared.
You can use the TBGRAVirtualScreen component of BGRAControls so you just need to redefine the OnRedraw event and call RedrawBitmap.
-
Well, it works fine in Linux too. :)
So you should not call PaintImage directly, but instead call Invalidate or Repaint, which will call OnPaint. But then you get a flickering, so you need to prevent background to be cleared.
But, like all good ideas, I stole the present method -- from one of your tutorials. :D However, I will keep this in mind. I am now confident that layers will work for my app, which I have begun to work on once again. At this point the test app is retired.
I do have another question though. Aside from greater memory usage and somewhat more processing time required, is there a practical limit to the number of layers? Right now, I am anticipating a total of five.
-
But, like all good ideas, I stole the present method -- from one of your tutorials. :D
Oh no, I did not propose that ? :o
Well, yeah, it is simpler that other methods. Ok, if it works on Linux, then it is essentially on MacOS that it won't.
I do have another question though. Aside from greater memory usage and somewhat more processing time required, is there a practical limit to the number of layers? Right now, I am anticipating a total of five.
You're right, the main issues are memory and processing time. The program can also get complex, for example if the number of layers can change. In this case, you can use BGRALayers. Your test program would become :
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
BGRABitMap, BGRABitMapTypes, BGRALayers;
type
{ TForm1 }
TForm1 = class(TForm)
StatusBar1: TStatusBar;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormPaint(Sender: TObject);
private
layers: TBGRALayeredBitmap;
backgroundLayer, mainLayer, cursorLayer: TBGRABitmap;
procedure PaintImage;
{ private declarations }
public
{ public declarations }
end;
var
Form1 : TForm1;
x1, y1, x2, y2, count : Integer;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.Width := 800;
Form1.Height := 600;
layers := TBGRALayeredBitmap.Create(800,600);
//create background layer
backgroundLayer := TBGRABitmap.Create(layers.Width,layers.Height,BGRAWhite);
layers.AddOwnedLayer(backgroundLayer);
//create main layer
mainLayer := TBGRABitmap.Create(layers.Width,layers.Height);
layers.AddOwnedLayer(mainLayer);
//create cursor layer
cursorLayer := TBGRABitmap.Create(layers.Width,layers.Height);
layers.AddOwnedLayer(cursorLayer,192);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
//free layers (don't need to free each layer individually because they are owned)
layers.Free;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
x1 := x; // Store the line's starting point
y1 := y;
end;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ssLeft in Shift then // Mouse is moving with left button down
begin
// Erase the line since the mouse has moved
cursorLayer.FillTransparent;
// Get the new coordinates for the cursor end of the line
x2 := x;
y2 := y;
// Draw the line with the new coordinates
cursorLayer.DrawLineAntiAlias(x1,y1,x2,y2, BGRA(255,0,0),1.5);
PaintImage;
end;
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
// Draw the completeed line on the main layer
mainLayer.DrawLineAntiAlias(x1,y1,x2,y2,BGRABlack,1.5);
cursorLayer.FillTransparent;
PaintImage;
// Might as well count the lines
inc(count);
StatusBar1.SimpleText :=IntToStr(count) + ' lines';
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
PaintImage;
end;
procedure TForm1.PaintImage;
begin
layers.Draw(Canvas,0,0);
end;
end.
-
If talking about layers I wonder how to easily move them up and down (change the Z axis order)?
-
Using BGRALayers you can do
TBGRALayeredBitmap.InsertLayer(DestinationIndex, SourceIndex: integer)
-
Circular you really kick some butt.
Now I am trying to move layers with a mouse. I got good example (http://dl.dropbox.com/u/17084229/Code/pavyzdys_drag.zip) with moving
TShape,but when I try code with a LayerOffset it moves way to fast.
-
I suppose you should update your fixedx at each mousemove, because coordinates are relative to the shape in your example whereas they are relative to whole image with a layer.
-
circular,
In the function
function TBGRACustomLayeredBitmap.ComputeFlatImage: TBGRABitmap;
I offer to ammend code
if LayerVisible[i] then
to
if LayerVisible[i] and (LayerOpacity[i]<>0) then
Thanx,
Fenix
-
Ok. Done. Thanks. :)
-
I've added some features in BGRALayers (on subversion). There are new functions :
- MoveLayerUp / MoveLayerDown to move up or down a layer in the stack
- Draw and ComputeFlatImage can take (firstLayer,lastLayer) as additionnal parameters, so you can draw a range of layers.
- Freeze/Unfreeze functions : you can freeze a range of layers that you will not change, so that they will not be computed again when you call Draw
- FreezeExceptOneLayer : a helper function that freezes everything and unfreeze one layer, useful for example if you move a layer, change only one layer, and when the movement is finished, you need to call Unfreeze to get all the layers updating again.
This freeze/unfreeze capability is only provided for optimization purposes. For example, if you try to freeze just one layer, it will not do anything, because there is no point in making a frozen copy of only one layer.
-
Hello people, i've just optimized advanced blending operations and layers with advanced blending operations.
TBGRALayeredBitmap has a new property LinearBlend (False by default) to specify if you want to use linear blending instead of gamma corrected blending (i.e. dmDrawWithTransparency).
TBGRABitmap has a new function :
BlendImageOver(x, y: integer; Source: TBGRACustomBitmap; operation: TBlendOperation; AOpacity: byte; ALinearBlend: boolean);
Which does in one step the blending operation and the "merge over" operation. So you can render a layer with one call to that function.
-
Thanks :)
-
You're welcome. :)
-
Hello people,
I've added :
- OpenRaster support (layered bitmap file format with .ora extension).
- new blending operations : boDivide, boSoftLight, boHardLight, boExclusion, boLinearExclusion, boSubtract, boLinearSubtract, boSubtractInverse, boLinearSubtractInverse (increase interoperability with Krita image editor)
You can now load and save TBGRALayeredBitmap :
- load from Paint .NET (*.pdn) and from OpenRaster (*.ora)
- save to OpenRaster (*.ora)
Interoperability with Gimp is poor because Gimp handles poorly blendind modes in OpenRaster format.
-
Here is a test project for playing with layered bitmap files (you need to use lastest svn) :
-
This remembers me Corel Photo Paint it's really nice.
You will add free transform tool? (scaling, rotating, perspective, etc..).
When you finish this stuff you can try 9 slice scaling:
I've tryed to do something with this for BGRAImageButton and Windows 7 Drawer with BGRABitmapThemeUtils.pas unit in BGRAControls, it works, but it has limited functionality.
-
Well, i'm planning to merge it with LazPaint.
I don't see the link with 9 slice scaling. But it can be a tool added to LazPaint.
-
Check BGRAImageButton or BGRABitmapThemeUtils.pas in BGRAControls.
Well I've done just functions to scale with that, but there is no tool.
In google you can see how it works:
http://www.google.com/search?q=9+slice+scaling&rlz=1C1LENN_enAR480&sugexp=chrome,mod%3D15&um=1&ie=UTF-8&hl=es&tbm=isch&source=og&sa=N&tab=wi&ei=aARWUNPXK4SA9gT654GwDg&biw=1092&bih=479&sei=bgRWUMCHGpSi8gT9qYCIDw
Edit: Also the functions in BGRABitmapThemeUtils are limited, you only can set 'BorderWidth' and 'BorderHeight', so you can't manipulate each of the 4 imaginary lines.
Edit 2: This is a really nice article:
http://www.centigrade.de/en/blog/article/modern-user-interface-design-tools-part-2-graphical-approach-of-gui-design-tools/
and this other
http://www.w3.org/TR/2005/WD-css3-background-20050216/#the-border-image
-
Oh thanks. Well, yes it can be added as a tool. But I was saying that I don't see how it is related to layers.
-
Ok. Well in Adobe Flash and Illustrator it can be applied for each layer, it's a property.
PD: Attached there is an example, similar to the css3 site one.
-
I understand. The layer would have properties do define where the 4 limits are, and a rectangle where to draw the resulting image.
But i'd rather do it as a filter that produces the content of the layer, because TBGRALayeredBitmap, with just blending modes, can be stored and loaded from an OpenRaster file. So if I stick to simple layer operations, there will be more interoperability. If I add special features, then I will need to create a specific image format for LazPaint. I was thinking about it, but well, it's not necessary in fact, and it would be yet another layered bitmap format.
I've added some little things to my OpenRaster format, like more blending modes, and gamma correction option. Gamma correction is not a big issue, and custom blending modes, well, anyway, it is not very clear where to stop with blending modes.
One thing that could be added to, is a reference to another image to define a layer. Some layer would be the copy of some external layered bitmap. Of course, the flattened image of the external file would be stored inside the layered image, so that it can be opened without that external file. But it would be updated if necessary. There may be circular references to check, but it would be an easy way to implement complex structures, instead of grouping layers inside one file.
-
As you wish =)
PD: You need an avatar.
-
Here it is :)
-
Nice, I need to update my avatar too.
-
Here is a test project for playing with layered bitmap files (you need to use lastest svn) :
thank you very useful to me. Lazarus 2.0.12 (2022)
-
thank you very useful to me. Lazarus 2.0.12 (2022)
-
You're welcome.
Layers have been implemented a long time ago, so for sure now you would have a recent version enough.