Delphi FireMonkey app can not draw simple black rectangle - delphi

Just create simple FireMokey HD app, put TImage with align=alclient on the form and trying to draw simple black rect:
procedure TForm8.FormCreate(Sender: TObject);
var
c: TCanvas;
begin
Image.Bitmap := TBitmap.Create(ClientWidth, ClientHeight);
c := Image.Bitmap.Canvas;
c.BeginScene;
try
c.Clear(claWhite);
c.Stroke.Color := claBlack;
c.Stroke.Kind := TBrushKind.bkSolid;
c.DrawRect(
TRectF.Create(7,7,ClientWidth-7,ClientHeight-7),
0,0,
[],
1
);
finally
c.EndScene;
end;
end;
And it doesn't work. Color of the rect is not black, it is kind of gray. There some changes of the color in corners. Did i need to set some other properties or what is wrong here ?
I tried different opacity values (1,100,255,65535), picture doesn't change at all and there is no information in the help what the hell this option means.
Zoomed left-top corner:
Also tried to use polygons as it described in example. Same problem - rounded corners and gray color instead of black (Opacity property of image is 1, all properties as by default):
procedure TForm8.Button2Click(Sender: TObject);
var
p1, p2, p3, p4, p5: TPointF;
MyPolygon: TPolygon;
begin
// sets the points that define the polygon
p1.Create(100, 100);
p2.Create(200, 100);
p3.Create(200, 200);
p4.Create(100, 200);
p5.Create(100, 100);
// creates the polygon
SetLength(MyPolygon, 5);
MyPolygon[0] := p1;
MyPolygon[1] := p2;
MyPolygon[2] := p3;
MyPolygon[3] := p4;
MyPolygon[4] := p5;
Image.Bitmap.Canvas.BeginScene;
// draws the polygon on the canvas
Image.Bitmap.Canvas.DrawPolygon(MyPolygon, 50);
Image.Bitmap.Canvas.EndScene;
// updates the bitmap
// Image.Bitmap.BitmapChanged;
end;

http://roman.yankovsky.me/?p=1018
if Canvas.BeginScene then
try
Canvas.Stroke.Thickness := 1.5;
Canvas.Stroke.Kind := TBrushKind.bkSolid;
Canvas.Fill.Color := TAlphaColorRec.Black;
Canvas.Fill.Kind := TBrushKind.bkSolid;
for I := 1 to 9 do
begin
Canvas.DrawLine(PointF(50 + I * 25 - (Canvas.Stroke.Thickness / 2), 0),
PointF(50 + I * 25 - (Canvas.Stroke.Thickness / 2), ClientHeight), 1);
end;
finally
Canvas.EndScene;
end;

This is easy to fix once you understand the better paradigm of Firemonkey. Firemonkey uses real coordinates, not integer coordinates. You unwittingly told it to draw lines that were centered the boundaries between pixels, so each of your lines were half in one set of pixels and half in another set of pixels.
Specifically, what happened is that your integer coordinates were interpreted as exact center points on a continuous number line. For example, say the point is 7. A line of width 1 centered on the point at 7.0 will extend from 6.5 to 7.5 on the number line. But because the pixels extend from 6.0 to 6.99 and from 7.0 to 7.99 on the number line, each pixel is half black and half white. Automatic antialiasing caused them to be drawn 50% black, which is where the two-pixel wide gray comes from.
When using FMX (now called FMX) you have to switch your thinking from integer coordinates to real coordinates, which is far more sophisticated and powerful.
The easiest solution is to move your integer-based math by 0.5 to the right and 0.5 down. Then a one-pixel wide line at 7.5 will extend from 7.0 to 7.999, which is what you were expecting. To do this, just add 0.5 to all your pixel coordinates, both horizontal and vertical, as you issue drawing commands.
The nice thing is, lines that are 0.8 pixels wide or 1.5 pixels wide will automatically appear thinner or thicker, respectively. Diagonal lines and other curves will appear correct without jagged edges. You can scale complex drawings and they will look perfect at any zoom level. (The math for the half-pixel shift stays the same for all zoom levels. The 0.5 is added after scaling immediately before drawing the line.)
The above is true for all devices: screens, bitmaps, and printers, etc. So the same code to draw on screen can be used to draw to everything else. When drawing text, you can use fractional point sizes for the fonts, so they scale with everything else.

Related

Fast crop .png images in Delphi

