In a picture, I want to draw a selection area with a circular shape. I used to draw rectangular shape but never dealt with any other. Is it possible to be done ? I am coding in Delphi
DrawFocusRect() supports rectangles only. For other shapes, you will have to manually draw them yourself as desired, such as with Ellipse() with an appropriate Brush and Pen.
To have similar appearance and behavior with DrawFocusRect(), use an alternating and XOR pen. E.g.:
var
Brush: TLogBrush;
begin
Brush.lbStyle := BS_SOLID;
Brush.lbColor := clBlack;
Canvas.Pen.Handle := ExtCreatePen(PS_COSMETIC or PS_ALTERNATE, 1, Brush, 0, nil);
Canvas.Pen.Style := psAlternate;
Canvas.Pen.Mode := pmNotXor;
Canvas.Brush.Style := bsClear;
Canvas.Ellipse(...
Related
I have a ViewPort3D element in a multi-device application form that being filled with a large number of TRectangle3D elements (anywhere from 1 to 10000) with LightMaterialSource applied to them, which all need to be rendered dynamically since I'm also rotating the camera using the following procedure:
procedure TForm3.Viewport3D1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
var
I: IViewport3D;
begin
if ssRight in shift then
begin
I:=ViewPort3D1;
with tdummy(I.CurrentCamera.Parent) do RotationAngle.X:=RotAng.X - Y;
with tdummy(I.CurrentCamera.Parent.Parent) do RotationAngle.Y:=RotAng.Y + X;
end;
end;
However the performance of the ViewPort3D begins to drop noticeably when the number of rectangles rendered approaches at least several dozen. The camera rotation gets slower and more unresponsive the more rectangles are added to the viewport up to the point of becoming a slideshow.
Is there a way to improve performance of the ViewPort3D without deleting said rectangles?
I've tried using setting the Multisample property to "none": ViewPort3d1.Context.SetMultisample(TMultisample.None) as well as removing MaterialSource from all the rectangles. While it did help a little with the performance, it didn't solve the problem entirely.
For 10k in my tests
Context.Draw/Fill.cube
Drawing in the render event is much more efficient, but the performance drops significantly when the camera angle is changed.
TRectangle3D Creating 10k pieces turns into serious performance problems after 2k created and showed on windows.
if visible=false is set after TRectangle3D create, rendering is completed at very high speed,
however, when visible=true, there is a serious performance degradation when the camera angle is changed.
As far as I can see, the reason for the slowdown is the operations on the CPU, that is, the gpu is not the part that slows down here, but when I examine the codes, there is a constant high amount of event type message notifications going to on mousemove to objects.
my suggestion is if a lot of visible objects are going to be used,
if objects are out of camera view, hide objects(visible=false), hide objects with a loop at each mousemove event, see if objects are in camera area or not, this will help performance.
There is not only 10k object problem here, it has many shortcomings.
basically this one can be used as a simple drawing 3d engine for simple jobs.
As far as I know, in Java, just like the viewport3d object, we can add the unity engine graphical window to a form in a java application,
I don't know if unity engine graphics window can be added to delphi,
u can request the support from embercadero, but for advanced graphics it would be more logical to use engines like unreal unity proffesional optimized engines.
Each high level fmx 3d object make a "drawcall." (wich reprocess all, from cpu (mesh preparation) to gpu (for diplay)
-> You always have to minimize drawcall count.
So, displaying 10000 FMX rectangles is never a solution. :)
You have to make only 1 Tmesh descendant, witch will draw your 10000 "hand-made" rectangles in one call.
Please see TMesh.Data (data.points and data.triangleindice) to undestand how to draw a 3d object in direct mode. Or, more simply, see how "TPlane" (in source) is built.
As a general plan, and as a basic "3d making" approach, making "complex" 3d FMX object is possible, but you have to deal with vertices/indexes to draw much possible things in one call.
As an exemple, here a is the code to realize it :
put TMesh on your viewport, and call this proc :
Procedure PopulateMesh_RectangleMap(aMesh : TMesh; const xCount : integer = 100; const yCount : integer=100; const rectWidth : single = 2.0; const rectHeight : single= 1.0);
var lv,li : integer;
lsx, lsy, xpos, ypos : single;
i,j : integer;
a,b,c,d : TPoint3d; //4 corner of a rect.
begin
Assert(assigned(aMesh));
lsx := rectWidth;
lsy := rectHeight;
li := 0;
lv := 0;
//mem. allocation.
aMesh.Data.Clear;
aMesh.Data.VertexBuffer.Length := 4 * xCount * yCount; //4 vertices by rect, need k*k rects.
aMesh.Data.IndexBuffer.Length := 6 * xCount * yCount; // 6 indices for 2 triangles desc (to make 1 rect) for k*k rects.
for i := 0 to xcount-1 do
for j := 0 to ycount-1 do begin
xpos := -xcount/2 + i + i*lsx;
ypos := -ycount/2 + j + j*lsy;
a := point3d(xpos - lsx/2,ypos - lsy/2,0);
b := point3d(xpos + lsx/2,ypos - lsy/2,0);
c := point3d(xpos + lsx/2,ypos + lsy/2,0);
d := point3d(xpos - lsx/2,ypos + lsy/2,0);
aMesh.Data.VertexBuffer.Vertices[li+0] := a;
aMesh.Data.VertexBuffer.Vertices[li+1] := b;
aMesh.Data.VertexBuffer.Vertices[li+2] := c;
aMesh.Data.VertexBuffer.Vertices[li+3] := d;
aMesh.Data.IndexBuffer.Indices[lv+0] := li+0;
aMesh.Data.IndexBuffer.Indices[lv+1] := li+1;
aMesh.Data.IndexBuffer.Indices[lv+2] := li+2;
aMesh.Data.IndexBuffer.Indices[lv+3] := li+2;
aMesh.Data.IndexBuffer.Indices[lv+4] := li+3;
aMesh.Data.IndexBuffer.Indices[lv+5] := li+0;
inc(li,4);
inc(lv,6);
end;
aMesh.Data.BoundingBoxNeedsUpdate; //We touch data. Update Mesh container.
aMesh.Width := lsx*3; //keep proportion.
aMesh.Height := lsy*3;
aMesh.Repaint;
end;
I have a DrawGrid with 600 x 600 Cells.
Each Cell gets painted with a color dependig on its Value.
Displaying the Grid needs ~1 second.
Question is: how can this be improved, so drawing needs less time?
The OnDrawCell Event looks like:
(MyVal is the Col/Row value and is taken from an 2 dimensional Array)
...
MyVal := MyArray[ACol, ARow];
case MyVal of
0: Drawgrid1.Canvas.brush.Color := clRed;
1: Drawgrid1.Canvas.brush.Color := clBlue;
...
end;
Drawgrid1.Canvas.Brush.Style := bsSolid;
Drawgrid1.Canvas.fillrect(Rect);
Thank you.
Klaus
everyone
I've been trying to solve the following problem in Delphi.
I want to make take an image and to make just one antialiased round corner.
I know how to make all 4 corners round by using RoundRect. However, I don't seem to figure out how to make just one.
I've been trying to solve the problem like this:
procedure RoundCorner(var image: TBitmap; w,h : integer);
//w - width of an image
//h - height of an image
//radius can be set at 150 (rounded rect radius)
// image is the timage object received as var parameter
var
i, j :integer;
x, y :double;
begin
i:= w - Trunc(radius);
x:= 0;
y:= radius - sqrt(sqr(radius) - sqr(x));
while(i < w) do
begin
j:=0;
while(j <= y) do
begin
image.Canvas.Pixels[i-1,j]:=clWhite; //a colour of your choosing or just erase this line
j := j + 1;
end;
y:= radius - sqrt(sqr(radius) - sqr(x));
x := x + 1;
i := i + 1;
end;
end;
This works, however I'm faced with 2 problems:
The corner is not antialiased
I want to fill the cut region with a different colour
Any suggestions are welcomed
Thanks.
First of all in your case "antialiasing" does mean that your image have to have a 32 bit pixel format in order to make a round transparent corner. Second thing is that you cannot access alpha channel via Canvas, you would need to access bitmap pixels directly via Scanline property or maybe to use a library like Graphics32 or AGG.
Another "modern" way to implement round corner is to use FMX and put the image inside a roundrect and clip it by the roundrect.
Is it possible to merge two or more different bmp-pictures of the same size into one by overlaying on top of each other? The same way it was done in Windows XP MS Paint: pasting one picture in another, with secondary color being transparent.
You can use Transparent property of TBitmap to that effect. Since your bitmaps have a black border, automatic transparent color (first pixel of image data) wouldn't work and you need to also set the TransparentColor property to 'clWhite'.
var
bmp1, bmp2: TBitmap;
begin
bmp1 := TBitmap.Create;
bmp1.LoadFromFile('...\test1.bmp');
bmp2 := TBitmap.Create;
bmp2.LoadFromFile('...\test2.bmp');
// bmp2.PixelFormat := pf24bit; // with 32 bit images I need this, don't know why
bmp2.Transparent := True;
bmp2.TransparentColor := clWhite;
bmp1.Canvas.Draw(0, 0, bmp2); // draw bmp2 over bmp1
// this is how the merged image looks like
Canvas.Draw(0, 0, bmp1);
..
In case of the second bitmap is black-and-white, you can use it as a mask in a raster operation with BitBlt ( bit-block transfer), as follows:
Windows.BitBlt(Bmp3.Canvas.Handle, 0, 0, Bmp3.Width, Bmp3.Height,
Bmp1.Canvas.Handle, 0, 0, SRCCOPY);
Windows.BitBlt(Bmp3.Canvas.Handle, 0, 0, Bmp3.Width, Bmp3.Height,
Bmp2.Canvas.Handle, 0, 0, SRCAND);
I want to draw quite complex images with alpha-transparent rectangles and alpha-transparent images.
There is GDI+ wrapper from Mitov, but it doesn't seem to support 32bit BMP files plus it rescales them and the documentation is terrible. BMPs are way faster than PNGs so I want to use them.
There is SynGDI wrapper of GDI+, but it seems very basic and there is no documentation for it.
There is also this trick for GDI:
procedure DrawAlphaAPI(Source: TBitmap; Destination: TCanvas;
const X, Y: Integer; const Opacity: Byte = 255);
var BlendFunc: TBlendFunction;
begin
BlendFunc.BlendOp := AC_SRC_OVER;
BlendFunc.BlendFlags := 0;
BlendFunc.SourceConstantAlpha := Opacity;
if Source.PixelFormat = pf32bit then
BlendFunc.AlphaFormat := AC_SRC_ALPHA
else
BlendFunc.AlphaFormat := 0;
Windows.AlphaBlend(Destination.Handle, X, Y, Source.Width, Source.Height,
Source.Canvas.Handle, 0, 0, Source.Width, Source.Height, BlendFunc);
end;
But when I call it with Opacity = 255 it draws 32bit bitmaps not properly (something like they are half transparent where they should be fully).
I don't want to use Scanline to make pixels transparent as this will be too complicated to draw all the transparent rectangles this way.
Also I thin GDI+ should be faster on modern computers, am I right?
So the question is: how to draw an alpha transparent rectangle and bitmap easily (without tons of code)?
Preferred Delphi: 7. I also have 2005 and XE3 but since 7 is a speed demon I would most want something to work from 7 up.
If you prepare the ordinary TBitmap, any of the GDI+ implementations can be used just assigning bmp.Canvas.Handle.
Your problem in compiling might be caused by an old DirctDraw-Version in the Folder, just remove it.
implementation
uses GDIPAPI, GDIPOBJ;
{$R *.dfm}
Procedure PrepareBMP(bmp: TBitmap; Width, Height: Integer);
var
p: Pointer;
begin
bmp.PixelFormat := pf32Bit;
bmp.Width := Width;
bmp.Height := Height;
bmp.HandleType := bmDIB;
bmp.ignorepalette := true;
bmp.alphaformat := afPremultiplied;
// clear all Scanlines
p := bmp.ScanLine[Height - 1];
ZeroMemory(p, Width * Height * 4);
end;
procedure TForm2.Button1Click(Sender: TObject);
var
bmp: TBitmap;
G: TGPGRaphics;
B: TGPSolidBrush;
begin
bmp := TBitmap.Create;
try
PrepareBMP(bmp, 300, 300);
G := TGPGRaphics.Create(bmp.Canvas.Handle);
B := TGPSolidBrush.Create(MakeColor(100, 255, 0, 0));
try
G.SetSmoothingMode(SmoothingModeHighQuality);
G.FillEllipse(B, MakeRect(0.0, 0, 300, 300));
B.SetColor(MakeColor(100, 0, 255, 128));
G.FillEllipse(B, MakeRect(40.0, 40, 260, 260));
finally
B.Free;
G.Free;
end;
// draw overlapping in Form Canvas to display transparency
Canvas.Draw(0, 0, bmp);
Canvas.Draw(100, 100, bmp);
finally
bmp.Free;
end;
end;