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));
Related
I want to take a screenshot of my page and put the result into a bitmap, Because there is a scrollbar on the page, i have to take several screenshots, and i want to merge those bitmaps.
if have used this code to make a screenshot and save it: Take a screenshot of a particular area in Delphi 7
i used the code to merge them from this page http://www.delphigroups.info/2/8/309463.html
if i copied it directly it would result in the first image being used, and i white rectangle for the second. so i tried to change it a little bit, and now i'm getting both images in one file.
This is the code i use to concatenate the bitmaps:
function ConcatenateBitmaps(const MainBitmap: TBitmap; const BitmapToAdd:
TBitmap): TBitmap;
begin
Result := MainBitmap;
If BitmapToAdd.Width > MainBitmap.Width then
Result.Width := BitmapToAdd.Width;
Result.Height := MainBitmap.Height + MainBitmap.Height;
Result.Canvas.CopyRect(
Rect(0,MainBitmap.Height,BitmapToAdd.Width,BitmapToAdd.Height),
BitmapToAdd.Canvas,
Rect(0,0,BitmapToAdd.Width,BitmapToAdd.Height)
);
end;
The problem is that te second image is being flipped, vertical and horizontal;
What am i doing wrong here?
EDIT:
An example of the result, the first image is good, the second image is flipped:
as i see now, my description was wrong, it's horizontaly mirrored, and verticaly flipped
Cause and quickfix:
The problem is in this part:
Rect(0,MainBitmap.Height,BitmapToAdd.Width,BitmapToAdd.Height)
You make a rectangle of which the top is the total height of the resulting image, and the bottom is the height of the bitmap to add. So this rectangle is basically inverted (its bottom is above its top).
And it's likely deformed as well, since the height of this rectangle is not the height of the bitmap to add.
The quickfix would be:
Rect(0,Result.Height- BitmapToAdd.Height,BitmapToAdd.Width,Result.Height)
Other issues and confusion:
But I think the cause of your confusion is because you think that Result and MainBitmap are two different bitmaps, while actually they are both references to the same bitmap. The assignment you do in the beginning just copies the reference, not the actual TBitmap object.
In addition, you mix up 'height' and 'bottom'. TRect expects you to set top and bottom coordinates, not top and height. This, together with the previous issue, causes not only that the bitmap is upside down, but also that it will be stretched, and partially covering the previous images. The more images you add, the more clear that effect will be.
Personally I think it's way more efficient to modify the existing bitmap in this scenario, mainly because you would otherwise have to clean up your old bitmap all the time, plus that you have a function that magically creates bitmaps. You get the question of ownership of the bitmap objects, and with that, the risk of memory leaks, which is not good, especially when dealing with large bitmaps.
My suggested version:
So, I would just make it a procedure, where the first bitmap is modified by adding the second bitmap to it.
In the version below, I also used Canvas.ClipRect, which is for a bitmap essentially the bounding rectangle of the bitmap. And then I used OffsetRect to 'move' this rectangle(increasing its top Y and bottom Y).
By doing this in a separate variable, you can have a relatively clean version compared to the quick fix I presented above, because you can use the dimensions of MainBitmap before actually modifying it.
procedure AppendBitmap(const MainBitmap: TBitmap; const BitmapToAdd:
TBitmap);
var
TargetRect: TRect;
begin
// Widen the main bitmap if needed
if BitmapToAdd.Width > MainBitmap.Width then
MainBitmap.Width := BitmapToAdd.Width;
// Set TargetRect to the right size
TargetRect := BitmapToAdd.Canvas.ClipRect;
// And then to the right position
OffsetRect(TargetRect, 0, MainBitmap.Height);
// Make room for the bitmap to add
MainBitmap.Height := MainBitmap.Height + BitmapToAdd.Height;
// Draw it in the created space
MainBitmap.Canvas.CopyRect(
TargetRect,
BitmapToAdd.Canvas,
BitmapToAdd.Canvas.ClipRect
);
end;
And if you like, you can make a wrapper function with the signature of the original, that creates a copy of the main image and returns that. Note though, that MainBitmap and the result of this function are no longer the same bitmap, and you have to make sure to properly free both of them when you're done.
function ConcatenateBitmaps(const MainBitmap: TBitmap; const BitmapToAdd:
TBitmap): TBitmap;
begin
Result := TBitmap.Create;
Result.Assign(MainBitmap);
AppendBitmap(Result, BitmapToAdd);
end;
PS: I like questions like this from which I learn something. I never realized you could flip an image by flipping the rect passed to CopyRect. :D
I am having a strange problem, and I do not think I can solve it.
I have an ImgView containing layers (transparent png images) and I intend to save all the layers as png files (like a "Save Project" thing), so that later on I can re-open them and place them where I left them. (like an "Open Project" thing)
This is my problem, following steps work just fine:
I add layers (transparent PNG files)
I move them around and place them where I want them
I press save project (so here I save all layers as png image files)
It works
If I do the next following steps, something goes wrong:
I add layers (transparent PNG files)
I move them around and place them where I want them
I change the location of the layers (as in: send to back one layer for example) (so this step is different)
I press save project (so here I save all layers as png image files)
It crashes with "Access violation at address 005380FB in module 'MyApp.exe'. Read of address 000000C0"
Right now it only gives me the above error, but a few runs ago, it pointed me to this line:
procedure TCustomBitmap32.ResetAlpha(const AlphaValue: Byte);
var
I: Integer;
P: PByteArray;
begin
if not FMeasuringMode then <<<<<------ this line
So if I change the index of layers... I cannot save them anymore as PNG ?!?!?!
Here is my save procedure:
for i:=0 to mainForm.ImgView.Layers.Count-2 do
begin
mylay := TBitmapLayer(mainForm.ImgView.Layers.Items[i]);
SaveBMPAsPng(mylay.Bitmap,'C:\MyApp\tmp\'+getLayerPan(i)+'.png');
end;
// where getLayerPan is a function that retrieves a name that I gave to the layer
... and
procedure SaveBmpAsPng(bmp:TBitmap32;dest:string);
var
Y: Integer;
X: Integer;
Png: TPortableNetworkGraphic32;
function IsWhite(Color32: TColor32): Boolean;
begin
Result:= (TColor32Entry(Color32).B = 255) and
(TColor32Entry(Color32).G = 255) and
(TColor32Entry(Color32).R = 255);
end;
begin
bmp.ResetAlpha;
for Y := 0 to bmp.Height-1 do
for X := 0 to bmp.Width-1 do
begin
if IsWhite(bmp.Pixel[X, Y]) then
bmp.Pixel[X,Y]:=Color32(255,255,255,0);
end;
Png:= TPortableNetworkGraphic32.Create;
Png.Assign(bmp);
Png.SaveToFile(dest);
Png.Free;
end;
What could be wrong?
Please help...
EDIT
I think I discovered my problem...
When I move the layers around, the only way (that I know of) to do it clean, is to load all layers into an imagelist (TBitmap32List was my choice at that moment) and after that clean the layers and re-add them from the imagelist to my ImageView in the desired order.
I can only assume that this is where something goes wrong.
It must be because in the layers I have transparent PNGs, and when I load them into the Bitmap32List, I load them as BMPs.
I must look for another way of reorganizing my layers before going any further. I will update you with my solution. If any of you know of a better way of reordering layers in ImageView32, please let me know.
EDIT
So, please observe in the image bellow that the GUI is done, and working. I have the panels representing the layers, I can move them around (as you may see in the image I am dragging layer 'Elementul 0' and movin it up in the chain).
And I repeat, my logic also works when I use temporary files for moving layers up or down in the order. One of the answers suggested that I should just use the Index property to change a layers position in the layers hierarchy, and I am saying that it cannot be done without at least adding new layers to the image. So this is not a double question. It is just a response to one of the answers I received.
Thank you
Your problem is a lot simpler than you might think. Working with layers comes natural:
Send to back
Set the layer's index to 0 or simply call SendToBack. All layers previously before it will have their index increased by 1. All layers previously after it remain at the same position.
Send backward
Decrease the layer's index by 1. The layer previously before it will now come after it, thus has its index increased by one.
Send forward
Increase the layer's index by 1. The layer previously after it will now come before it, thus has its index decreased by one.
Send to front
Set the layer's index to the number of layers minus 1. The layers previously after it have their increased decreased by one.
Hence there is absolutely no need to touch the bitmap, save to disk it to disk, or use any kind of temporary layers to change the order. In virtually every case, the right thing happens when you just set the index of the layer to the position (counting from 0, back to front) you want it to appear at. After moving a panel in your list, you could set the corresponding layer's index to the new index of the panel in the list. However, because the panel is ordered front to back and GR32 orders back to front, you need to translate the index of the panel to the desired index of the layer.
Here's an example how to do that with a TListBox and a TButton:
procedure TForm1.SendBackwardButtonClick(Sender: TObject);
var
LNewListBoxItemIndex: Integer;
begin
// Calculate the new list index and make sure it's valid
LNewListBoxItemIndex := Max(0, Min(ListBox1.ItemIndex + 1, ListBox1.Items.Count - 1));
// Transform the current and new list indices and use them to move the layer
ImgView321.Layers[ListBox1.Items.Count - 1 - ListBox1.ItemIndex].Index :=
ListBox1.Items.Count - 1 - LNewListBoxItemIndex;
// Move the list item
ListBox1.Items.Move(ListBox1.ItemIndex, LNewListBoxItemIndex);
// Preserve the selection (if applicable)
ListBox1.ItemIndex := LNewListBoxItemIndex;
end;
You may also decide to fully synchronize the list with the layers. In that case you should associate each item (possibly TPanel) with a layer.
// Create layers from front to back
LLayer := TBitmapLayer.Create(ImgView321.Layers);
ListBox1.Items.AddObject('First layer', LLayer);
// Could use LPanel := TPanel.Create(...); LPanel.Tag := Integer(Pointer(LLayer)) instead
LLayer := TBitmapLayer.Create(ImgView321.Layers);
ListBox1.Items.AddObject('Second layer', LLayer);
// Now the list is correct but the layers are not in the right order.
// Use the code listed below whenever you need to synchronize the layers
// with the list. In theory it may be slow (O(n^2)) but practically it
// won't matter much assuming you won't have hundreds of layers.
// Don't update the screen every time we move a layer to get closer to the final result
ImgView321.BeginUpdate;
try
for LIndex := 0 to ListBox1.Items.Count - 1 do
// Get the associated layer and make it the least visible of all processed so far
TCustomLayer(ListBox1.Items.Objects[LIndex]).SendToBack;
// Could use TCustomLayer(Pointer(SomePanel.Tag)).SendToBack instead
finally
// Always do this not to have strange behavior after an error
ImgView321.EndUpdate;
end;
// When it's done, update the screen
ImgView321.Changed;
By your description of how you changed the order of the layers, it is most likely the reason for your problem. Since you did not post that part of the code it can not be assessed with certainty.
Anyway, to rearrange the layers, you can use the Index property of TCustomLayer (of which TBitmapLayer is a descendant)
So the solution to the problem is to NOT use a Bitmap32List as a temporary container for png layers when reordering layers, because something gets lost in the process.
So try other solution for reordering. My curent solution is to drop the layers as PNG files to the disk, then reload them from the disk in the desired order.
Another solution (untested yet) would be to create a number of new layers, equal to the number of existing layers, move actual layers there, then get them back one by one in the desired order, and then remove the extra layers.
Anyway. That was the question, and this is the answer so far
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.
I have 1 bitmap object witdh : 1024px and height : 768 px
I want to cut this bitmap object to 2 part like left and right but I don't want to use DrawBitmap method in canvas because this method can use more CPU then CopyMemory.
I don't want to use this method ( leftImg.Canvas.DrawBitmap(MainBmp, RectF(0,0, MainBmp.Width div 2, bmp.Height),
RectF(0,0, leftImg.Width, leftImg.Height), 1, True); )
MainBmp := TBitmap.Create(1024, 768);
leftImg := TBitmap.Create(MainBmp.Width div 2, MainBmp.Height);
rightImg := TBitmap.Create(MainBmp.Width div 2, MainBmp.Height);
leftBits := PAlphaColorArray(leftImg.Scanline[0]);
CopyMemory(#leftBits[0], #MainBmp.StartLine[0], (MainBmp.Width div 2) * bmp.Height);
if I am doing like this he can copy but not left part of bitmap :( he copy half of top to bottom.
That drawing is exactly what I want to do.
After cut procces, i need like this without using any loop (like while or for)
Thanks
No can do! As you've found out image data is layout in the memory line by line (hence scanline). What you want could only be possible if it was column by column. Without any loops this is not possible.
As you noticed, a scanline is a row of pixels, from left to right. There is one scanline for each pixel of vertical height in the image.
Your 1024px x 768px images have 768 scanlines. Copying the first half of the data from scanlines yields you the top half of the image.
You wouldn't have to go through every pixel, you can skip ahead since everything is indexed.
However, since you want both halves, you're not wasting any work by going through the whole thing. As you iterate through the data, copy both the left and right parts out at the same time. So, for the first scanline, copy the first half of pixels to the left image and the rest of the pixels to the right image, go to the next line, and repeat.
This should be less work than DrawBitmap twice.
Also, rather than loading the image, displaying it, then splitting it, split it while you're loading the image.
You'll still need a loop, unless you want to write everything 768 times.
Technically, you could rotate the image and do it the way you want, but rotating it would require loops too, and you'd have to rotate it back when you're done.
Use the TCanvas.CopyRect() method to copy portions of one TCanvas to another TCanvas. It allows the two bitmaps to have different pixel formats. The OS will handle the differences internally for you:
MainBmp := TBitmap.Create(1024, 768);
leftImg := TBitmap.Create(MainBmp.Width div 2, MainBmp.Height);
rightImg := TBitmap.Create(MainBmp.Width div 2, MainBmp.Height);
leftImg.Canvas.CopyRect(
Rect(0, 0, leftImg.Width, leftImg.Height),
MainBmp.Canvas,
Rect(0, 0, leftImg.Width, leftImg.Height)
);
rightImg.Canvas.CopyRect(
Rect(0, 0, rightImg.Width, rightImg.Height),
MainBmp.Canvas,
Rect(leftBmp.Width, 0, rightImg.Width, rightImg.Height)
);
I am working with delphi. I have an array of points which are continues as shown in image.
Then I give this array to CreatePolygonRgn and create the region say rgn1.
rgn1 := CreatePolygonRgn(tmpary1[0],Count,WINDING);
Then I fill the region and show it on my TImage control as shown in image. The problem is from the left side, the points are also covered in region but from right side the points of array are not covered. This can be seen in image that from left side green border is not shown but from right side border is visible. Am I mistaking somewhere??? If my question is not clear to you then please ask.
Thank You.
Edit:
for cnt := 0 to Count - 1 do begin
p1 := imgmain.Picture.Bitmap.ScanLine[tmpary[cnt].Y];
p1[tmpary[cnt].X].rgbtBlue := 0;
p1[tmpary[cnt].X].rgbtGreen := 255;
p1[tmpary[cnt].X].rgbtRed := 0;
end;
rgn1 := CreatePolygonRgn(tmpary1[0],tmpseq1.Count,WINDING);
imgmain.Picture.Bitmap.Canvas.Brush.Color := clRed;
FillRgn(imgmain.Picture.Bitmap.Canvas.Handle,rgn1,imgmain.Picture.Bitmap.Canvas.Brush.Handle);
It may just be the way it works. FillRect, for example, includes the left and top borders, but excludes the right and bottom borders of the rectangle.
I think the same probably applies to FillRgn.
Edit: Confirmed here, too.
At last I found the feasible solution to my problem and also the solution of this problem as both question are related to each other.
I was filling the region and then tried to get boundary of that region. I was getting some points of original array as boundary and some points were actual boundary points. I wanted all points of actual boundary.
So, now I fill the region with red color then fill the pixels of array with red color and then I run floodfill algorithm. It will give all points I needed.