I don't know what to do here anymore, so I hope that somebody can help me.
I'm using Delphi 10.4 and Windows 10.
Basically, my problem is that cutting a part of the .png image with transparent background is to slow. I use scanline.
I have one background image (back.bmp) that is drawn on the form. That image can be also a .png (with no transparency) if that can help to solve this.
From the second image (frontsigns.bmp) I cat different parts and need to draw them to that background.
Old version of this program used .bmp as second image (with no transparent background) so that was very fast.
procedure TfrmMain.btnDrawBMPClick(Sender: TObject);
var
frontsigns : TBitmap;
begin
frontsigns := TBitmap.Create;
frontsigns.LoadFromFile('E:\frontsigns.bmp');
frmMain.Canvas.CopyRect(Rect(0,0,302,869), frontsigns.Canvas, Rect(0, yStartPos, 302, yEndPos)); // yStartPos and yEndPos are variables
end;
This draw part of the second image (303x870 px) on the background in the 0.415 ms. That is OK (probably can't be faster).
Now I need to use a second image with transparent backgrounds, so I use .png. Because I cut and draw different parts of the second image on the background my idea is that I use temp background image and draw part of the .png on that temp image and after that I draw it on the form.
Here is the code.
procedure TfrmMain.btnDrawBMPClick(Sender: TObject);
var
background, tmpbackground : TBitmap;
frontsigns, CroppedPng : TPngImage;
begin
background := TBitmap.Create;
background.LoadFromFile('E:\back.bmp');
frontsigns := TPngImage.Create;
frontsigns.LoadFromFile('E:\frontsigns.png');
tmpbackground := TBitmap.Create(303, 870);
tmpbackground.Canvas.CopyRect(Rect(0, 0, 302, 869), background.Canvas, Rect(0, 0, 302, 869));
CropPng(frontsigns, 0, yStartPos, 302, yEndPos, CroppedPng); // yStartPos and yEndPos are variables
tmpbackground.Canvas.Draw(0, 0, CroppedPng);
end;
This draw part of the second image (303x870 px) on the background in the 13.5 ms!!!!!!!
Reason is slow scanline I think. I should write here that frontsigns.png has only fully transparent background. There are not any semi-transparent pixels.
Here is my code for cropping .png images.
const
ColorTabMax = 10;
ColorTab : array[0..ColorTabMax-1] of TColor =
(ClBlack, ClMaroon, ClRed, ClWebDarkOrange, ClYellow, ClGreen, ClBlue, ClPurple, ClGray, ClWhite);
procedure CropPng(Source: TPngImage; Left, Top, Width, Height: Integer; out Target : TPngImage);
function ColorToTriple(Color: TColor): TRGBTriple;
begin
Color := ColorToRGB(Color);
Result.rgbtBlue := Color shr 16 and $FF;
Result.rgbtGreen := Color shr 8 and $FF;
Result.rgbtRed := Color and $FF;
end;
var
X, Y : Integer;
Bitmap : TBitmap;
BitmapLine : PRGBLine;
AlphaLineA, AlphaLineB : pngImage.PByteArray;
begin
if (Source.Width < (Left + Width)) or (Source.Height < (Top + Height)) then
raise Exception.Create('Invalid position/size');
Bitmap := TBitmap.Create;
try
Bitmap.Width := Width;
Bitmap.Height := Height;
Bitmap.PixelFormat := pf24bit;
for Y := 0 to Bitmap.Height - 1 do
begin
BitmapLine := Bitmap.Scanline[Y];
for X := 0 to Bitmap.Width - 1 do
BitmapLine^[X] := ColorToTriple(Source.Pixels[Left + X, Top + Y]);
end;
Target := TPngImage.Create;
Target.Assign(Bitmap);
if Source.Header.ColorType in [COLOR_GRAYSCALEALPHA, COLOR_RGBALPHA] then
begin
Target.CreateAlpha;
for Y := 0 to Target.Height - 1 do
begin
AlphaLineA := Source.AlphaScanline[Top + Y];
AlphaLineB := Target.AlphaScanline[Y];
for X := 0 to Target.Width - 1 do
AlphaLineB^[X] := AlphaLineA^[X + Left];
end;
end;
finally
Bitmap.Free;
end;
end;
I'm open for any ideas here. Can I make scanline works fatser? I don't have semi-transparent pixels so maybe I don't need to do all this.
I've tried with 32bit .bmp images with alpha channel, but haven't made it work with alphablend function.
I'me even open for third party libraries if there is no otehr option.
Thanks.....
In library PngComponents unit PngFunctions offers procedure SlicePNG, which allows to split a TPngImage into separate parts of equal size. As this has to be done only once it may significantly reduce the drawing time.
The problem with your approach is that you are reading your source image by accessing individual pixels using Source.Pixels and not using ScanLine
BitmapLine^[X] := ColorToTriple(Source.Pixels[Left + X, Top + Y]);
If you want to benefit properly by using ScanLine make sure you use ScanLine for both source and target images.
Also since your source and target images are both TPngImage you probably don't even need to create the temporary TBitmap.
And if color palettes of your PNG's match then you don't even need to do any color decoding/encoding but instead just copy data directly from one image to another. Of course you do need to make sure that color palette in your PNG's match each other in advance.
I remember reading about a tool that modifies a PNG's palette information to match with other files some years ago. Unfortunately I don't remember its name. I do remember reading about it in an article about creating of PNG based image atlases for games.
Here is my current progress thank you to the SilverWariors answer. I've just implemented first tip for now.
I was using information from:
https://delphi.cjcsoft.net/viewthread.php?tid=48996
https://en.wikipedia.org/wiki/BMP_file_format
I've replaced:
BitmapLine^[X] := ColorToTriple(Source.Pixels[Left + X, Top + Y]);
with:
BitmapLine^[X] := GetPixel(source, Left + X, Top + Y);
GetPixel function is bellow.
function GetPixel(Source: TPngImage; X, Y: Integer): TRGBTriple;
var
LineSource : pngImage.PByteArray;
begin
LineSource := Source.Scanline[y];
// Get blue value - stored in lowest order byte in a TColor
Result.rgbtBlue := PByteArray(LineSource)^[(x*3)+0];
// Get Green value - second lowest byte in TColor
Result.rgbtGreen := PByteArray(LineSource)^[(x*3)+1];
// Get Red value - third lowest byte in TColor
Result.rgbtRed := PByteArray(LineSource)^[(x*3)+2];
end;
I'm not sure why the color order is like this and not like in the article on the link above. Maybe because .png file is 32bit.
With this change I've decreased time from 13.5 ms to 6.44 ms. That is great, but I think it can be even much better.
Here is where is I see potential improvement.
Now I scan every line two times. One for the RGB colors and one for for ALPA information.
AlphaLineA := Source.AlphaScanline[Top + Y];
I think that I can get ALPHA info from scanline if I scanline returns all four bytes in a 32bit image. I'm I correct?
Maybe something like:
PByteArray(LineSource)^[(x*3)+3];
Another idea is that I can directly write to the final background. Now I cut part of the .png image and draw it on the background at the end. I must use draw because transparency that .png image that I got as result of croping original image will be lost if I use CopyRect.
But If I draw pixels directly to the background (that has ALPHA 255) that would be much faster. Maybe I can avoid that because the background is 32bit .bmp (it can be 32bit .png) without any transparency (ALPHA is 255 for all bits). Also ALPHA for .png that I'm cutting of can be only 255 (not transparent) and 0 (fully transparent).
I'm not sure how I can accomplish this.

FMX: Strange glitch with TCanvas.DrawPath. Why?

I draw a path consisting of 2 lines going up and then back down to the same spot, or almost the same spot, but the first line is drawn too high. If I then draw the same lines using DrawLine I don't see the issue. Why is this happening?
Below is an example. Just drop a 400x400 TImage on a blank multiplatform form. The code draws 2 red paths, one with close to a 180 degree angle between the lines and one with less of an angle. The same lines are then drawn using DrawLine in blue. If the DrawPath function works correctly then the blue lines should completely cover the red lines, but they don't. In this example with a scale of 1.5 the path extends 7 pixels too high for the first path. The extent of the error reduces as the lines get further apart. The issue still happens with a scale of 1, but is less obvious.
procedure TForm1.FormActivate(Sender: TObject);
var
LPath1, LPath2 : TPathData;
i : Integer;
begin
// A path of 2 lines going up and then back down to almost the same spot
LPath1 := TPathData.Create;
LPath1.MoveTo(PointF(100,200));
LPath1.LineTo(PointF(100,50 ));
LPath1.LineTo(PointF(105,200));
// A path of 2 lines going up and then back down at a wider angle
LPath2 := TPathData.Create;
LPath2.MoveTo(PointF(200,200));
LPath2.LineTo(PointF(200,50 ));
LPath2.LineTo(PointF(260,200));
Image1.Bitmap.BitmapScale := 1.5; // The issue shows up more at larger scales
Image1.Bitmap.SetSize(Trunc(Image1.Width), Trunc(Image1.Height));
with Image1.Bitmap.Canvas do if BeginScene then begin
Clear(TAlphaColorRec.White);
// Draw the paths using DrawPath in red
Stroke.Color := TAlphaColorRec.Red;
Stroke.Thickness := 1;
DrawPath(LPath1, 1);
DrawPath(LPath2, 1);
// Draw the paths using DrawLine in blue over the top
// The red lines should be completely hidden under the blue
Stroke.Color := TAlphaColorRec.Blue;
for i := 1 to LPath1.Count - 1 do
DrawLine(LPath1.Points[i-1].Point, LPath1.Points[i].Point, 1);
for i := 1 to LPath2.Count - 1 do
DrawLine(LPath2.Points[i-1].Point, LPath2.Points[i].Point, 1);
EndScene;
end;
LPath1.Free;
LPath2.Free;
Image1.Bitmap.SaveToFile('test.png');
end;
Result of the code when run in Windows 10. I'm using Delphi 11, but the same issue happens with Delphi 10. I've tried switching GPU but the same issue occurs.
Enlarged view:
I've come to the conclusion that this isn't a glitch at all. It's because the default setting of TCanvas.Stroke.Join is TStrokeJoin.Miter. The artefact seen is just the sharp spike of the mitred corner. Using MoveTo before each line segment when constructing the path does solve the issue (because there's no join between the separate line segments) but so does setting the TCanvas.Stroke.Join parameter to TStrokeJoin.Round or TStrokeJoin.Bevel.
Note that at very sharp angles approaching 180 degrees, the miter join would become infinite. However, it appears to be limited somehow, perhaps in proportion to the stroke thickness. I don't think there's a way to change this miter limit in delphi.
This is because by default TPath is making smooth transitions between different path segments. I'm guessing it might be using Quadratic interpolation for making these smooth transitions.
Yes making smooth transition between two lines doesn't seem logical but it looks this is how it is implemented.
Now you can avoid this by telling the TPath that your two lines are not connected and thus should be treated as two separate lines even thou in reality they are connected. And you can do this by simply calling Path.MoveTo which is intended to shift position so you can create another unconnected line that dos not continue from your last path point.
Here is how modified code for your first sharp cornered line would look like:
NOTE that I'm specifying the exact same position for MoveTo command that was used for rendering of previous path line since you don't want the new line to start at new position.
// A path of 2 lines going up and then back down to almost the same spot
LPath1 := TPathData.Create;
LPath1.MoveTo(PointF(100,200));
LPath1.LineTo(PointF(100,50 ));
//Add move to command to prevent Path from trying to make smooth transitions between two lines
LPath1.MoveTo(PointF(100,50));
LPath1.LineTo(PointF(105,200));

