var
tempbmp1, tempbmp2: TBGRABitmap;
begin
// Background Gradient
tempbmp1:=TBGRABitmap.Create(btn1.Width,btn1.Height,BGRA(104,104,104,255));
tempbmp1.Canvas.GradientFill(Rect(1,Round(btn1.Height*0.25),btn1.Width-1,btn1.Height-1),$686868,$404040,gdVertical);
// Frame Border
tempbmp1.Canvas.Brush.Color:=$181818;
tempbmp1.Canvas.FrameRect(btn1.ClientRect);
// Light Gradient
tempbmp2:=TBGRABitmap.Create(btn1.Width,btn1.Height,BGRA(0,0,0,0));
tempbmp2.GradientFill(1,1,btn1.Width-1,btn1.Height-1,
BGRA(255,255,255,34),
BGRA(255,255,255,10), gtLinear,
PointF(btn1.ClientRect.Right,btn1.ClientRect.Top),
PointF(btn1.ClientRect.Right,btn1.ClientRect.Bottom),
dmDrawWithTransparency,True,False);
tempbmp2.AlphaFillRect(2,2,btn1.Width-2,btn1.Height-2,0);
// Merge Bitmaps
tempbmp1.Canvas.Draw(0,0,tempbmp2.Bitmap);
// Paint in Canvas
btn1.Canvas.Draw(0,0,tempbmp1.Bitmap);
// Free Bitmaps
tempbmp1.Free;
tempbmp2.Free;
end;
Add some pictures :)Yes. It's a good idea.
tempbmp1.Canvas.Draw(0,0,tempbmp2.Bitmap);It does not work on gtk, because TBitmap cannot be drawn with alpha channel. Instead, use :
tempbmp2.Draw(tempbmp1.Canvas,0,0,False);
What do you mean?
Hm, I see your API is totally incompatible with standard TCanvas, TPen, etc --
is this intentional?
For example, if you would implement image.Pen.JoinStyle instead of image.JoinStyle,
this last tutorial would not be even needed.
Hm, I see your API is totally incompatible with standard TCanvas, TPen, etc --
is this intentional?
For example, if you would implement image.Pen.JoinStyle instead of image.JoinStyle,
this last tutorial would not be even needed.
Sir, I think BGRABitmap is one of the best Lazarus libraries...
give to lazarus many new abilities...
1) The package does not compile with fpc 2.4.2 due to circular dependenciesIt's not a circular dependency. Units are fully defined in the interface. That's even why there is an interface section, to allow units to use each other without circular dependency.
(in particular, BGRADefaultBitmap <->BGRAPolygon).
Although this is formally a FPC bug, circular unit dependencies are bad
programming practice, so it would be nice if BGRABitmap avoided it.
I was able to work around it by not using a package and adding
the BGRABitmap source to the unit path -- but I can not publish such a hack
into Lazarus repository.
2) As I suspected in the previous post, porting TCanvas-using code to BGRAHow can you know that it's arbitrary ? I already tried to explain to you why BGRABitmap is different from standard Canvas. You did not answer at all, and continue in your idea that it's non sense.
is cumbersome. Some functions, like Ellipse, receive arbitrarily different parameters --
no big deal, of course, but irritating.
3) FPColorToBGRA function is missing. I think it should be extracted fromPositive formulation : you need some FPColorToBGRA function. Well, why not write it yourself, and put it here. Then I would just have to copy and paste it into subversion.
TBGRADefaultBitmap.SetInternalColor.
4) Some functionality is absent (or maybe I just did not find it):That's right, these functions are not implemented. As I thought you would need dashed lines, I programmed it. This was to a certain extent for you.
Font.Orientation, Clipping/ClipRect, Brush.Style, RadialPie.
BTW, I noticed that your tutorials utilize old-style .lrs resources --It's rather a secondary aspect if it works. That's the version of Lazarus that I'm using and that is available on Ubuntu. I prefer that BGRABitmap be available for users of old version of Lazarus too.
I think they should be converted to FPC resources so as not to teach
outdated practices to novice users.
procedure TForm1.FormPaint(Sender: TObject);
var image: TBGRABitmap;
c: TBGRAPixel;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight,ColorToBGRA(ColorToRGB(clBtnFace)));
c := ColorToBGRA(ColorToRGB(clWindowText));
image.RectangleAntialias(80,80,300,200,c,50);
image.Draw(Canvas,0,0,True);
image.free;
end;
the example shows chiseled corners but I get squareDo you notice that you are very negative.I apologize if I offended you, of course I think BGRA has much potential --
For example, you say it's totally incompatible.Again, sorry -- but yes, I did mean "totally" incompatible as opposed to
Well, incompatible would not be enough ?
That's even why there is an interface section, to allow units to use each other without circular dependency.You mean implementation section?
Wait for a new version of FPC that handles this, reorganise BRGABitmap or use static linking ?
How can you know that it's arbitrary ? I already tried to explain to you why BGRABitmap is different from standard Canvas.You did, and I have taken note of what you said.
you need some FPColorToBGRA function. Well, why not write it yourself, and put it here. Then I would just have to copy and paste it into subversion.
procedure FPColorToBGRA(AValue: TFPColor);
begin
with AValue do
Result := BGRA(red shr 8, green shr 8, blue shr 8, alpha shr 8);
end;
As I thought you would need dashed lines, I programmed it. This was to a certain extent for you.Thanks, this is very appreciated.
I prefer that BGRABitmap be available for users of old version of Lazarus too.Ah, ok -- I just wanted to let you know.
Ok, thanks.QuoteDo you notice that you are very negative.I apologize if I offended you, of course I think BGRA has much potential --
this is why I am trying to utilize it.
In fact, I had an idea of proposing BGRA for inclusion in Lazarus --
and I think in this case the problems I mentioned would probably worry other
Lazarus developers as well.
Please believe me that my comments are by no means directed at you personally --
only at technical aspects of your library.
I am accustomed to formulating my technical thoughts directly,
but I will certainly try to say things in your preferred way in the future.
Ok, this needs to be developped to be correctly understood.QuoteFor example, you say it's totally incompatible.Again, sorry -- but yes, I did mean "totally" incompatible as opposed to
Well, incompatible would not be enough ?
"slightly" incompatible -- for an example of the latter, see e.g. AggPas implementation.
Anyway, this is just a difference of terms -- I prefer to say thatIn a certain way, yes, but it's not a problem. It's a mutual dependence. It's like in life, we are all mutually dependent.
implementation section allows to use units *with* circular
(or semi-circular -- nice word for this situation, BTW) dependency,
because dependency does not go away, it is only worked around.
New version of FPC may or may not fix this -- it is a well-known long-standingI meant included as units, not as a package.
hard-to-fix bug. As for static linking -- I am not sure what you mean,
AFAIK, fpc programs are statically linked by default.
So, *I* would like the second choice -- but of course, it is your project, so you decide.I understand. I am also favorable to this if the FPC bug cannot be fixed. It's hard for me to believe it cannot be fixed, but anyway, it's likely to take some time.
How can you know that it's arbitrary ? I already tried to explain to you why BGRABitmap is different from standard Canvas.You did, and I have taken note of what you said.
Ok. I've copied it (i've changed procedure to function).Code: [Select]procedure FPColorToBGRA(AValue: TFPColor);
begin
with AValue do
Result := BGRA(red shr 8, green shr 8, blue shr 8, alpha shr 8);
end;
1) If you decide to implement it, you should also use it instead if inlined codeOk.
in TBGRADefaultBitmap.SetInternalColor function
2) This is best expressed with the patch, but I wanted to avoid making post too long,Ok, I'm not familiar with extracting functions, but now I see what you mean.
and the issue is very simple -- so I thought that the phrase "extract from
TBGRADefaultBitmap.SetInternalColor" will be the most direct and compact way to express
my intention. Obviously I failed to make it understandable enough, sorry for that.
Unfortunately, dashed lines did not work for me on the first try--What happens?
but I did not yet investigate deeply, it is quite possible this is due to my mistake.
In conclusion, I do look forward to working with BGRA -- because is seems to finallyThanks. By the way, I still think that a canvas would be a good idea. But I would like first to determine the needs, what is the best option for everyone.
bring working transparency implementation, which both FPImage/FPCanvas and LCL failed to
do for a long time. Please continue your good work.
The options are still :
- using TFPColor
- using TColor and a byte for Opacity
- using TBGRAPixel
- combining them
You mean TColor and byte for opacity, along with TBGRAPixel ?
TFPColor is a record with word values (16 bit for each channel).
I meant included as units, not as a package.I see. Unfortunately, this is limits usage possibilities -- for example,
It's hard for me to believe it cannot be fixed,You might want to read some fpc-devel threads on the topic --
What changes do you suggest to avoid mutual references ?That's easy -- see attached patch.
Quote...dashed lines did not work...What happens?
The options are still :
- using TFPColor
- using TColor and a byte for Opacity
- using TBGRAPixel
- combining them
Ok. I've copied it (i've changed procedure to function).
Looking at the line drawing code, I do not see any references to the PenStyle --
maybe you forgot to implement it?
You might want to read some fpc-devel threads on the topic --It's sad if they are negative with each others. I did not mean that I cannot accept a negative report. I suppose that you understand what I mean.
then you will see what real negative posts look like :)
That's easy -- see attached patch.I will look at that.
Obviously, it may be improved -- for example, you might want to add (and then use)
refcounting for the interface, add the rest if methods to it,
put it in a separate unit intead of TBGRABitmapTypes etc.
I just did a minimal patch for easier review.
There are many procedures. Some of these do not take a width w as parameter, and do not implement pen styles.QuoteNothing -- lines always are drawn solid.Quote...dashed lines did not work...What happens?
Looking at the line drawing code, I do not see any references to the PenStyle --
maybe you forgot to implement it?
BTW, you might want to use include files to reduce the code duplication betweenWhy not. What do you suggest exactly ?
line drawing procedures without loss of speed.
This is indeed a serious problem -- I think that the decision of FPC developersYou mean that TFPCustomCanvas should include TColor ?
not to implement TColor was a mistake. I did not yet give up a hope of
convincing them to fix it.
Meanwhile, I think some support of TColor is a must -- there is justThat's right, it's already the case.
too much code using it.
I suggest the following plan:
1) Internally, use whatever works fastest -- I guess it is TBGRAPixel
2) Provide a functions for conversions with TFPColor/TColor/TColor+Opacity in both directions
(this is already almost done)
3) Provide pen/brush interface -- I believe it is far too entrenched to break now,Where can we contact them on this issue ?
and besides, it is not really so bad.
5) Provide TCanvas emulation and discuss with Lazarus developers the standard interface
for opacity in TFPCanvas/TCanvas.
4) (in the future, this is not quite simple)Why not.
Put TColor-related functions in a separate unit, and
remove dependencies on Graphics unit in all other code. This will allow
to use BGRABitmap without LCL widgetset -- for example, in web applications.
There are many procedures. Some of these do not take a width w as parameter, and do not implement pen styles.
You mean that TFPCustomCanvas should include TColor ?Yes. Even if it will not support "system" colors.
Where can we contact them on this issue ?On the mailing list -- see this thread http://www.mail-archive.com/lazarus@lists.lazarus.freepascal.org/msg18414.html (http://www.mail-archive.com/lazarus@lists.lazarus.freepascal.org/msg18414.html) for a recent discussion
we could have three properties :
- Color: TColor
- Opacity: Byte
- ColorBGRA: TBGRAPixel
Or we could add a fourth property to pen and brush
- ColorFP: TFPColor
I suppose you agree that we cannot derive such canvas from TCanvasOf course -- that would defeat idea of widgetset independence.
TBGRACanvas cannot be fully compatible, because coordinates are floating numbers, unless we add each function twiceYou do not need to add every function twice -- only those that are present in
Is it possible to link actual reference counting functions to interface reference counting functions ?
Nope, it was correct.QuoteThere are many procedures. Some of these do not take a width w as parameter, and do not implement pen styles.
Hm, it seems what it is actually the reverse -- those procedures that take width as parameter,
do implement PenStyle, others do not.
The problem is maybe that TColor is ambiguous, it can mean plain RGB or a reference to a system color.QuoteYou mean that TFPCustomCanvas should include TColor ?Yes. Even if it will not support "system" colors.
I'm not use to this.QuoteWhere can we contact them on this issue ?On the mailing list -- see this thread http://www.mail-archive.com/lazarus@lists.lazarus.freepascal.org/msg18414.html (http://www.mail-archive.com/lazarus@lists.lazarus.freepascal.org/msg18414.html) for a recent discussion
of TCanvas/TFPCanvas in relation to TAChart and widgetset-less drawing.
Also, I have noticed that you already overloaded some functionsNope, it's just that some line drawing functions use Bresenham algorithm. They are available for convenience only.
to receive integers -- so I assume you have a need for this besides TCanvas compatibility.
You mean tutorials on BGRABitmap or on other Lazarus components or on FreePascal in general ?
I could do other tutorials about BGRABitmap. More precisely, what subject interests you ?
I suppose the upload went wrong. Here I uploaded it again.
Try downloading lazpaint2.8.zip again.
http://sourceforge.net/projects/lazpaint/files/lazpaint/lazpaint2.8.zip/download
You can also use subversion to get version with current modifications. If you have Windows, you need TortoiseSVN for this and then checkout https://lazpaint.svn.sourceforge.net/svnroot/lazpaint.
I could do other tutorials about BGRABitmap. More precisely, what subject interests you ?
What would be nice is a simple demo like the tutorial (first example w/boxes) which outlines the calling of bezier curves.Ok.
I tried to implement it like in the demo from the download (ttestdemo I think?) but I keep getting some type of scoping issue w/tpanel when I cut and past to my project. It say's "'got DynArray and requested openarray".I'm surprised. Can you post your code here?
Now BGRABitmap package avoids semi-circular references (updated on subversion and as a zip file).
Yes, it is almost good. Just one reference left -- BGRABitmap <-> BGRAAnimatedGif.Ok, it's updated on subversion.
Simply removing BGRAAnimatedGif from BGRABitmap "uses" section fixes the problem,
and then the package works. Thank you.
I am curious as to why did you prefer abstract classes to interfaces in the end?To keep backward compatibility, so that it's still possible to write "as TBGRABitmap" without warning. On the other side, it's a bit confusing to use an interface without reference counting. And anyway, I needed to have an abstract class for generic creation, so it would have been necessary to have both, and I don't want to have prototypes (in default, in abstract and in interface).
Note that to test it, you have first apply the fix above.I'm surprised that it does work for you. Here on win32 version, there was no problem. Anyway it's fixed on subversion.
I just have a problem to compile the version 2.8 or the last svn with Gtk2. This is related to TBGRADefaultBitmap/TBGRACustomBitmap.Thanks. I also patched BGRAQtBitmap. I hope it works on Qt too now.
This seem to work with the attached patch.
What would be nice is a simple demo like the tutorial (first example w/boxes) which outlines the calling of bezier curves.Ok.QuoteI tried to implement it like in the demo from the download (ttestdemo I think?) but I keep getting some type of scoping issue w/tpanel when I cut and past to my project. It say's "'got DynArray and requested openarray".I'm surprised. Can you post your code here?
/////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, Buttons, ComCtrls, ColorBox, Spin, Arrow, Menus, BGRABitmap,
BGRADefaultbitmap, bgrabitmaptypes, ExtendedNotebook, math, utest;
type
pointsAr=array of tpoint;
TArray=array of double;
TTest = class
public
Name: string;
procedure OnPaint(Canvas: TCanvas; Width,Height: Integer); virtual; abstract;
end;
TTest11 = class(TTest)
protected
virtualScreen: TBGRABitmap;
pts: array of TPointF;
dirs: array of TPointF;
FFilter: string;
public
constructor Create(filter: string);
destructor Destroy; override;
procedure OnPaint(Canvas: TCanvas; Width,Height: Integer); override;
procedure setpoints;
//procedure setPoints(originX,originY,phiX,phiY,endX,endY:double);
end;
{ TForm1 }
TForm1 = class(TForm)
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
CheckBox4: TCheckBox;
ExtendedNotebook1: TExtendedNotebook;
Image1: TImage;
Memo1: TMemo;
Panel1: TPanel;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
SpeedButton4: TSpeedButton;
SpeedButton5: TSpeedButton;
SpinEdit1: TSpinEdit;
SpinEdit2: TSpinEdit;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TrackBar1: TTrackBar;
TrackBar2: TTrackBar;
TrackBar3: TTrackBar;
TrackBar4: TTrackBar;
TrackBar5: TTrackBar;
TrackBar6: TTrackBar;
procedure ExtendedNotebook1Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Image1Paint(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure SpeedButton4Click(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure TrackBar2Change(Sender: TObject);
procedure TrackBar5Change(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
/////////////////////////////////////////////////////////////////////
function calcPHI2(BaseN:double;count:integer):Tarray;
function calcPHIdbl(BaseN:double;pos:boolean=true):tarray;
//function calcXYZsym(BaseN:double;sym:boolean):tArray;
//function calc_symmetry(BaseN:tarray;shift_positive:boolean):Tarray;
//function calccompN(BaseN:double);
procedure memodump1(str:string);
procedure memodump(ar:tarray);
procedure redrawArX(ar:tarray);
procedure redrawArY(ar:tarray);
var
Form1: TForm1;
X1pos,Y1pos,Z1pos,X2pos,Y2pos,Z2pos:integer;
implementation
//////////////////////////////////////////////////////////////////
function calcPHI2(BaseN:double;count:integer):Tarray;
var
ar1,ar2,R_array:tarray;
i,i2:integer;
Base_i,maj,min :double ;
begin
{ar1:=nil;
ar2:=nil;
R_array:=nil;}
base_i:=baseN;
setlength(ar1,count);
setlength(ar2,count);
ar1[0]:=Base_i;
// ar2[count]:=0; //this is wrong
for i:=0 to count-1 do
begin
ar1:=base_i*0.618;
ar2:=baseN-(base_i-ar1);
base_i:=ar1;
//memodump1(floattostr(ar1)+'-----'+floattostr(ar2));
//memodump1(inttostr(round(ar1)));
end;
base_i:=baseN;
{for i:= 0 to count-1 do
begin
ar1:=base_i*0.618;
ar2:=baseN-(base_i-ar1);
base_i:=ar1;
memodump1('---'+inttostr(round(ar2)));
end; }
i2:=(count*2)-1;
setlength(R_array,(count*2)-1);
for i:=0 to Count-1 do
begin
R_Array:=ar1;
R_Array[i2]:=ar2;
i2:=i2-1;
end;
result:=R_Array;
{ memodump1('*****');
memodump(ar1);
memodump1('*****');
memodump(ar2);
memodump1('*****');
memodump(R_array); }
end;
///////////////////////////////////////////////////
///////////////////////////////////////////////////
function calcPHIdbl(BaseN:double;pos:boolean):tarray;
var
arA,arB,r_array:tarray;
i,i2,ic:integer;
side:boolean=true;
begin
arA:=calcPHI2(baseN*0.618,form1.trackbar1.Position); ///// works fine for first call to calcphi2
arB:=calcPhi2(BaseN-(basen*0.618),form1.trackbar2.position); ///// fails here!! (SIGSEV)
//memodump(arB);
//redrawArX(arA);
//redrawArX(arB);
ic:=length(arA);
setlength(r_array,length(arA)+length(arB));
i2:=length(r_array)-1;
case pos of
true:
for i:= 0 to ic-1 do
begin
r_array:=basen-(basen*0.618)+arA;
r_array[i2]:=arB;
i2:=i2-1;
end;
false:
for i:= 0 to ic-1 do
begin
r_array:=arA;
r_array[i2]:=basen*0.618+arB;
i2:=i2-1;
end;
end;
//memodump(r_array);
//redrawArX(r_array);
result:=r_array;
end;
///////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////
{function calcXYZsym(BaseX,BaseY,BaseZ:double;Xsym,Ysym,Zsym:boolean):tArray;
var
arX,ar,arY,arZ,r_array:tarray;
i,i2:integer;
begin
arX:= calcPHIdbl(BaseX,true);
arY:= calcPHIdbl(BaseY,true);
arZ:= calcPHIdbl(BaseZ,true);
//calcXYZsym(300,50,30,false,true,false);
end; }
///////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////
{function calc_symmetry(BaseN:double;shift_positive:boolean):tarray ;
var
r_Array,r_ArraySh,bArray:tarray;
i:integer;
begin{
bArray:=calcPHIdbl(BaseN,true);
for i:= 0 to length(bArray-1) do
begin
r_Array:=bArray*(-1)
end;
case shift_positive of
true:///////////////////
begin
setlength(r_ArraySh,length(r_Array));
for i:= 0 to length(r_ArraySh-1) do
r_ArraySh[1]:= r_Array*(-1);
result:=r_ArraySh;
end;
false://////////////////
begin
setlength(r_Array,length(bArray));
for i:= 0 to length(r_ArraySh-1) do
r_Array[1]:= r_Array;
result:=r_Array;
end;
end; }
end; }
///////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////
procedure memodump(ar:tarray);
var
i:integer;
begin
//form1.memo1.clear;
For i:= 0 to length(ar)-1 do
begin
form1.memo1.Lines.add(floattostr(round(ar))); ///rounded to integer
end;
end;
procedure memodump1(str:string);
begin
form1.Memo1.lines.add(str);
end;
{ TForm1 }
procedure Tform1.SpeedButton1Click(Sender: TObject);
var
a:tarray;
begin
a:=calcPHI2(300,4);////works fine but only 1 time
//memodump1('//////////');////2nd try returns 'SIGSEV' error
//redrawArX(a);
end;
procedure TForm1.Image1Paint(Sender: TObject);
begin
end;
procedure TForm1.ExtendedNotebook1Change(Sender: TObject);
begin
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
X1pos:=1;
Y1pos:=1;
Z1pos:=1;
X2pos:=1;
Y2pos:=1;
Z2pos:=1;
end;
procedure TForm1.SpeedButton2Click(Sender: TObject);
var
a:tarray;
points:pointsAr;
begin
// Initial point
{setlength(ttest11.pts,5);
ttest11.pts[1].x := 10;
ttest11.pts[1].y := 10;
// Final point
ttest11.pts[4].x := 120;
ttest11.pts[4].y := 120;
// Control points
ttest11.pts[2].x := 10;
ttest11.pts[2].y := 60;
ttest11.pts[3].x := 60;
ttest11.pts[3].y := 10; }
ttest11.setpoints;
Image1.Canvas.PolyBezier(points);
a:=calcphidbl(300,form1.checkbox1.checked);
ttest11.onpaint(form1.timage1.canvas, 300,100);
//redrawArX(a);
end;
procedure TForm1.SpeedButton3Click(Sender: TObject);
var
bmp: TBGRABitmap;
p: PBGRAPixel;
n: integer;
begin
bmp := TBGRABitmap.Create('image.png');
p := bmp.Data;
for n := bmp.NbPixels-1 downto 0 do
begin
p^.red := not p^.red; //invert red canal
inc(p);
end;
bmp.InvalidateBitmap; //note that we have accessed directly to pixels
bmp.Draw(Canvas,0,0,True);
bmp.Free;
end;
procedure TForm1.SpeedButton4Click(Sender: TObject);
var
bmp: TBGRABitmap;
begin
//bmp := TBGRABitmap.Create(100,100,BGRABlack); //creates a 100x100 pixels image with black background
//bmp.FillRect(20,20,60,60,BGRAWhite, dmSet); //draws a white square without transparency
// bmp.FillRect(40,40,80,80,BGRA(0,0,255,128), dmDrawWithTransparency); //draws a transparent blue square
end;
procedure TForm1.TrackBar1Change(Sender: TObject);
var
X,Y,Xsym,Ysym:tarray;
begin
form1.image1.canvas.clear;
X:=calcphidbl(300,form1.checkbox1.checked);
Y:=calcphidbl(100,form1.checkbox2.checked);
//Xsym:=calc_symmetry(X,true);
//Ysym:=calc_symmetry(Y,true);
redrawArX(X);
redrawArY(Y);
//redrawArX(Xsym);
//redrawArY(Ysym);
end;
procedure TForm1.TrackBar2Change(Sender: TObject);
var
X,Y,Xsym,Ysym:tarray;
begin
form1.image1.canvas.clear;
X:=calcphidbl(300,form1.checkbox3.checked);
Y:=calcphidbl(100,form1.checkbox4.checked);
//Xsym:=calc_symmetry(X,true);
//Ysym:=calc_symmetry(Y,true);
redrawArX(X);
redrawArY(Y);
end;
procedure TForm1.TrackBar5Change(Sender: TObject);
begin
// timage.canvas.
end;
procedure redrawArX(ar:tarray);
var
i:integer;
begin
//form1.image1.canvas.clear;
form1.image1.canvas.pen.Color:=clred;
For i:= 0 to length(ar)-1 do
begin
form1.image1.canvas.moveto(round(ar),0); ///rounded to integer
form1.image1.canvas.Lineto(round(ar),100);
end;
end;
procedure redrawArY(ar:tarray);
var
i:integer;
begin
//form1.image1.canvas.clear;
form1.image1.canvas.pen.Color:=clred;
For i:= 0 to length(ar)-1 do
begin
form1.image1.canvas.moveto(0,round(ar)); ///rounded to integer
form1.image1.canvas.Lineto(300,round(ar));
end;
end;
constructor TTest11.Create(filter: string);
begin
inherited Create;
Name := 'Antialiased lines and splines';
if filter <> '' then Name += ' with filter '+filter;
randomize;
virtualScreen := nil;
FFilter := filter;
end;
destructor TTest11.Destroy;
begin
virtualScreen.Free;
inherited Destroy;
end;
procedure TTest11.OnPaint(Canvas: TCanvas; Width, Height: Integer);
var filtered: TBGRABitmap;
begin
if pts = nil then exit;
if (virtualscreen <> nil) and ((virtualscreen.width <> width) or (virtualscreen.Height <> height)) then
FreeAndNil(virtualScreen);
if virtualscreen = nil then
virtualscreen := TBGRABitmap.Create(Width,Height);
if ffilter = 'Emboss' then
begin
virtualScreen.Fill(BGRABlack);
virtualScreen.DrawPolyLineAntialias(virtualScreen.ComputeOpenedSpline(pts),BGRAWhite,(width+height)/80,True);
filtered := virtualScreen.FilterEmbossHighlight(True) as TBGRABitmap;
virtualScreen.Fill(ColorToRGB(clBtnFace));
virtualScreen.PutImage(0,0,filtered,dmDrawWithTransparency);
filtered.Free;
virtualscreen.Draw(Canvas,0,0,True);
end else
begin
virtualScreen.Fill(BGRAWhite);
virtualScreen.DrawPolyLineAntialias(virtualScreen.ComputeOpenedSpline(pts),BGRA(0,0,0,128),(width+height)/80,True);
if ffilter = 'Contour' then
begin
filtered := virtualScreen.FilterContour as TBGRABitmap;
filtered.Draw(Canvas,0,0,True);
filtered.Free;
end else
begin
virtualScreen.DrawPolyLineAntialias(pts,BGRA(0,0,0,128),(width+height)/800,True);
virtualscreen.Draw(Canvas,0,0,True);
end;
end;
end;
procedure ttest11.setpoints;
begin
setlength(pts,3);
setlength(dirs,3);
Pts[0].x:= 20;
Pts[0].y:= 20;
Pts[1].x:= 200;
Pts[1].y:= 90;
Pts[2].x:= 20;
Pts[2].y:= 200;
onpaint(form1.timage1.canvas,300,100);
end;
initialization
{$R *.lfm}
end.
It say's "'got DynArray and requested openarray".On which line?
Is it possible to do this http://img815.imageshack.us/i/88910461.png/ with BGRABitmap?
procedure LoadFromStream(Str: TStream; Handler: TFPCustomImageReader);
uses FPReadPNG;
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
var
reader: TFPReaderPNG;
begin
GradBMP:=TBGRABitmap.Create(Width,Height);
reader := TFPReaderPNG.Create;
Red:=TBGRABitmap.Create; //don't need to initialize size here
Red.LoadFromStream(TLazarusResourceStream.Create('splash_logo','PNG'),reader);
reader.Free;
end;
Cool.
The tutorial is in german thanks to Billyraybones and Lainz, and now it is in French too.
http://wiki.lazarus.freepascal.org/BGRABitmap_tutorial/fr
Cool.
The tutorial is in german thanks to Billyraybones and Lainz, and now it is in French too.
http://wiki.lazarus.freepascal.org/BGRABitmap_tutorial/fr
Maybe you mean that some aspects are not developped enough in tutorials.
function Shadow(ASource: TBGRABitmap; AOffSetX,AOffSetY: Integer; ARadius: Integer; AShowSource: Boolean = True): TBGRABitmap;
var
bmpOut: TBGRABitmap;
begin
bmpOut:= TBGRABitmap.Create(ASource.Width+2*ARadius+AOffSetX,ASource.Height+2*ARadius+AOffSetY);
bmpOut.PutImage(ARadius+AOffSetX,ARadius+AOffSetY,ASource,dmDrawWithTransparency);
BGRAReplace(bmpOut,bmpOut.FilterBlurRadial(ARadius,rbFast));
if AShowSource = True then bmpOut.PutImage(ARadius,ARadius,ASource,dmDrawWithTransparency);
Result:= bmpOut;
end;
var
n: integer;
p: PBGRAPixel;
begin
p := image.Data;
for n := 1 to p.NbPixels do
begin
if p^.alpha <> 0 then
begin
p^.red := wantedColor.red;
p^.green := wantedColor.green;
p^.blue := wantedColor.blue;
end;
inc(p);
end;
end;
bgrabitmaptypes.pas(370,6) Error: No matching implementation for interface method "IUnknown.QueryInterface(const TGuid,out <Formal type>):LongInt; StdCall;" found
bgrabitmaptypes.pas(370,6) Error: No matching implementation for interface method "IUnknown._AddRef:LongInt; StdCall;" found
bgrabitmaptypes.pas(370,6) Error: No matching implementation for interface method "IUnknown._Release:LongInt; StdCall;" found
bgrabitmaptypes.pas(437,6) Error: No matching implementation for interface method "IUnknown.QueryInterface(const TGuid,out <Formal type>):LongInt; StdCall;" found
bgrabitmaptypes.pas(437,6) Error: No matching implementation for interface method "IUnknown._AddRef:LongInt; StdCall;" found
bgrabitmaptypes.pas(437,6) Error: No matching implementation for interface method "IUnknown._Release:LongInt; StdCall;" found
bgrabitmaptypes.pas(439,1) Fatal: There were 6 errors compiling module, stopping
function QueryInterface(const iid : tguid;out obj) : longint;stdcall;
function _AddRef : longint;stdcall;
function _Release : longint;stdcall;
Clearly the interface IBGRAScanner doesn't compile.
Maybe it could work by replacing IFNDEF WINDOWS by IFDEF UNIX. It should occur 12 times.
Or maybe by removing stdcall and cdecl keywords in the implementation section.
Or by using only these definitions (in implementation too) :Quotefunction QueryInterface(const iid : tguid;out obj) : longint;stdcall;
function _AddRef : longint;stdcall;
function _Release : longint;stdcall;
Without any IFDEFs. In fact, I don't know if the IFDEFs are necessary at all.
Hello Circular,
I'm getting errors in trying to compile 3.2:Code: [Select]bgrabitmaptypes.pas(370,6) Error: No matching implementation for interface method "IUnknown.QueryInterface(const TGuid,out <Formal type>):LongInt; StdCall;" found
bgrabitmaptypes.pas(370,6) Error: No matching implementation for interface method "IUnknown._AddRef:LongInt; StdCall;" found
bgrabitmaptypes.pas(370,6) Error: No matching implementation for interface method "IUnknown._Release:LongInt; StdCall;" found
bgrabitmaptypes.pas(437,6) Error: No matching implementation for interface method "IUnknown.QueryInterface(const TGuid,out <Formal type>):LongInt; StdCall;" found
bgrabitmaptypes.pas(437,6) Error: No matching implementation for interface method "IUnknown._AddRef:LongInt; StdCall;" found
bgrabitmaptypes.pas(437,6) Error: No matching implementation for interface method "IUnknown._Release:LongInt; StdCall;" found
bgrabitmaptypes.pas(439,1) Fatal: There were 6 errors compiling module, stopping
2.8 is working well. Any thoughts?
Frederick
Carbon Widgets on Intel OS X 10.6
function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; override;
function _AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; override;
function _Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; override;
Ok I'll try putting stdcall for the 3 functions.I have official 0.9.30 (2011-04-13), fpc v:2.4.0, svn rev:30219, i386-darwin-carbon
About the ToString problem, I suppose that you don't have version 0.9.30.
Thanks Leledumbo. So the correct code now is :This one works, but again, without override;Code: [Select]function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; override;
function _AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; override;
function _Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; override;
Edit: in fact in BGRABitmap there is not "override" because it does not replace an ancestor method.
Hi, I would like to know if TBGRABitmap has a way to load RAW images from a memory buffer or stream.It has LoadFromStream procedure and i think that if LoadFromFile accepts like all common image formats, also LoadFromStream must accept all common formats.
lBmp := TBGRABitmap.Create(FImgWidth, FImgHeight);
try
for y := 0 to FImgHeight-1 do
begin
p := lBmp.Scanline[y];
for x := 0 to FImgWidth-1 do
begin
p^.red := lBuffer[0];
p^.green := lBuffer[1];
p^.blue := lBuffer[2];
p^.alpha:= 255;
inc(p);
inc(lBuffer);
end;
end;
lBmp.Draw(Self.Canvas, 0, 0);
finally
lbmp.Free;
end;
circular,The LoadFromFile functions just calls the standard LoadFromFile functions of FPImage which uses TPNGReader. There is nothing specific here when loading bitmaps. But when saving, I specified that it should use 8-bit channels, because some programs cannot read 16-bit channels.
I just tried version 3.4, and it works fine, many thanks for the fixes.
Can you tell me what unit BGRABitmap uses to read a png? There seems to be a bug in the png import, and I'm not sure how to report it. I apologize for not being able to figure it out myself.
Some png files created in Photoshop, which open fine in browsers and other image viewing programs, do not open correctly.
Circular, using the code below I can load a raw bitmap image from a pointer to an UInt8 array I get from a C++ medical library. The problem is that the images have different bit depths. They can be of 8,10,12,13,16 bits.You need to determine the red/green/blue values before assigning them to the bitmap. The code you supplied is perfect for 24-bit RGB images, but of course, it does not work for other formats.
Finally, my question is, how can I show correctly my image with TBGRABitmap?
var PWordBuffer : PWord;
begin
...
for y := 0 to FImgHeight-1 do
begin
p := lBmp.Scanline[y];
for x := 0 to FImgWidth-1 do
begin
byteValue := PWordBuffer^ shr 8; //means div 256
p^.red := byteValue;
p^.green := byteValue;
p^.blue := byteValue;
p^.alpha:= 255;
inc(p);
inc(PWordBuffer);
end;
end;
var img: TLazIntfImage;
descr: TRawImageDescription;
p: PByte;
x,y: integer;
begin
img := TLazIntfImage.Create(0,0);
fillchar(descr,sizeof(descr),0);
descr.BitsPerPixel := 8;
descr.Format := ricfGray;
descr.RedPrec := 8; //red channel is used to store grayscale value
descr.Width := 16;
descr.Height := 16;
img.DataDescription := descr; //this allocates the bitmap
for y := 0 to 15 do
begin
p := img.GetDataLineStart(y);
//here you can load the real data instead of this loop
for x := 0 to 15 do
begin
p^ := x*16;
inc(p);
end;
end;
bmp := TBGRABitmap.Create(img.Width,img.Height);
for y := 0 to 15 do
for x := 0 to 15 do
bmp.SetPixel(x,y,FPColorToBGRA(img.Colors[x,y]));
img.free;
end;
for y := 0 to FImgHeight - 1 do
begin
p := lBmp.Scanline[y];
for x := 0 to FImgWidth - 1 do
begin
p^.red := lBuffer[2];
p^.green := lBuffer[1];
p^.blue := lBuffer[0];
p^.alpha := 255;
Inc(p);
Inc(lBuffer, 3);
end;
end;
I found a solution for the RGB problem, the pointer to the buffer must be incremented by 3 instead of 1.The color are rendered correctly ?
Now I only have to figure out how to elimnate the duplicated images when working with 16bits grayscale images.Do you have a screenshot with PByte and PWord ?
The color are rendered correctly ?
Do you have a screenshot with PByte and PWord ?
Clearly this image is 8-bit grayscale and PByte is the right way to read it.QuoteDo you have a screenshot with PByte and PWord ?
PByte: http://www.tarjeta-salud.com.ar/img/test-pbyte.jpg
PWord: http://www.tarjeta-salud.com.ar/img/test-pword.jpg
How i can create Outline text with BGRABitmap?It's not easy, because it uses the bitmap result from the operating system, it does not have access to the geometry of the font. Anyway you can make some outline by using the contour filter :
uses Types;
procedure TForm1.FormPaint(Sender: TObject);
const textContent = 'Some text'; fontheight = 30;
var image,textBmp,outline: TBGRABitmap;
size: TSize;
p: PBGRAPixel;
n: Integer;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight, ColorToBGRA(ColorToRGB(clBtnFace)) );
//define font param
image.FontAntialias := true;
image.FontHeight := fontheight;
image.FontStyle := [fsBold];
//create text image
size := image.TextSize(textContent);
textBmp := TBGRABitmap.Create(size.cx+2,size.cy+2,BGRAWhite);
image.CopyPropertiesTo(textBmp);
textBmp.TextOut(1,1,textContent,BGRABlack);
//create outline
outline := textbmp.FilterContour as TBGRABitmap;
textBmp.Free;
p := outline.data;
for n := 0 to outline.NbPixels-1 do
begin
p^.alpha := 255-(GammaExpansionTab[p^.red] shr 8);
p^.red := 0; //outline color
p^.green := 0;
p^.blue := 192;
inc(p);
end;
//draw outline
image.PutImage(20-1,20-1,outline,dmDrawWithTransparency);
outline.Free;
//draw inner text
image.TextOut(20,20,textContent,BGRAWhite);
image.Draw(Canvas,0,0,True);
image.free;
end;
The LoadFromFile functions just calls the standard LoadFromFile functions of FPImage which uses TPNGReader. There is nothing specific here when loading bitmaps. But when saving, I specified that it should use 8-bit channels, because some programs cannot read 16-bit channels.
Circular, I measured the time it takes to load the buffer image to a TBGRABitmap and it's very fast, congratulations!.
Now, if I do myBGRABitmap.Draw(Image1.Canvas, 0, 0); it takes too much time (2 seconds for a 4000x4000 image is too much).
What component do you recommend to paint to, instead of TImage?. I use a TScrollBox with a TImage as child, that allows me to scroll the image.
fBitmap.Draw(fImage.Picture.Bitmap.Canvas, x, y, fOpaque);
tempBmp := myFullBitmap.GetPart(Rect(ScrollX,ScrollY,ScrollX+VisibleWidth,ScrollY+VisibleHeight)) as TBGRABitmap;
tempBmp.Draw(myPaintBox.Canvas,0,0);
tempBmp.Free;
Hi,
I am trying draw simple gradient:I have questions:
FBGRA.Canvas.GradientFill(ClientRect,clRed,clSilver,gdHorizontal); FBGRA.Draw(Self.Canvas,0,0,False);
1. How to draw gradient with low quality (less pass colors)
2. There is gdHorizontal and gdVertical style but how create gradient from top-left to bottom-right?
image.GradientFill(...);
BGRAReplace(image, image.FilterNormalize);
image.ResampleFilter := rfSpline;
stretched := image.Resample(newWidth, newHeight) as TBGRABitmap;
image.ResampleFilter := rfBestQuality;
stretched := image.Resample(newWidth, newHeight) as TBGRABitmap;
Hi,
I am trying draw simple gradient:I have questions:
FBGRA.Canvas.GradientFill(ClientRect,clRed,clSilver,gdHorizontal); FBGRA.Draw(Self.Canvas,0,0,False);
1. How to draw gradient with low quality (less pass colors)
2. There is gdHorizontal and gdVertical style but how create gradient from top-left to bottom-right?
Use GradientFill function from BGRABitmap, not GradientFill from Canvas.
bmp: BGRABitmap;
bmp.GradientFill instead bmp.Canvas.GradientFill
And you can set coordinates of the gradient.
See this example with a radial gradient:
http://wiki.lazarus.freepascal.org/Sample_Graphics#Lazarus_About
If you want to do a gradient with low quality, you can draw it with dark colors, and then apply Normalize filter :And thanks too :)Code: [Select]image.GradientFill(...);
BGRAReplace(image, image.FilterNormalize);
ScrollHoriz.Max := Round(VisibleWidth/ZoomFactor) - PaintBox1.Width;
...
tempBmp := myFullBitmap.GetPart(Rect(ScrollX,ScrollY,ScrollX+Round(VisibleWidth/ZoomFactor),ScrollY+ound(VisibleHeight/ZoomFactor))) as TBGRABitmap;
stretched := tempBmp.Resample(VisibleWidth,VisibleHeight,rmFineResample);
tempBmp.Draw(myPaintBox.Canvas,0,0);
stretched.Free;
tempBmp.Free;
How I can assign a TBGRABitmap to a TImage?
Edit: I got it. But there is a better way?
bmp:= TBGRABitmap.Create(Image1.Width,Image1.Height); bmp.Rectangle(Image1.ClientRect,BGRABlack,BGRAWhite,dmDrawWithTransparency); Image1.Picture.Bitmap.LoadFromBitmapHandles(bmp.Bitmap.BitmapHandle,bmp.Bitmap.BitmapHandle); bmp.Free;
Hi Circular. I'm struggling to find some pointers about line/glyph picking.
I would like to draw something over a bitmap, like a line or text and let the user pick it and move it around with the mouse.
How can I do this?
I've done a knob button component.
*faint* Awesomeness! Thanks for the great job!Thanks.
It needs a 9.31 snapshot (that's fair enough since other components may have needed some bug fixes to work). However the other components are dependent on the 3.5 bgrabitmap and even then I couldn't get the palette icons in tab bgra controls to show for knob and progress bar.The panel speed button button etc display.9.31 is necessary for TBGRAImageList.
var
lWidth: Integer;
lHeight: Integer;
begin
FTool:= tZoom;
FZoom := FZoom * (0.1);
// apply zoom to original image and get the new dimensions
SetDicomZoom(FZoom);
GetDimensions(FImgWidth, FImgHeight);
lWidth := Round(PaintBox1.Width * FZoom);
lHeight:= Round(PaintBox1.Height * FZoom);
FLeft := FLeft + ((lWidth- PaintBox1.Width) div 2);
FTop := FTop + ((lHeight- PaintBox1.Height) div 2);
// Show the image on Paintbox.
ShowDicomImage;
PaintBox1.Invalidate;
procedure TForm1.Zoom;
var
lWidth: double;
lHeight: double;
lCenterX: double;
lCenterY: double;
lLeft: double;
lTop: double;
begin
// original image width and height
lWidth := FImgWidth;
lHeight := FImgHeight;
// center point of PaintBox
lCenterX := (PaintBox1.Width / 2);
lCenterY := (PaintBox1.Height / 2);
// original center of PaintBox plus offset
lLeft:= FLeft + lCenterX + 1;
lTop := FTop + lCenterY + 1;
// apply zoom to original image and get new dimensions
SetDicomZoom(FZoom);
GetDimensions(FImgWidth, FImgHeight);
// recalculate positions
FLeft := (FImgWidth * lLeft / lWidth) - lCenterX - 1;
FTop := (FImgHeight * lTop / lHeight) - lCenterY - 1;
ShowDicomImage;
PaintBox1.Invalidate;
end;
Thanks.
Well, I do not really understand what you mean by "on the horizon". To compute spline length, you can compute points and then compute the length of the polyline. Normals can also be computed from the polyline.
So in fact, functions that compute length and compute normals for polylines would be ok ? Or did you mean something else ?
t1 := GetPositionOfLength( Length/3 );
t2 := GetPositionOfLength( 2*Length/3 );
part1 := ComputePoints(0,t1);
part2 := ComputePoints(t1,t2);
part3 := ComputePoints(t2,1);
Do you mean for example a line splitted into 3 parts, that you bend and the bent line has also 3 parts of the same ratio of length ?
This could be achieved with a object called for example TSpline, which is created with control points, and then methods like:
- PointAt(position:single) where position is in [0..1]
- NormalAt(position: single)
- GetPositionOf(point: TPointF): single that returns the position in[0..1] (well one possible position)
- GetPositionOfLength(length: single): single that returns the position so that [0..pos] has the wanted length
- Length:single -> full length
- ComputePoints(startPos,endPos: single) with position in [0..1]
So if you want to calcule three equal parts, you would doCode: [Select]t1 := GetPositionOfLength( Length/3 );
t2 := GetPositionOfLength( 2*Length/3 );
part1 := ComputePoints(0,t1);
part2 := ComputePoints(t1,t2);
part3 := ComputePoints(t2,1);
Would it be allright?
TRasterImage.BitmapHandleNeeded: Unable to create handles, using default
[FORMS.PP] ExceptionOccurred
Sender=EInvalidOperation
Exception=Canvas does not allow drawing
Stack trace:
$00000000004E8E8B
$0000000000516908
$000000000065157C line 41 of ../../lazpaint/bgrabitmap/bgratext.pas
$0000000000651606 line 46 of ../../lazpaint/bgrabitmap/bgratext.pas
$000000000060A740 line 2410 of ../../lazpaint/bgrabitmap/bgradefaultbitmap.pas
$0000000000602DC0 line 1313 of ../../lazpaint/bgrabitmap/bgradefaultbitmap.pas
$00000000005FF69B line 650 of ../../lazpaint/bgrabitmap/bgradefaultbitmap.pas
$00000000005FA912 line 145 of ../../lazpaint/bgrabitmap/bgrabitmap.pas
$0000000000437056
TApplication.HandleException Canvas does not allow drawing
Stack trace:
$00000000004E8E8B
$0000000000516908
$000000000065157C line 41 of ../../lazpaint/bgrabitmap/bgratext.pas
$0000000000651606 line 46 of ../../lazpaint/bgrabitmap/bgratext.pas
$000000000060A740 line 2410 of ../../lazpaint/bgrabitmap/bgradefaultbitmap.pas
$0000000000602DC0 line 1313 of ../../lazpaint/bgrabitmap/bgradefaultbitmap.pas
$00000000005FF69B line 650 of ../../lazpaint/bgrabitmap/bgradefaultbitmap.pas
$00000000005FA912 line 145 of ../../lazpaint/bgrabitmap/bgrabitmap.pas
$0000000000437056
exception at 00000000004E8E8B:
Canvas does not allow drawing.
@CaptBill:
These methods do not exist yet. I am talking about how we could design the object you need.
Yes, to do this, use BGRAGradientScanner unit, create a TBGRAGradientScanner object, and pass it as a parameter to the FillPoly function.
image: TBGRABitmap;
image.FontHeight := 30;
image.FontAntialias := true;
image.TextOut(1,1,'0,1,2,3,4',clBlack);
I don't know is this problem with TAChart or BGRA because with BGRA everything is ok:
Code: [Select]
image.FontAntialias := true;
procedure paintlines(XLines,YLines:tarray;Xlength,YLength:double; imagebox:TImage);
var
p: PBGRAPixel;
image: TBGRABitmap;
hsla: THSLAPixel;
iX,iY :integer;
xl,yl,intXLength,intYLength:integer;
begin
image := TBGRABitmap.Create(imagebox.width,imagebox.height);
hsla.lightness := 32768;
hsla.alpha := 65535;
for iX:= 0 to length(XLines) do
begin
xl:=round(XLines[ix]);
yl:=round(YLines[iy]);
IntXLength:= round(XLength);
IntYLength:= round(YLength);
image.DrawLineAntialias(xl,0,xl+IntXLength,0,p,1); ///error"Got PBgraPixel expected PBgraScanner"
for iY:= 0 to length(YLines) do
begin
//image.DrawHorizLine(0,round(YLines[iy]),round(YLines[iy]+YLength,p));
end;
image.InvalidateBitmap;
image.Draw(imagebox.Canvas,0,0,True);
image.free;
end;
It turned out to be due to slight incompatibility in BGRABtimap vs TCanvas line drawing,
should be fixed in r31189.
By the way, circular, is there any way to globally turn antialiasing on/off in BGRABitmap?You mean in CanvasBGRA ? You can do it with Font.Antialiasing. You can use it in chart back-end.
It would allow me to fully implement AntialiasingMode similar to other back-ends.
This code worked fine on Windows7 but won't compile under Linux.You cannot call it with a pbgrapixel but with a TBGRAPixel. If you have a PBRAPixel, you can dereference it with ^. But I don't understand you're code. You don't seem to use the hsla variable.
Tried many ways to cast the variables to the procedure. Nothing seems to work. Keeps calling the scanner version of DrawLineAntialias but I want the pbgrapixel version of the overloaded procedure.
Yes, I already did that. The question was about global antialiasing, referring to all drawing,By the way, circular, is there any way to globally turn antialiasing on/off in BGRABitmap?You mean in CanvasBGRA ? You can do it with Font.Antialiasing. You can use it in chart back-end.
It would allow me to fully implement AntialiasingMode similar to other back-ends.
Font antialising must be explicitely set because it is slower and not always very readable. Personnaly I would not use it in TAChart axes.I agree, it is off by default in TAChart.
..also about the demo request for TBgraCustomScanner. I completely forgot about the demo app in Lazpaint directory. The plasma/fire demo should be all anyone needs to see the scanner functions at work.Oops I forget to answer about TBGRACustomScanner. There is an example here:
....also the answer to the question I had about getting the length/normals of a bezier (about a week ago) I found right on the Wiki demo staring me in the face....all the points(technically lines) are in the return array of ComputeSpline/Bezier functions....just might need to modify the array to send floats instead of integers is all.ComputeSpline returns an array of PointF so it's alread floats. But the precision may not be sufficient. It depends on what you need.
Well there is CanvasBGRA.AntialiasingMode. Is that what you were looking for?
1) Do you ever plan to produce a version of BGRABitmap which does not depend on LCL?No. But if someone wants to do it that's ok.
2) From architectural POV, I thought that BGRABitmap is the main fully functional API,No. For example you can call FillPoly or FillPolyAntialias.
and BGRACanvas is just an adaptor that exposes part of functionality in
TCanvas-compatible manner. However, BGRACanvas now has functionality
(AntiliasingMode) not present in BGRABitmap, which violates the above principle.
3) What is the reason for checkIt's to call a faster procedure (pixel line) instead of the generic one (polygon line). These lines are widely used in TAChart for the grids. As they are horizontal and vertical, there is no point in using the nice rendering.
if (FCanvas.Pen.ActualWidth = 1) and (FCanvas.Pen.Style = psDot) then
in LineTo procedure?
Sure, but moving TAChart to BGRACanvas will make that task harder.1) Do you ever plan to produce a version of BGRABitmap which does not depend on LCL?No. But if someone wants to do it that's ok.
But using BGRABitmap you can not switch antialiasing on and off without changing code.QuoteBGRACanvas now has functionalityNo. For example you can call FillPoly or FillPolyAntialias.
(AntiliasingMode) not present in BGRABitmap, which violates the above principle.
You don't need to do that. You just need to use an appropriate back-end with new functions for drawingSure, but moving TAChart to BGRACanvas will make that task harder.1) Do you ever plan to produce a version of BGRABitmap which does not depend on LCL?No. But if someone wants to do it that's ok.
Anyway, since such a change does not look likely, I will do the move.
But using BGRABitmap you can not switch antialiasing on and off without changing code.That's just another way.
(Or wrapping every call into a conditional statement, of course).
Last question: what is your name? I would like to credit you in the commit message.Well, circular, or circular17 if you prefer.
You don't need to do that. You just need to use an appropriate back-end with new functions for drawingOf course, I did not mean converting all TAChart, just BGRA back-end.
adjacent polygons or phong effects. You can add some fallback behavior in the generic class.
What about assigning a back-end to the TAChart object, so that it uses any back-end,It already works this way.
without any dependency ?
Unfortunately, fpcanvas is slightly limited in functionality,Now I understand your need. aggpas does not work already for this?
so I'd like to have other LCL-indepenent back-ends.
Problem is BGRABitmap is deeply linked to TBitmap. It is on purpose, to allow easy switching between TBGRABitmap and LCL bitmaps. As a matter of fact, optimized versions use internally operating system bitmaps (DIB section on Windows and same thing on Linux).
It is possible to do a server-side application with LCL.That was my first reaction too. As I said, LCL design has some problems.
Hello people !
I've added a Canvas2D property, which can be used to draw like on the HTML Canvas element.
http://wiki.lazarus.freepascal.org/BGRABitmap_tutorial_14
It's not finished yet, some functions are not available, but you can already do some stuff.
Thanks Lainz. I've updated the sample graphics page.
I would not have believed it either... Thanks for converting from SVG !
mouse highlight for triangles and paw.
procedure TForm1.FormPaint(Sender: TObject);
var
bmp : TBGRABitmap;
phong : TPhongShading;
BC1 : TBGRAPixel;
begin
bmp := TBGRABitmap.Create(ClientWidth, ClientHeight, BGRAWhite);
bmp.DrawHorizLine(0,120,ClientWidth,BGRABlack);
phong := TPhongShading.Create;
phong.LightColor:=BGRAWhite;
BC1:=ColorToBGRA(clRed);
BC1.alpha:=100;
phong.DrawRectangle(bmp,Rect(50,50,200,200),10,10,BC1,true,[]);
bmp.Draw(Canvas, 0, 0, True);
bmp.Free;
end;
Alpha:=Alpha-(255-eColor.alpha); //<- added
ec.alpha := Alpha shl 8+Alpha;
result := GammaCompression(ec);
everything is ok with alpha from 230 - 255, with more transparency I see a little mess on the corners.unit ucube3d;
{$mode objfpc}
interface
uses
Classes, SysUtils, BGRAScene3D, BGRABitmapTypes;
type
{ TCubeScene3D }
TCubeScene3D = class(TBGRAScene3D)
cube: IBGRAObject3D;
constructor Create;
procedure SetCubeTexture(ATexture: TBGRACustomBitmap);
procedure SetCubeTexture(ATexture: IBGRAScanner; tx,ty: single);
end;
implementation
{ TCubeScene3D }
constructor TCubeScene3D.Create;
var v: arrayOfIBGRAVertex3D;
begin
inherited Create;
cube := CreateObject;
v := cube.Vertices.Add([-1,-1,-1, 1,-1,-1, 1,1,-1, -1,1,-1,
-1,-1,+1, 1,-1,+1, 1,1,+1, -1,1,+1]);
cube.AddFace([v[0],v[1],v[2],v[3]],BGRA(255,0,0));
cube.AddFace([v[4],v[5],v[1],v[0]],BGRA(128,160,255));
cube.AddFace([v[7],v[6],v[5],v[4]],BGRA(96,224,0));
cube.AddFace([v[3],v[2],v[6],v[7]],BGRA(192,0,255));
cube.AddFace([v[1],v[5],v[6],v[2]],BGRA(255,192,0));
cube.AddFace([v[4],v[0],v[3],v[7]],BGRAWhite);
cube.Vertices.Scale(20);
AmbiantLight := 0.25;
AddLight(Point3D(1,1,1),1.25);
end;
procedure TCubeScene3D.SetCubeTexture(ATexture: TBGRACustomBitmap);
begin
SetCubeTexture(ATexture,ATexture.Width-1,ATexture.Height-1);
end;
procedure TCubeScene3D.SetCubeTexture(ATexture: IBGRAScanner; tx, ty: single);
var
i: Integer;
begin
for i := 0 to cube.FaceCount-1 do
with cube.Face[i] do
begin
Texture := ATexture;
TexCoord[0] := PointF(0,0);
TexCoord[1] := PointF(tx,0);
TexCoord[2] := PointF(tx,ty);
TexCoord[3] := PointF(0,ty);
end;
end;
end.
Abmp.Canvas2D.strokeStyle(clGreen);
Abmp.Canvas2D.LineTo(....)
Abmp.Canvas2D.stroke;
Abmp.Canvas2D.strokeStyle(clRed);
Abmp.Canvas2D.LineTo(....)
Abmp.Canvas2D.stroke;
Abmp.Canvas2D.strokeStyle(clGreen);
Abmp.Canvas2D.beginPath;
Abmp.Canvas2D.moveTo(...);
Abmp.Canvas2D.lineTo(....)
Abmp.Canvas2D.stroke;
Abmp.Canvas2D.strokeStyle(clRed);
Abmp.Canvas2D.beginPath;
Abmp.Canvas2D.moveTo(...);
Abmp.Canvas2D.lineTo(....)
Abmp.Canvas2D.stroke;
The wiki is not working, so I did an application with simple examples with comments. It's on subversion. I've fixed some things in BGRABitmap too.
There is also a zip available on source forge (version 4.6).
http://sourceforge.net/projects/lazpaint/files/src/
Sorry to disturb you one more time but...still no plan for a alpha-blended panel component ?
Thanks
The problem is TControls that doesn't support alpha.
TBGRAControl=(TControl)
Using the trick for Adding alpha support in Windows TControl and the other OS's has alpha support by default.
TBGRAControl=(TControl)
// Default TControl
Sorry to disturb you one more time but...still no plan for a alpha-blended panel component ?What do you want to do ? Maybe it's possible without it.
Thanks
Is TBGRA available for OS X too ?
I do not have find the download-file in source-forge (only Win and Linux) %)
Hello Mr Circular.Ok well, it would be possible to create a transparent virtual screen, but without components in it. That means that you would have to program interactions with the elements inside the panel yourself by handling the mouse events for the whole panel. In other words, you can do what you want if you don't put components into it, and if the program draws and handles the components by itself.
First i want a shaped panel, like showed in the topic of shaped panel to create a custom hint, with alphablended properties.
Also i develop a DJ program (miXimum) and i want to use that alphablended panel for the waves-forms, easier to synchronize two songs.
Also it could be a great effect if the players (panels) could appear and disappear after mixing (with alphablend effect)..
Hello Mr Circular.Ok well, it would be possible to create a transparent virtual screen, but without components in it. That means that you would have to program interactions with the elements inside the panel yourself by handling the mouse events for the whole panel. In other words, you can do what you want if you don't put components into it, and if the program draws and handles the components by itself.
First i want a shaped panel, like showed in the topic of shaped panel to create a custom hint, with alphablended properties.
Also i develop a DJ program (miXimum) and i want to use that alphablended panel for the waves-forms, easier to synchronize two songs.
Also it could be a great effect if the players (panels) could appear and disappear after mixing (with alphablend effect)..
If this is ok, you just need that transparent virtual screen component.
Fbmp.Canvas2D.strokeStyle(clRed);
Fbmp.Canvas2D.beginPath;
Fbmp.Canvas2D.moveTo(10,10);
Fbmp.Canvas2D.lineTo(200,200);
Fbmp.Canvas2D.stroke;
Fbmp.Fill(someColor);
Fbmp.Canvas2D.shadowColor(clBlack);
Fbmp.Canvas2D.shadowOffset := PointF(5,5);
Fbmp.Canvas2D.shadowBlur := 3;
Imagine a custom built interface and even your components are drawn by BGRAbitmap, plus transparency.
I have no idea.
I think is a form with code. With my little experience could not do this =)Apparently, they register the form with RegisterPropertyEditor.
Yo've seen spktoolbar? It has an editor in the folder "designtime".
https://lazarus-ccr.svn.sourceforge.net/svnroot/lazarus-ccr/components/spktoolbar
Also jedi code format (jcf in the lazarus component folder) is integrated in the IDE.
I think is a form with code. With my little experience could not do this =)Apparently, they register the form with RegisterPropertyEditor.
Yo've seen spktoolbar? It has an editor in the folder "designtime".
https://lazarus-ccr.svn.sourceforge.net/svnroot/lazarus-ccr/components/spktoolbar
Also jedi code format (jcf in the lazarus component folder) is integrated in the IDE.
resim1 := TBGRABitmap.Create(resim1dosya); // A jpeg file
onizleme := resim1.Resample(512,384) as TBGRABitmap; // image resized to 512x384
maske:=TBGRABitmap.Create(512,384); // a 512x384 mask image
maske.GradientFill(0,0,maske.Width,maske.Height,BGRA(255,255,255),BGRA(0,0,0),gtLinear,PointF(0,0),PointF(0,maske.Height),dmSet); // A white to black gradient for mask
onizleme.ApplyMask(maske); //Mask is applied
sonresim:=TBGRABitmap.Create(512,384); //Final image
sonresim.PutImage(0,0,onizleme,dmDrawWithTransparency); // Final image is rendered
sonresim.Draw(Panel1.Canvas,0,0,True); // and drawn to canvas..
onizleme.Free;
resim1.Free;
maske.free;
sonresim.Free; // all resources are freed..
procedure TForm1.FormCreate(Sender: TObject);
begin
FBmp1 := TBGRABitmap.Create(400, 400); // FBmp1 is the "plainCanvas"
FVect1 := TBGRABitmap.Create(400, 400);
FVect2 := TBGRABitmap.Create(400, 400);
// draw temp vect1
FVect1.Canvas2D.lineWidth:= 2;
FVect1.Canvas2D.strokeStyle(clGreen);
FVect1.Canvas2D.fillStyle(clYellow);
FVect1.Canvas2D.beginPath;
FVect1.Canvas2D.strokeRect(20,20, 200,20);
FVect1.Canvas2D.fillRect(21,21, 198,18);
FVect1.Canvas2D.stroke;
// draw temp vect2
FVect2.Canvas2D.lineWidth:= 2;
FVect2.Canvas2D.strokeStyle(clRed);
FVect2.Canvas2D.beginPath;
FVect2.Canvas2D.strokeRect(40,10, 100,100);
FVect2.Canvas2D.stroke;
end;
procedure TForm1.CopyVectorsToBitmap;
var
lRect: TRect;
begin
lRect := FVect1.ClipRect;
FBmp1.Canvas.CopyRect( lRect, FVect1.Canvas, lRect );
FBmp1.Canvas.CopyRect( lRect, FVect2.Canvas, lRect );
Invalidate;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
// copy "plainCanvas" to screen or PaintBox, or whatever
FBmp1.Draw(Self.Canvas,0, 0, False);
end;
You should not use Canvas property of BGRABitmap unless you have no choice, because it is slower.
procedure WMEraseBkgnd(var Message: TLMEraseBkgnd); message LM_ERASEBKGND;
...
procedure TForm1.WMEraseBkgnd(var Message: TLMEraseBkgnd);
begin
//do nothing
end;
with Printer do
try
BeginDoc;
Printer.Canvas.CopyRect(
Rect(0, 0, Printer.PageWidth, Printer.PageHeight),
FBmp.Canvas,
Rect(0, 0, FBmp.Width, FBmp.Height)
);
finally
EndDoc
end;
with Printer do
try
BeginDoc;
Canvas.Draw(0, 0, FBmp.Bitmap);
finally
EndDoc;
end;
FBmp.Bitmap.Canvas
instead FBmp.Canvas
with Printer do
try
BeginDoc;
FBmp.Draw(Canvas,0,0);
finally
EndDoc;
end;
Circular, I've uploaded a showcase of a Dicom Viewer i've written using BGRABitmap.
Please, take a look:
http://www.youtube.com/watch?v=hc1RT-s-dw0 (http://www.youtube.com/watch?v=hc1RT-s-dw0)
Thank you for this wonderful library.
Leonardo M. Ramé
http://leonardorame.blogspot.com (http://leonardorame.blogspot.com)
procedure TForm1.PaintBox1OnPaint(Sender: TObject);
var
lBMP: TBGRABitmap;
begin
lBMP := TBGRABitmap.Create(100, 100);
try
(* start drawing stuff *)
lBmp.Canvas.Line ...
(* End drawing stuff *)
lBmp.Draw(PaintBox1.Canvas, 0, 0);
finally
lBmp.Free;
end;
end;
I need to move blue line everywhere but it should stay under yellow without repainting those lines as shown in 2 pictureFirst paint all blue lines, then paint all yellow lines? i think you can't do this without repainting.
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;
..
bsHot: begin
FBGRA.PutImage(0, 0, FBGRAUp, dmDrawWithTransparency);
FBGRA.PutImage(0, 0, FBGRAHot, dmDrawWithTransparency, FTimerStep);
end;
..
procedure CustomReplace(var Destination: TBGRACustomBitmap; Temp: TObject);
begin
Destination.Free;
Destination := Temp as TBGRACustomBitmap;
end;
var
TBmp: TBGRABitmap;
begin
if csLoading in ComponentState then
exit;
if (Bitmap = nil) or (Bitmap.Width < 1) and (Bitmap.Height < 1) then
exit;
FBmpHeight := Bitmap.Height div 4;
FBGRA.SetSize(Width, Height);
TBmp := TBGRABitmap.Create(FBmp);
//get pointer bitmaps
FreeAndNil(FBGRAUp);
FBGRAUp := TBmp.GetPtrBitmap(0,FBmpHeight);
FBGRAUp.ResampleFilter:= rfBestQuality;
FreeAndNil(FBGRAHot);
FBGRAHot := TBmp.GetPtrBitmap(FBmpHeight,FBmpHeight*2);
FBGRAHot.ResampleFilter:= rfBestQuality;
FreeAndNil(FBGRADown);
FBGRADown := TBmp.GetPtrBitmap(FBmpHeight*2,FBmpHeight*3);
FBGRADown.ResampleFilter:= rfBestQuality;
FreeAndNil(FBGRADisabled);
FBGRADisabled := TBmp.GetPtrBitmap(FBmpHeight*3,FBmpHeight*4);
FBGRADisabled.ResampleFilter:= rfBestQuality;
if BitmapOptions.Enable then
begin
CustomReplace(FBGRAUp,CustomResizeBitmap(FBGRAUp,BitmapOptions.BorderWidth,BitmapOptions.BorderHeight,Width,Height,BitmapOptions.DrawMode,BitmapOptions.ResampleMode,BitmapOptions.ResampleFilter));
CustomReplace(FBGRADown,CustomResizeBitmap(FBGRADown,BitmapOptions.BorderWidth,BitmapOptions.BorderHeight,Width,Height,BitmapOptions.DrawMode,BitmapOptions.ResampleMode,BitmapOptions.ResampleFilter));
CustomReplace(FBGRAHot,CustomResizeBitmap(FBGRAHot,BitmapOptions.BorderWidth,BitmapOptions.BorderHeight,Width,Height,BitmapOptions.DrawMode,BitmapOptions.ResampleMode,BitmapOptions.ResampleFilter));
CustomReplace(FBGRADisabled,CustomResizeBitmap(FBGRADisabled,BitmapOptions.BorderWidth,BitmapOptions.BorderHeight,Width,Height,BitmapOptions.DrawMode,BitmapOptions.ResampleMode,BitmapOptions.ResampleFilter));
end
else
begin //needed even if same size in order to make a real copy
CustomReplace(FBGRAUp, FBGRAUp.Resample(Width, Height));
CustomReplace(FBGRADown, FBGRADown.Resample(Width, Height));
CustomReplace(FBGRAHot, FBGRAHot.Resample(Width, Height));
CustomReplace(FBGRADisabled, FBGRADisabled.Resample(Width, Height));
end;
TBmp.Free;
InvalidatePreferredSize;
AdjustSize;
if Sender is TBitmap then
Invalidate;
{$IFDEF DEBUG}
Inc(FUpdateCount);
{$ENDIF}
end;
FBGRAUp := nil;
FBGRADown := nil;
FBGRADisabled := nil;
FBGRAHot := nil;
In fact, it seems that the error I found in BGRABitmap is causing the error you mentionned. Anyway here is a new version of BGRABitmap (5.5) :
- new blend operations : boNiceGlow and boDarkOverlay
- merged boMultiply and boLinearMultiply because it looked the same
- css colors : CSSBlue, CSSRed etc.
- TBGRAColorList : CSSColors.ByName[...]
- StrToBGRA handles CSS color names
- alpha PutImage fix
http://sourceforge.net/projects/lazpaint/files/src/
I've commited a fix loading bgrapixel from string, the function StrToBGRA when the string is something like 'rgba(80,70,60,50);'
before it always returned alpha as 255, now it works fine.
You can do this with Canvas2D property. Use scale, rotate, translate, arc and stroke. Finally call resetTransform for next drawing. You can also start with save (state) and end with restore (state).
EDIT: also call beginPath before arc, so the complete sequence is :
scale, rotate, translate, beginPath, arc, stroke, resetTransform
There is an "obj" directory, you need to copy it near the exe file (in lib directory).
uses BGRALayers;
var image: TBGRALayeredBitmap;
begin
image := TBGRALayeredBitmap;
image.LoadFromFile('someimage.ora'); //note that you can also load a Paint.NET file here
...
image.Draw(Canvas, 0,0);
...
image.Free;
end;
var image: TBGRALayeredBitmap;
begin
image := TBGRALayeredBitmap.Create(800,600);
image.AddOwnedLayer(TBGRABitmap.Create(800,600));
image.AddLayerFromFile('someimage.png');
...
image.SaveToFile('myimage.ora');
image.Free;
end;
procedure SetMargins(AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer);
procedure SetMargins(AMargins: TMargins);
property Margins: TMargins;
procedure Draw(ABitmap: TBGRABitmap; ARect: TRect; DrawGrid: boolean = False);
procedure Draw(ABitmap: TBGRABitmap; ALeft,ATop,AWidth,AHeight: integer; DrawGrid: boolean = False);
procedure AutodetectRepeat;
property SliceRepeat[Aposition: TSliceRepeatPosition]: Boolean;
The welcome page is http://wiki.lazarus.freepascal.org/BGRABitmap_tutorial
It contains now a list of categories to help browse through the tutorials
also added sections in tutorials 4 and 5.
uses BGRAOpenRaster, BGRAPaintNET;
begin
RegisterOpenRasterFormat;
RegisterPaintNetFormat;
end;
unit unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
//units added here
EasyLazFreeType, //FreeType support
BGRABitmap, BGRABitmapTypes, //BGRABitmap
BGRAFreeType; //BGRABitmap FreeType support
type
{ TForm1 }
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
ftfont: TFreeTypeFont;
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
ftfont := TFreeTypeFont.Create;
ftfont.Name := 'Arial.ttf';
ftfont.SizeInPixels := 30;
ftfont.ClearType := True;
end;
procedure TForm1.FormPaint(Sender: TObject);
var
bmp: TBGRABitmap;
drawer: TBGRAFreeTypeDrawer;
begin
bmp := TBGRABitmap.Create(ClientWidth,ClientHeight,ColorToRGB(clBtnFace));
drawer := TBGRAFreeTypeDrawer.Create(bmp);
drawer.DrawText('Hello world',ftfont,0,0,BGRABlack,[ftaTop,ftaLeft]);
drawer.Free;
bmp.Draw(Canvas,0,0);
bmp.Free;
end;
end.
//supposing you have Bitmap: TBGRABitmap
var vf : TBGRAVectorizedFont;
begin
vf := TBGRAVectorizedFont.Create;
vf.Name := 'Times New Roman';
vf.FullHeight := 50;
Bitmap.Canvas2D.fillStyle(BGRA(255,0,0,255));
vf.DrawTextRect(Bitmap.Canvas2D, 'Some text', 0,0);
vf.Free;
end;
Note that you should keep TBGRAVectorialFont in memory to avoid loading characters each time you draw text. As you can see, you must use a Canvas2D object. It means that you can apply any effect with the Canvas2D object.uses BGRAVectorize;
...
var img: TBGRABitmap;
begin
...
img.FontRenderer := TBGRAVectorizedFontRenderer.Create('.'); //define your directory here
var bmp: TBGRABitmap;
begin
...
bmp.FontRenderer := nil; //need to do that only if you switched to another renderer before that
end;
uses BGRAVectorize;
...
begin
bmp.FontRenderer := Bitmap.FontRenderer := TBGRAVectorizedFontRenderer.Create(ExtractFilePath(APath);
where APath is the directory of *.glyphs files.uses BGRAFreeType, LazFreeTypeFontCollection;
var FFreeTypeCollection : TFreeTypeFontCollection;
...
begin
//create font collection
FFreeTypeCollection := TFreeTypeFontCollection.Create;
FFreeTypeCollection.AddFolder(APath);
//use it in LazFreeType
SetDefaultFreeTypeFontCollection(FFreeTypeCollection);
//set the renderer
bmp := TBGRABitmap.Create(200,200);
bmp.FontRenderer := TBGRAFreeTypeFontRenderer.Create;
...
bmp.Free;
SetDefaultFreeTypeFontCollection(nil);
FFreeTypeCollection.Free;
end;
where APath is a directory containing *.ttf files.uses BGRABitmap, BGRABitmapTypes, BGRATextFX;
{ TForm1 }
procedure TForm1.FormPaint(Sender: TObject);
var bmp: TBGRABitmap;
renderer: TBGRATextEffectFontRenderer;
begin
bmp := TBGRABitmap.Create(ClientWidth,ClientHeight,BGRAWhite);
renderer := TBGRATextEffectFontRenderer.Create;
bmp.FontRenderer := renderer;
renderer.ShadowVisible := True;
renderer.OutlineVisible := True;
renderer.OutlineColor := CSSRed;
renderer.OuterOutlineOnly := True;
bmp.FontQuality:= fqFineAntialiasing;
bmp.TextOut(5,5,'Hello world',BGRABlack);
renderer.OutlineVisible := false;
bmp.TextOutAngle(5,25,-200, 'Hello world',CSSDarkGreen, taLeftJustify);
bmp.Draw(Canvas,0,0);
bmp.Free;
end;
uses BGRATransform;
var texture, destination: TBGRABitmap;
perspective : TBGRAPerspectiveScannerTransform;
quad: array of TPointF;
begin
...
quad := PointsF([ ... ]); //define 4 points here
perspective := TBGRAPerspectiveScannerTransform.Create(texture,[PointF(-0.5,-0.5),PointF(texture.Width-0.5,-0.5),
PointF(texture.Width-0.5,texture.Height-0.5),PointF(-0.5,texture.Height-0.5)],quad);
perspective.IncludeOppositePlane := False; //do not draw opposite plane
destination.FillRect(0,0,dest.Width,dest.Height,perspective,dmDrawWithTransparency);
perspective.Free;
Thankyou!I don't understand.
And please check this %)
http://lazarus.freepascal.org/index.php/topic,12411.msg115172.html#msg115172
Result := TBGRAMultiSliceScaling.Create(bmp, ini.ReadInteger(Section, 'MarginTop', 0),
ini.ReadInteger(Section, 'MarginRight', 0), ini.ReadInteger(Section,
'MarginBottom', 0), ini.ReadInteger(Section, 'MarginLeft', 0),
ini.ReadInteger(Section, 'NumberOfItems', 1), Direction, True);
8-)
uses BGRAFilters;
var task: TFilterTask;
begin
task := BGRAFilters.CreateMotionBlurTask(bitmap,bounds,distance,angle,oriented);
task.CheckShouldStop:= @MyCheckShouldStopFunc; //function to tell to stop the task
try
Result := task.Execute; //result may not be finished if the task has been stopped
finally
task.Free;
end;
end;
uses BGRABitmap, BGRABitmapTypes, BGRATypewriter;
procedure TForm1.FormPaint(Sender: TObject);
var bmp: TBGRABitmap;
begin
bmp := TBGRABitmap.Create(ClientWidth,ClientHeight,ColorToRGB(clBtnFace));
bmp.DrawPolygonAntialias(ComputeEasyBezier(
[PointF(10,10), PointF(50,10),PointF(90,50),PointF(90,100),PointF(20,100)],
True, 0.5), BGRABlack, 5);
bmp.Draw(Canvas,0,0);
bmp.Free;
end;
Fatal: Internal error 201001032On FPC 2.7.1 from SVN I get error in BGRABitmapTypes, line 2770 (IntersectLine):
Fatal: Internal error 2012090607
BTW: I want try BGRA Chart extension: http://wiki.freepascal.org/BGRABitmap_tutorial_TAChart but don't know where to download this packageIsn't it available in /components/tachart ?
We use the latest FPC 2.7.1Well, this trick doesn't work on Code Typhon 4.10 and BGRABitmap 7.1 so I moved back to 6.6.2 included with CT installator
SVN 10-03-2013 Rev 23788
We test this trick on :
Win32, Win64, Linux32, Linux64, FreeBSD32, FreeBSD64, Solaris32, Solaris64, WinCE, ArchLinux Arm, and Ubuntu Phone OS ...
Isn't it available in /components/tachart ?Thanks. Yes it is. But this package has little mess on Lazarus SVN 40461 (CodeTyphon 4.10). I have finally fixed it. Sternas Stefanos if you are here, you can add this fix to future version of CT:
I'm testing bgrabitmap extension for chart. I noticed two strange things.Probably a missing ColorToRGB function somewhere in the bgradrawer code.
First, Chart title property. I'm using BGRA GUI connector for drawing whole chart. If background have standard color like clRed or clBlue then it is ok, but with clForm or clBtnFace I get black background (see first attachment)
Second, 3D chocolate bars. They are drawing ok until I move X axis from left to right (mouse right click + move). They should disappear behind left edge but they are following my move (see screens before and after)I'm not sure I understand. I'll notify 'ask' about this.
I'ts hard to explain this behavior :)QuoteSecond, 3D chocolate bars. They are drawing ok until I move X axis from left to right (mouse right click + move). They should disappear behind left edge but they are following my move (see screens before and after)I'm not sure I understand. I'll notify 'ask' about this.
After this trick, I get another error (FPC 2.6.0):
BGRASSE line 232 "uknown identifer RBX"
{$ifdef xxxcpux86_64} assembler;
{ Move some data from one 64-bit register to another. }
{ This was just to verify that free pascal can indeed }
{ use 64-bit intel assembly language on linux. }
{$asmmode intel}
program asm64;
begin
asm
push rax
pop rbx
end
end.
{$asmmode intel}
line, you'll get the "unknown identifier" error.If you remove theFPC defaults to AT&T syntax for its inline assembler, please read the documentationCode: [Select]{$asmmode intel}
line, you'll get the "unknown identifier" error.
Hi, in BGRABitmapTypes is defined int32or64 and uint32or64. In systemh.inc there is already defined a solution for this NativeInt and NativeUInt, I think you should use this ones.You're right.
Also I've a question, there is a difference on speed using Single, Double or Extended for Real types between 32-64 bit platforms? http://freepascal.org/docs-html/ref/refsu6.html#x28-310003.1.2I suppose Single and Double are about the same speed, and faster than other types. It may depend on the processor of course.
QuoteAlso I've a question, there is a difference on speed using Single, Double or Extended for Real types between 32-64 bit platforms? http://freepascal.org/docs-html/ref/refsu6.html#x28-310003.1.2I suppose Single and Double are about the same speed, and faster than other types. It may depend on the processor of course.
Single also is smaller than Double and can be easily processed with SSE instructions.
E:\griensu\bgracontrols\bcfilters.pas(287,10) Error: identifier idents no member "InplaceGrayscale"
procedure ChangeLightness(ABitmap: TBGRABitmap; AFactor, AShift: single);
var n: integer;
p: PBGRAPixel;
ec: TExpandedPixel;
curLightness, newLightness: integer;
begin
p := ABitmap.Data;
for n := ABitmap.NbPixels-1 downto 0 do
begin
ec := GammaExpansion(p^);
curLightness:= GetLightness(ec);
newLightness:= round(curLightness*AFactor+AShift*65535);
if newLightness > 65535 then newLightness:= 65535;
ec := SetLightness(ec, newLightness, curLightness);
p^ := GammaCompression(ec);
inc(p);
end;
end;
if newLightness < 0 then newLightness := 0;
Form1.VuImage.Canvas.Pen.Color:=needle;
Form1.VuImage.Canvas.Pen.Width:=2;
Form1.VuImage.Canvas.Line(94, 94, y, z);
if VU_Settings.Active=3 then // Spectrum Analyser
begin
If VU_Settings.Placement=2 then YAxes:= Form1.Panel_VU.Height div 2;
If VU_Settings.Placement=3 then YAxes:= Form1.Panel_VU.Height-2;
If VU_Settings.Placement=1 then YAxes:= 2;
Form1.VuImage.Canvas.Pen.Width:=2; Form1.VuImage.Canvas.Pen.Color:=clHighlight;
Form1.VuImage.Canvas.Brush.Style:=bssolid; Form1.VuImage.Canvas.Brush.Color:=clBlack;
Form1.VuImage.Canvas.Rectangle(0,0,Form1.Panel_VU.Width,Form1.Panel_VU.Height);
For Counter:=0 to 117 do
begin
YValue:=round(MyThread.FFT[counter]*128); YValue2:=YValue;
Form1.VuImage.Canvas.Pen.Color:=clLime;
if VU_Settings.Placement=2 then
begin
if YValue>38 then YValue:=38;
Form1.VuImage.Canvas.Line(2+counter*2,YAxes+YValue,round(2+counter*2),YAxes-YValue);
if YValue2>60 then YValue2:=60;
Form1.VuImage.Canvas.Pen.Color:=clGreen;
Form1.VuImage.Canvas.Line(2+counter*2,YAxes+trunc(YValue2/1.8),2+counter*2,yAxes-trunc(YValue2/1.8));
If VU_Settings.ShowPeaks then
begin
Form1.VuImage.Canvas.Pixels[Counter*2+2,YAxes-YValue]:=clRed;
Form1.VuImage.Canvas.Pixels[Counter*2+3,YAxes-YValue]:=clRed;
end;
end;
if VU_Settings.Placement=3 then
begin
if YValue>41 then YValue:=41;
Form1.VuImage.Canvas.Line(2+counter*2,YAxes,2+counter*2,YAxes-round(YValue*1.8));
if YValue2>60 then YValue2:=60;
Form1.VuImage.Canvas.Pen.Color:=clGreen;
Form1.VuImage.Canvas.Line(2+counter*2,YAxes,2+counter*2,yAxes-trunc(YValue2));
If VU_Settings.ShowPeaks then
begin
Form1.VuImage.Canvas.Pixels[Counter*2+2,YAxes-round(YValue*1.8)]:=clRed;
Form1.VuImage.Canvas.Pixels[Counter*2+3,YAxes-round(YValue*1.8)]:=clRed;
end;
end;
if VU_Settings.Placement=1 then
begin
if YValue>40 then YValue:=40;
Form1.VuImage.Canvas.Line(2+counter*2,YAxes,2+counter*2,YAxes+round(YValue*1.8));
if YValue2>70 then YValue2:=70;
Form1.VuImage.Canvas.Pen.Color:=clGreen;
Form1.VuImage.Canvas.Line(2+counter*2,YAxes,2+counter*2,yAxes+trunc(YValue2));
If VU_Settings.ShowPeaks then
begin
Form1.VuImage.Canvas.Pixels[Counter*2+2,YAxes+round(YValue*1.8)]:=clRed;
Form1.VuImage.Canvas.Pixels[Counter*2+3,YAxes+round(YValue*1.8)]:=clRed;
end;
end;
end;
end;
{
// all pixels //
var
i: integer;
p: PBGRAPixel;
begin
p := Bitmap.Data;
for i := Bitmap.NBPixels-1 downto 0 do
begin
p^.red := ;
p^.green := ;
p^.blue := ;
p^.alpha := ;
Inc(p);
end;
// scan line //
var
x, y: integer;
p: PBGRAPixel;
begin
for y := 0 to Bitmap.Height - 1 do
begin
p := Bitmap.Scanline[y];
for x := 0 to Bitmap.Width - 1 do
begin
p^.red := ;
p^.green := ;
p^.blue := ;
p^.alpha := ;
Inc(p);
end;
end;
Bitmap.InvalidateBitmap;
}