I am using Stretched=True on a TImage with a 256x256 bitmap. This gets scaled down by 1,2,4 or 8. As expected, text on the bitmap gets more horrible the more I depart from '1'.
I notice though that Windows 7 explorer renders a scaled down version of the bitmap 'softer' and more pleasing. Is it possible to 'blur' a TBitmap in this way?
I suppose you mean Stretched = True on a TImage, not on A TBitmap.
Unfortunately TImage has no resamplers built in, when it comes to resizing images in it.
My recommendation would be to use Graphics32 as it supports a variety of resamplers (some are better for increasing size others for reducing size)
By using the HALFTONE StretchBltMode, you will get smoother results than the normal stretchdraw.
This will only work in windows 2000 and later
procedure SmoothResize();
var pt:TPoint;
h: HDC;
begin
h := imgMainPicture.Canvas.Handle;
// Previous call to StretchDraw
// imgMainPicture.Canvas.StretchDraw(Rect(0, 0, imgMainPicture.Width - 1,
// imgMainPicture.Height - 1), curPicture.AnnotatedBitmap);
// Normal StretchDraw uses STRETCH_DELETESCANS as StretchBltMode , HALFTONE should give better results
GetBrushOrgEx(h, pt);
SetStretchBltMode(h, HALFTONE);
SetBrushOrgEx(h, pt.x, pt.y, #pt);
StretchBlt(h, 0, 0, imgMainPicture.Width - 1,
imgMainPicture.Height - 1, curPicture.AnnotatedBitmap.Canvas.Handle,
0, 0, curPicture.Width,curPicture.Height,SRCCOPY);
end;
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 trying to make a kind of bitmap editor so I just want to draw a line on a bitmap with no anti-aliasing effect in Firemonkey. Something like this:
var
Bmp: TBitmap;
Bmp := TBitmap.Create(2000, 2000);
if (Bmp.Canvas.BeginScene) then
begin
Bmp.Canvas.Stroke.Color := TAlphaColors.Aquamarine;
Bmp.Canvas.DrawLine(PointF(5, 5), PointF(100, 100), 1);
Bmp.Canvas.EndScene;
Bmp.SaveToFile('c:\temp\result.bmp');
end;
FreeAndNil(Bmp);
But it doesn't work. I am trying for a while with several ideas with no luck:
Using Map/Unmap to access the bitmap data directly is very slow with big bitmaps according to my coworkers.
Using a TImage with DisableInterpolation=true and even GlobalUseGPUCanvas=False doesn't work.
Using a TPaintBox component doesn't fit our needs.
The solution would be the use of Canvas.Quality=HighPerformance but it's a read-only property. I tried to change the bitmap Canvas.Quality in different ways but it doesn't work.
So how can I simply draw a line with no anti-aliasing effect at all in Firemonkey?
PS: I am using Delphi 10.2.3 (Tokyo)
Finally I found a way to do this. It's so simple that I am wondering if there is some hidden poison in the solution (LOL). TCanvasManager allows the creation of a HighPerformance Canvas from a given bitmap. It draws with no antialiasing according to my tests. Here the code:
var
Bmp: TBitmap;
TmpCanvas: TCanvas;
begin
Bmp := TBitmap.Create(2000, 2000);
TmpCanvas := TCanvasManager.CreateFromBitmap(Bmp, TCanvasQuality.HighPerformance);
if (TmpCanvas.BeginScene) then
begin
TmpCanvas.Stroke.Color := TAlphaColors.Aquamarine;
TmpCanvas.DrawLine(PointF(5, 5), PointF(100, 100), 1);
TmpCanvas.EndScene;
Bmp.SaveToFile('c:\temp\result.bmp');
end;
FreeAndNil(TmpCanvas);
FreeAndNil(Bmp);
I also found that it doesn't work with the method to write text on Canvas (Canvas.FillText).
I hope this helps many others with the same problem.
FireMonkey paints lines on the grid between the pixels and not on the pixels. So you have to add 0.5 to each coordinate in order to paint on the pixels:
Bmp.Canvas.DrawLine(PointF(5.5, 5.5), PointF(100.5, 100.5), 1);
This does not disable anti-aliasing, but avoids the excessive anti-aliasing that happens otherwise. I'm not aware of a FireMonkey function that disables anti-alisiasing. You would have to call a native OS function, for example CGContextSetAllowsAntialiasing on MacOS, but usually it is not needed anymore as soon as you figure out how to paint on the pixels.
I want to quickly resize an image (shrink/enlarge). The resulted image should be of high quality so I cannot use the classic StretchDraw or something like this. The JanFX and Graphics32 libraries offer high quality resamplers. The quality is high but they are terribly slow (seconds to process a 2000x1000 image).
I want to try FMX CreateThumbnail to see how fast it is:
FMX.Graphics.BMP.CreateThumbnail
I created a FMX bitmap in a VCL application and tried to assign a 'normal' bitmap to it.
fmxBMP.Assign(vclBMP);
But I get an error: Cannot assign TBitmap to a TBitmap. Obviously the two bitmaps are different.
My questions:
1. Are the image processing routines in FMX much faster then the normal VCL routines?
2. Most important: how can I assign a VCL bitmap to a FMX bitmap (and vice versa)?
You can use GDI+ scaling.
You can alter result quality and speed specifying different interpolation, pixel offset and smoothing modes defined in GDIPAPI.
uses
GDIPAPI,
GDIPOBJ;
procedure ScaleBitmap(Source, Dest: TBitmap; OutWidth, OutHeight: integer);
var
src, dst: TGPBitmap;
g: TGPGraphics;
h: HBITMAP;
begin
src := TGPBitmap.Create(Source.Handle, 0);
try
dst := TGPBitmap.Create(OutWidth, OutHeight);
try
g := TGPGraphics.Create(dst);
try
g.SetInterpolationMode(InterpolationModeHighQuality);
g.SetPixelOffsetMode(PixelOffsetModeHighQuality);
g.SetSmoothingMode(SmoothingModeHighQuality);
g.DrawImage(src, 0, 0, dst.GetWidth, dst.GetHeight);
finally
g.Free;
end;
dst.GetHBITMAP(0, h);
Dest.Handle := h;
finally
dst.Free;
end;
finally
src.Free;
end;
end;
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)
);