Need guidance on drawing PNGs into a Delphi XE6 TDrawGrid

I'm using a drawgrid to display a "dungeon" map. I have an array filled with data describing what types of physical features are located in each cell. The basic layout of rooms and corridors, etc. There's a PNG for each permutation.
I'm trying to "draw" the map by drawing the appropriate PNG into each cell of the drawgrid. I can do it more or less directly using DrawGrid1.Canvas.Draw(x,y,pngImage), but figuring out the exact x,y in pixels is frustrating because of the gridlines (at least, I'm finding it frustrating), and I'm not sure what other issues I'll run into down the road.
I also tried pngImage.Draw(DrawGrid1.Canvas,Rect), but once again, I have to calculate the Rect, which really seems unnecessary as the cells and PNGs are all 40x40 pixels.
Reading related articles and examples, OnDrawCell seems to be a better way, because given ARow and ACol, the Rect for the given cell is apparently precalculated (unless I'm misinterpreting what I've read in several places). But none of the examples I've found actually show how OnDrawCell is triggered. The easy answer "when something gets drawn into a cell" doesn't really explain it much better. That's what I'm trying to do.
(I've often found this to be the case with Delphi's documentation: How is explained (not always exactly for your given use case), but when or why is left shrouded in mystery..)
Of course, there are a few other things to figure out as well, like controlling the drawgrid so it doesn't erase the PNG when a cell is clicked..
Any relevant suggestions will be greatly appreciated. TFRM
Why is figuring out exact X and Y in pixels so hard? It is actually pretty simple.
In order to get left border of your rectangle you simply multiply width of you column plus width of your gridline by number of the column. And if you have gridline on the very left of the first column then add the width of your gridline.
And in order to get right border of your rectangle simply add width of the column to the previous result.
And for calculating Y you just use height instead of width
So the code would look something like this (written from my mind and untested)
const
CellWidth = 40;
CellHeight = 40;
GridLineThickness = 1;
procedure DrawCell(Row, Column: Integer; Image: Bitmap);
var Rect: TRect;
begin
Rect.Left := ((CellWidth + GridLineThickness) * Column) + GridLineThickness;
Rect.Right := Rect.Left + CellWidth;
Rect.Top := ((CellHeight + GridLineThickness) * Row) + GridLineThickness;
Rect.Bottom := Rect.Top + CellHeight;
PaintBox1.Canvas.StretchDraw(Rect, Image);
end;
And if you want an ability to zoom in or zoom out just multiply the CellWidth and CellHeight by a zoom factor. And when being zoomed out a lot just omit rendering grid lines.

Converting Delphi TPoint to C# Point

I am trying to convert some Delphi code as we are re-writing a Delphi 6.0 (VCL) application in .Net. I am not sure and could not figure out the comparison between 2 Delphi Tpoints(x,y) with that of C# Point(x,y).
I am trying to draw a line between 2 points but since I have no idea how Delphi draws it, I am not able to set the C# coordinates for it.
The Delphi code is simple:
Canvas.MoveTo(x, y - 128);
Canvas.LineTo(x, y);
I know about the C# coordinates though about 72 Points per inch and need to calculate the pixel density. But I am not sure about the Delphi PPI.
Any would be appreciated. Thanks.
Edit: If someone is wondering what TPoint I am talking when there is none in my code snippet, Canvas.MoveTo sets the PenPos property of the canvas which is of type TPoint.
I'm not sure what the exact question is that's being asked here. You have no Delphi TPoint in your code snippet; you simply have client rect logical coordinates.
The origin is at X = 0, Y = 0, which is the top left corner of the client area. Increasing X moves the position to the right, and increasing Y moves the position down. Logical units are pixels, so starting at the origin of 0, 0, a Canvas.MoveTo(10, 10) would set the new drawing position in from the left edge 10 pixels and down from the top 10 pixels, and a Canvas.LineTo(20, 20) from there would draw a line from the point at 10, 10 to 20, 20.
TCanvas.MoveTo and TCanvas.LineTo are simply wrappers around the underlying Windows GDI functions MoveToEx (with an always NULL third parameter) and LineTo.
As far as the C# equivalent, if you're referring to System.Drawing.Point, the units used are exactly the same (although I'm not sure where the origin is based by default). Given an origin of 0, 0, System.Drawing.Point(10, 10) should be the same position described above - 10 pixels from the left edge and 10 pixels down from the top edge.
A quick check confirms that the origin in a WinForms application is in fact the top left corner of the client area, using:
// Delphi code
procedure TForm3.FormPaint(Sender: TObject);
begin
Canvas.Pen.Color := clRed;
Canvas.MoveTo(0, 0);
Canvas.LineTo(100, 100);
end;
// C# code
private void Form1_Paint(object sender, PaintEventArgs e)
{
Pen newPen = new System.Drawing.Pen(Color.Red);
e.Graphics.DrawLine(newPen, new Point(0, 0), new Point(100, 100));
}
This produces the following output:

How do I StretchDraw two graphics beside each other on a custom TGraphicControl?

I'm writing my Delphi TGraphicControl paint procedure.
I create a canvas and I stretchdraw it onto the graphic area. It works well.
Then I repeat this with another Stretchdraw onto the graphic area but it is drawn in the area of the first Stretchdraw and not onto the graphic area as I direct it.
Is there a way that can place both stretchdraws beside each other in the TGraphicControl's canvas?
TCanvas.StretchDraw paints a graphic onto a canvas in a given rectangular area. The rectangle should, but does not need to be, within the bounds of the canvas. The owner of the canvas determines those bounds. In your case, it sounds like the canvas owner is the TGraphicControl object.
If you want two graphics to be painted beside each other, then the TRect you use to draw the first graphic should represent a rectangle that is adjacent to the TRect you use for the second graphic. You haven't shown any code yet, so it's hard to tell what's going wrong.
If you use the same TRect variable for both calls to StretchDraw, then you need to make sure you modify the rectangle's position between the calls — change the Left property, for starters.
For example:
var
r: TRect;
begin
r := ClientRect;
// First rectangle takes up left half of control
r.Right := r.Right div 2;
Canvas.StretchDraw(r, graphic1);
// Shift the rectangle to the right half
r.Left := r.Right;
r.Right := ClientRect.Right;
Canvas.StretchDraw(r, graphic2);
end;

Resources