Related
I need to print an image that is aquired from a scanner.
When the scan fits on one A4 page, there is no problem and my code prints perfect.
However, when the scan does not fits, but needs 2 pages, only one page is printed. The first.
This is my code so far
procedure TFormMain.PrintPicture;
var
MyRect: TRect;
Scale: Double;
begin
try
Printer.BeginDoc;
Scale := Printer.PageWidth / ImgHolder.Picture.Bitmap.Width;
MyRect.Left := 0;
MyRect.Top := 0;
MyRect.Right := trunc(ImgHolder.Picture.Bitmap.Width * Scale);
MyRect.Bottom := trunc(ImgHolder.Picture.Bitmap.Height * Scale);
Printer.Canvas.StretchDraw(MyRect, ImgHolder.Picture.Bitmap);
Printer.EndDoc;
except
on E:Exception do
begin
MessageBox(Handle, PChar('Printing failed' + chr(13) + E.Message), PChar(Caption), MB_OK or MB_ICONWARNING);
end;
end;
end;
when the image holds one page, the height of MyRect = 13092
when the image holds 2 pages, the height is 26185
This seems correct to me, but still only the first page is printed.
So I must be doing it all wrong, can someone please point me in the correct direction on how to print an image that is higher then the height of one page
EDIT
I want to print on more than one page if the image is larger.
I do not want to scale down the image to one page.
The reason for the scale in my code is because I could not print correct at first, and I find this code in another question that solved that for me.
But now it seems this approach is wrong.
So I would appreciate if I could get some help in setting up my printing correct.
If the user scans 2 or 3 times, the image will be made larger and the new scan will be added to the image at the bottom.
This is how the image gets longer than one page.
Now I need to print this image complete, so on more than one page if needed
There are many ways to print an image.
First, please remember that your screen and your printer have different resolutions (in pixels per inch, say). Typically, a printer has much higher resolution than a PC monitor, so if you print your full-screen 1920×1080 image on an A4 page, you will get a very small image on the page unless you magnify it.
Now, having said that, let's us consider two common scenarios (you want the second one).
Scaling the image so it fits perfectly on a single page
By "fits perfectly", I mean the image is scaled proportionally, preserving its aspect ratio, so that it is as large as possible on the page without being clipped.
Let (uses Math)
ScaleX := Printer.PageWidth / Bitmap.Width;
ScaleY := Printer.PageHeight / Bitmap.Height;
Scale := Min(ScaleX, ScaleY).
Then Scale is your scaling factor.
Indeed, ScaleX is the greatest scaling factor that allows the image to fit the page horizontally. For instance, if the paper is 1000×1000 and the image 2000×1000, you clearly need to shrink it to at least ScaleX = 50% to make it fit horizontally. On the other hand, if the image is 1000×5000, the problem is not the width but the height, and you clearly need to shrink it to at least ScaleY = 20% to make it fit vertically.
So if the image is 2000×5000, you need the scale factor to be 50% or less to make it fit horizontally, and you need the scale factor to be 20% or less to make it fit vertically. The greatest scale factor satisfying these two restrictions is 20%, the minimum of 50% and 20%.
procedure PrintBitmap(ABitmap: TBitmap);
begin
Printer.BeginDoc;
var ScaleX := Printer.PageWidth / ABitmap.Width;
var ScaleY := Printer.PageHeight / ABitmap.Height;
var Scale := Min(ScaleX, ScaleY);
var W := Round(ABitmap.Width * Scale); // Note: scaling proportionally,
var H := Round(ABitmap.Height * Scale); // same factor
Printer.Canvas.Brush.Color := clRed;
Printer.Canvas.StretchDraw(
TRect.Create( // Centre on page
Point((Printer.PageWidth - W) div 2, (Printer.PageHeight - H) div 2),
W, H
),
ABitmap
);
Printer.EndDoc;
end;
For example,
procedure TForm1.FormCreate(Sender: TObject);
begin
var bm := TBitmap.Create;
try
bm.LoadFromFile('K:\Sally.bmp');
PrintBitmap(bm);
finally
bm.Free;
end;
end;
Having a fixed image size, potentially spanning several pages
Now, instead suppose you have a fixed image size (W, H) and you want to print it on as many pages as needed. Then you need to loop through the 2D paper grid and draw each page separately:
procedure PrintBitmap(ABitmap: TBitmap);
var
W, H: Integer;
ImgPageWidth, ImgPageHeight: Integer;
function GetSourceRect(Row, Col: Integer): TRect;
begin
Result := TRect.Create(
Point(Col * ImgPageWidth, Row * ImgPageHeight),
ImgPageWidth, ImgPageHeight
);
end;
function GetDestRect(Row, Col: Integer): TRect;
begin
Result := Rect(0, 0, Printer.PageWidth, Printer.PageHeight);
end;
begin
Printer.BeginDoc;
W := ABitmap.Width * 4; // Hardcoding these in this example
H := ABitmap.Height * 4;
ImgPageWidth := Round(ABitmap.Width * (Printer.PageWidth / W));
ImgPageHeight := Round(ABitmap.Height * (Printer.PageHeight / H));
var PageCountX := Ceil(W / Printer.PageWidth); // Image width in pages
var PageCountY := Ceil(H / Printer.PageHeight); // Image height in pages
// Notice that the total page count is PageCountX * PageCountY.
for var y := 0 to PageCountY - 1 do
for var x := 0 to PageCountX - 1 do
begin
if x + y > 0 then
Printer.NewPage;
Printer.Canvas.CopyRect(
GetDestRect(y, x),
ABitmap.Canvas,
GetSourceRect(y, x)
);
end;
Printer.EndDoc;
end;
or
To print a big image on several pages, you have to loop on the width and on the height (two loops) to create pages with partial image. To print one partial image, you can use TCanvas.CopyRect
Hope this is clear...
I want to know if the PaintBox control can allow the user to scroll, left to right through data? Imagine it like an oscilloscope display where a single capture allows zooming and scrolling. In this case I do not need zooming. So, my Paintbox is 800x600 and my data set is 16000x600.
I can plot in the 800x600 region as shown below, no problems at all, and can apply scaling to get all the data in, but I want to keep the Y-axis scaled to 1 and be able to scroll/drag left/right and view the data.
for J := 1 to ((Form1.Memo1.Lines.count)-1) do
begin
MyTorques[J] := StrToInt(Form1.Memo1.Lines[J]);
Tqmult := ((StrToInt(Label6.Caption) + 500) Div 600);
Ycalc[J] := ((MyTorques[J]) Div Tqmult);
InvY[J] := (600 - (Ycalc[J]));
X1 := (J-1);
Y1 := InvY[J-1];
X2 := (J);
Y2 := InvY[J];
with PaintBox1.Canvas do
begin
pen.Style := psSolid;
pen.Color := clBlack;
pen.Width := 1;
moveto(X1, Y1);
Lineto(X2, Y2);
Label51.Caption := IntToStr(X1);
Label52.Caption := IntToStr(Y1);
Label28.Caption := IntToStr(X2);
Label29.Caption := IntToStr(Y2);
Label35.Caption := IntToStr(Tqmult);
Label37.Caption := IntToStr(Ycalc[J]);
Label39.Caption := IntToStr(InvY[J]);
Label41.Caption := IntToStr(MyTorques[J]);
end;
if MyTorques[J] < Smallest Then
Begin
Smallest := MyTorques[J];
SmallestIndex := J;
end;
if MyTorques[J] > Largest Then
begin
Largest := MyTorques[J];
LargestIndex := J;
end;
Label30.Caption := IntToStr(Smallest);
Label31.Caption := IntToStr(SmallestIndex);
Label32.Caption := IntToStr(Largest);
Label33.Caption := IntToStr(LargestIndex);
end;
So, does my paintbox.canvas need to be sized 16000x600 with a "window" over the top sized 800x600, and the paintbox control is drag-able with vertical and horizontal constraints?
PaintBox by default does not have any scrolling support built in.
So if you want to have scrolling capabilities you will have to place your PaintBox into some other scrollable control like ScrollBox and set size of your PaintBox large enoought to contain rendering of your entire plot.
But this is a bad practice. Why? Doing so you will spend a lot of time painting your plot even thou only a part of it is visible to user at one time.
Instead you should be thinking of painting just part of your plot that can actually be visible by your user at the sima time (fits into PaintBox) and then redraw the plot when user scrolls to different position on a plot.
I want to paint a monochome bitmap stretched at 200% with two colors: pure black and pure white.
I use the following code, but nothing gets displayed.
If I replace SRCCOPY with SRCPAINT I get a white rectangle, but still no random 2x2 blocks get painted as is supposed to happen.
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowCell(Form1.Canvas); //Using another canvas does not help.
end;
procedure ShowCell(Canvas: TCanvas);
const
cHeight = 100;
cWidth = 50; //50 * 8 = 400 pixels
var
bmpinfo: PBitmapInfo;
color: PRGBQUAD;
i: Integer;
x,y,h: integer;
DataBuffer: array[0..cHeight-1,0..cWidth-1] of byte;
ScanLineWidth: integer;
Cell: TLifeCell;
Coordinate: TCoordinate;
begin
GetMem(bmpinfo, SizeOf(TBitmapInfo) + SizeOf(TRGBQUAD)*2);
color:= #bmpinfo^.bmiColors[0];
color^.rgbRed:= 255;
color^.rgbBlue:= 255;
color^.rgbGreen:= 255;
color^.rgbReserved:= 0;
Inc(color);
color^.rgbRed:= 0;
color^.rgbBlue:= 0;
color^.rgbGreen:= 0;
color^.rgbReserved:= 0;
with bmpinfo.bmiHeader do begin
biSize:= SizeOf(bmpinfo.bmiHeader);
biWidth:= cWidth*8; //8 pixels per byte
biHeight:= cHeight;
biPlanes:= 1;
biBitCount:= 1;
biCompression:= BI_RGB;
biSizeImage:= 0;
biXPelsPerMeter:= 0;
biYPelsPerMeter:= 0;
biClrUsed:= 0;
biClrImportant:= 0;
end;
ScanlineWidth:= cWidth div 8;
if (ScanlineWidth mod 4) <> 0 then Inc(ScanlineWidth, 4 - ScanlineWidth mod 4);
for x:= 0 to cwidth-1 do begin
for y:= 0 to cheight-1 do begin
DataBuffer[x][y]:= Random(255);
end;
end;
StretchDIBits(Canvas.Handle, 0, 0, cHeight*2, cWidth*2*8, 0, 0, cHeight, cWidth*8,
#DataBuffer, bmpinfo^, DIB_RGB_COLORS, SRCCOPY);
FreeMem(bmpinfo);
end;
What am I doing wrong here?
It works for me with some corrections - cwidth/cheight in the cycle and main - width and height arguments of StretchDiBits function were exchanged. Has GetLastError reported wrong param values? (In my case - not)
for x:= 0 to cwidth-1 do begin
for y:= 0 to cheight-1 do begin
DataBuffer[x][y]:= Random(255);
end;
end;
StretchDIBits(Canvas.Handle, 0,0,cWidth*2*8,cHeight*2,0,0,cwidth*8,cHeight,#DataBuffer,
bmpinfo^, DIB_RGB_COLORS, SRCCOPY);
Another possible issue - you defined cWidth (data buffer width) independently of ScanlineWidth calculation.
There are a number of errors:
Bitmap declaration does not match StretchDIBits call.
Bitmap is upside down
Loop has x and y reversed
Status code is not checked (and finally)
For performance reasons the width of a bitmap should be a multiple of 4 (or 8) bytes
Bitmap declaration does not match StretchDIBits call
The problem is that the declaration of the bitmap must match the arguments of StretchDIBits. If these do not match you'll get a silent error and nothing will get displayed.
Here are the problem lines:
with bmpinfo.bmiHeader do begin
biSize:= SizeOf(bmpinfo.bmiHeader);
biWidth:= cWidth*8; //8 pixels per byte must match srcWidth.
biHeight:= cHeight; // must match srcHeight below.
StretchDIBits(Canvas.Handle,0,0,cWidth*2*8,cHeight*2
,0,0,cwidth*8,cHeight, //srcWidth,srcHeight
#DataBuffer, bmpinfo^, DIB_RGB_COLORS, SRCCOPY);
If either the srcWidth or srcHeight parameter exceed the dimensions of the bitmap the call will fail.
In the call to StretchDIBits in the question Height and Width are reversed, making the bitmap too large and forcing an error, preventing display.
Bitmap is upside down
Because IBM has had it's grubby hands on the bitmap format logic went out the window and the default for bitmaps is to be upside down.
BITMAPINFOHEADER
biHeight The height of the bitmap, in pixels. If biHeight is positive, the bitmap is a bottom-up DIB and its origin is the lower-left corner. If biHeight is negative, the bitmap is a top-down DIB and its origin is the upper-left corner.
Unless you want your data to be upside down, you'd better make biHeight negative, like so:
with bmpinfo.bmiHeader do begin
biSize:= SizeOf(bmpinfo.bmiHeader);
biWidth:= cWidth*8; //8 pixels per byte must match srcWidth.
biHeight:= -cHeight; // "-" = TopDown: must match srcHeight below.
Loop has x and y reversed
In the loop, take note that x and y are reversed in the buffer.
for y:= 0 to cHeight-1 do begin
for x:= 0 to cWidth-1 do begin //fill scanlines in the inner loop.
DataBuffer[y][x]:= Random(256); //y,x must be reversed!
end; {for x}
end; {for y}
Status code is not checked
If I had bothered to check the return value of StretchDIBits than I could have saved myself the bother. I would have known there was an error.
If the function succeeds, the return value is the number of scan lines copied. Note that this value can be negative for mirrored content.
If the function fails, or no scan lines are copied, the return value is 0.
Success:= StretchDIBits(.....
Assert(Success <> 0,'StretchDIBits error, check your arguments');
For performance reasons the width of a bitmap should be a multiple of 4 bytes
If you are going to write to your bitmap buffer using (32-bit) integers, you'd better make sure your bitmap width is a multiple of 4 bytes, or you're going to suffer delays due to misaligned writes.
If you use 64-bit Int64 writes, make it a multiple of 8 bytes.
Windows only enforces a 2-byte alignment. This is because the bitmaps need to stay compatible with 16-bit Windows bitmaps.
bmWidthBytes The number of bytes in each scan line. This value must be divisible by 2, because the system assumes that the bit values of a bitmap form an array that is word aligned
Gretings to all!
How to print pictures in Delphi on TPrinter, in real sizes of pictures?
From canvas of TImage I have good results, but if I paints on TPrinter canvas, I have BAD result, puctures is too small than real size of bitmap.
Why that happens What I'm need to do for fix bug?
UPDATE
Yes, I seen question from the hint in the 1st post.
I can't use JCL/JVCL code in my project, but I got idea from it.
I create temporary TImage, and calculate dimensions of it in accordance with the factor of printer's DPI:
var
i, iRow, iCol, // Counter
iBorderSize, // Ident from left/top borders
iImgDistance, // Ident between images in grid
iRows, // Rows Count
iColumns, // Colun count
iLeft, iTop: Integer; // For calc
bmp: TBitmap;
bStop, bRowDone, bColDone: Boolean;
Img1: TImage;
scale: Double;
function CalcY: Integer;
begin
if (iRow = 1) then
Result := iBorderSize
else
Result := iBorderSize + (iImgDistance * (iRow - 1)) +
(bmp.Height * (iRow - 1));
end;
function CalcX: Integer;
begin
if (iCol = 1) then
Result := iBorderSize
else
Result := iBorderSize + (iImgDistance * (iCol - 1)) +
(bmp.Width * (iCol - 1));
end;
begin
iBorderSize := StrToInt(BorderSizeEdit.Text);
iImgDistance := StrToInt(ImgsDistanceEdit.Text);
iRows := StrToInt(RowsCountEdit.Text);
iColumns := StrToInt(ColCountEdit.Text);
iRow := 1;
iCol := 1;
iLeft := iBorderSize;
iTop := iBorderSize;
if Printer.Orientation = poPortrait then
scale := GetDeviceCaps(Printer.Handle, LOGPIXELSX) /
Screen.PixelsPerInch
else
scale := GetDeviceCaps(Printer.Handle, LOGPIXELSY) /
Screen.PixelsPerInch;
bmp := TBitmap.Create;
Img1 := TImage.Create(nil);
Img1.Height := Trunc(Printer.PageHeight / scale); //Calc canvas size
Img1.Width := Trunc(Printer.PageWidth / scale); //Calc canvas size
Img1.Canvas.Brush.Color := clWhite;
Img1.Canvas.FillRect(Rect(0, 0, Img1.Width, Img1.Height));
try
bmp.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'Source.bmp');
for i := 1 to 18 do
begin
if (iRow <= iRows) then
begin
iTop := CalcY;
iLeft := CalcX;
Img1.Canvas.Draw(iLeft, iTop, bmp);
if not((iRow = iRows) and (iCol = iColumns)) then
begin
if (iCol = iColumns) then
begin
Inc(iRow);
iCol := 1;
end
else
Inc(iCol);
end
else
begin
PrintImage(Img1, 100);
iRow := 1;
iCol := 1;
Img1.Canvas.Brush.Color := clWhite;
Img1.Canvas.FillRect(Rect(0, 0, Img1.Width, Img1.Height));
end;
end;
end;
finally
FreeAndNil(bmp);
FreeAndNil(Img1);
end;
end;
And draw it on TPrinter.Canvas.
You can see results below:
Results is good, but not perfect.
As you can see, in the last column, all images are drawn not to the end, some part misses off the paper and not drawn.
I think it's happens because I use the Trunc to get integer part of double when I'm calculate dimensions of TImage.Canvas in accordance with the factor of printer's DPI.
By experiments I know value 0.20. 0.20 is a part of last column images, in pixels, that not drawn. If I change code, that gets scale factor by this:
if Printer.Orientation = poPortrait then
scale := GetDeviceCaps(Printer.Handle, LOGPIXELSX) /
Screen.PixelsPerInch - 0.20
else
scale := GetDeviceCaps(Printer.Handle, LOGPIXELSY) /
Screen.PixelsPerInch - 0.20;
I have that, what I need:
I think the value 0.20 isn't a constant and it will change on every PC.
How to calculate this value? What need to solve this problem?
The basic problem here is one of scaling. More or less, figure out how much to expand the resolution of the image and then stretchdraw it to the printer canvas. Something like this gets the image stretched out to the dimension of the printer canvas.
procedure TForm1.Button2Click(Sender: TObject);
var
MyRect: TRect;
scale: Double;
begin
if PrintDialog1.Execute then
begin
Printer.BeginDoc;
scale := Printer.PageWidth / Bitmap1.Width;
ShowMessage(FloatToStr(scale));
{ horizontal pixels, vertical pixels, bit depth 600 x 600 x 24}
MyRect.Left := 0;
MyRect.Top := 0;
MyRect.Right := trunc(Bitmap1.Width * scale);
MyRect.Bottom := trunc(Bitmap1.Height * scale);
Printer.Canvas.StretchDraw(MyRect, Bitmap1);
Printer.EndDoc;
end;
Of course, you have to check "Right" and "Bottom" to make sure they don't exceed your PageWidth and PageHeight depending on the type of scaling you use (6.25 or 600/96 seems fine for simply making an image the same relative size as the screen, assuming those numbers match your printer and screen), assuming you want to keep the image to one page and not mosaic pieces of it onto multiple pages.
I don't know if this works entirely since I don't have a varied number of devices (i.e. different DPIs) to test both orientations on, but this seems to be what you want to get both DPI numbers dynamically.
if Printer.Orientation = poPortrait then
scale := GetDeviceCaps(Printer.Handle, LOGPIXELSX) / PixelsPerInch
else
scale := GetDeviceCaps(Printer.Handle, LOGPIXELSY) / pixelsperinch;
Then of course, you multiply like above.
The issue you're running into is that there really isn't a "real size" of an image, it's all relative. The printer often has a lot higher resolution then your monitor and that's why pictures look small.
Your monitor has often a resolution of 96 dpi and normal printer has a resolution of 600 dpi which means your image prints in its real size it just looks small because a printer can put a lot more dots in the same space then a monitor can.
Delphi Basics link was also helpful : http://www.delphibasics.co.uk/RTL.asp?Name=printer&ExpandCode1=Yes
on form : drag n drop TPrintDialog from your Tool Palette
and manually add this to the uses clause under [Implementation]
uses printers; // Unit containing the printer command
With that and this post I was able to print directly to any printer at the size I wanted for images or text. There is no need to call the bitmap or assign the TPrinter once you have added the unit above. Just draw directly to the canvas in your PC printer queue.
procedure TForm1.cmdPrintCircleClick(Sender: TObject);
var
xx, yy, mySize : integer;
//printer1 : TPrinter;
begin
// create image directly on Printer Canvas and print it
//Ellipse( X-(Width div 2), Y-(Height div 2), X+(Width div 2), Y+(Height div 2));
if PrintDialog1.Execute then
try
with Printer do
begin
if Printer.Orientation = poPortrait then
begin
// represents 1/2 US-inch relative to Portrait page size 8.5 x 11
mySize := Trunc(PageWidth / 8.5 / 2);
end
else
begin
// represents 1/2 US-inch relative to Landscape page size 11 x 8.5
mySize := Trunc(PageHeight / 8.5 / 2);
end;
xx := Trunc(PageWidth / 2);
yy := Trunc(PageHeight / 2);
// Start printing
BeginDoc;
// Write out the ellipse // create one-inch black circle
Canvas.Brush.Color := clBlack;
Canvas.Ellipse(xx - mySize, yy - mySize, xx + mySize, yy + mySize);
// Finish printing
EndDoc;
end;
finally
end;
end;
I need to get the coordinates of a small image location residing in a big image (let say I need to search for a specific tree inside a forest photograph. If the sub-image is found then the result would be something like: x=120 y=354 by example).
Is there a fast algorithm that I could use ?
I'm using Delphi (can also use Java if needed)
Edit: A few things about the theory:
In a nutshell, there are two "spaces" to apply filters on an image: in color spare or in frequency space. If you decided the space(freq here, there are two sorts of filters: applied as convolution and correlation(here). To keep it simple, we assume that appling correlation simple means "we multiplicate two things". With using the correlation in frequency space of an image you can measure how similar images are. Two images are similar, if the grayscale gradients are. This is measured by the covariance. (Maybe someone can help me with inserting formulars here.) The crosscorrelationcoefficent is the normalised covariance (insert formular here:( )
If you put this into a algorithm for searching affinities between a "model" and a "reference image" (model is a small section that you search within the ref. img.), you get the matlab code, which I commented too. The formular that the code uses is this one:
FT([f°g] (m,n))=F(u,v)*G°(u,v). Where F is the fft and G° is the complex conjugated of G (G is the fft of the model)
Please define fast. :)
The solution I have in mind will need the fft, which is fast, but maybe not as fast as you want. It searches for the small "I_ausschnitt" image inside the I image and gives the position with the highes "possibility".
In matlab, this one will work. I hope you can put it into delphi. :)
I = im2double(imread('Textiltextur.tif')); // This is our reference image
I_model = imcrop( I, [49 36 42 28] ); // Our model - what we want so search in I
[X Y] = size( I ); // Get the size of the reference image.
f = fft2(I); // Perform the fast fourier transform->put the image into frequency space.
f_model = fft2(I_model ,X,Y); // Perform the fft of the model but do this in the size of the original image. matlab will center I_model and set other pixel to zero
w = conj(model ); // Complex conjugated
g = real( ifft2(w.*f)); // .* will perform a komponent wise multiplicaion e.g. [0][0]*[0][0], [0][1]*[0][1] and not a matrix mul.
gs =im2uint8(mat2gray(g)); // Convert the resulting correlation into an grayscale image with larger values->higher correlation
// Rest of the code is for displaying only
figure(1);
imshow(gs);
colormap hsv
figure;
[ XX YY] = meshgrid(1:Y,1:X );
colormap hsv
surfc(XX,YY,double(gs)), title('3D Korrelation')
min_corr = min(min(gs))
max_corr = max(max(gs))
%axis([1 X 1 Y min_corr max_corr])
colorbar
Edit: This will only work for grayscale images.
One possibility is a Boyer-Moore string search: http://en.wikipedia.org/wiki/Boyer%E2%80%93Moore_string_search_algorithm
You'll have to adapt it to your image search problem, of course.
Supposing the large image has N pixels and the small one M pixels, you'd be looking at an average case performance of N/M, which is rather good.
There are a number of different techniques to find a sub image in an image.
The most straightforward is to use 2D correlation of your small image on the larger image. This will be quite slow but easy to implement. It also only works well if the sub image is aligned with the original (no rotation) and of the same scale.
If that is not the case (you have rotation and/or scale variations) then you need something more advanced. My choice would be to use a feature detection algorithm such as SIFT or SURF.
And just to reiterate what I have put in most of the previous answers: Using algorithms that are designed for 1D strings (Boyer-Moore) for image processing is just wrong. If you do you will most likely end up spending hours implementing and adapting something that does not work in the current context while there are other better algorithms that you could use.
It is pretty fast (fails to find in 160ms, finds in 90ms on 1600x900) and the only one you will find out there.
Any speedups are welcome. Checked to work with 24-bit bitmaps under Win7/Win10 x64, XE2, XE5.
uses
System.Generics.Collections;
type
TSubImageInfo = record
X: integer;
Y: integer;
Color: integer;
end;
function ImageSearch(const ASubimageFile: string): TRect;
var
X, Y, K, _Color: integer;
_SubImageInfo: TSubImageInfo;
_SubImageInfoList: TList<TSubImageInfo>;
_SmallWidth, _SmallHeight, _BigWidth, _BigHeight: integer;
_MatchingPixels: integer;
_LTColor, _RTColor, _LBColor, _RBColor: integer;
_FirstPixels: TList<TSubImageInfo>;
_Offset: TPoint;
_Desktop: HDC;
_ScreenBitmap: TBitmap;
_SubimageBitmap: TPNGImage;
_Pos: TPoint;
begin
Result.Left := -1;
Result.Top := Result.Left;
Result.Height := Result.Left;
Result.Width := Result.Left;
if not FileExists(ASubimageFile) then
Exit;
_SubImageInfoList := TList<TSubImageInfo>.Create;
_ScreenBitmap := TBitmap.Create;
_SubimageBitmap := TPNGImage.Create;
_FirstPixels := TList<TSubImageInfo>.Create;
try
_SubimageBitmap.LoadFromFile(ASubimageFile);
if (_SubimageBitmap.Height < 3) or (_SubimageBitmap.Width < 3) then
Exit; // Image is too small
X := 0;
Y := _SubimageBitmap.Height div 2;
while X < _SubimageBitmap.Width - 1 do
begin
_SubImageInfo.X := X;
_SubImageInfo.Y := Y;
_Color := _SubimageBitmap.Canvas.Pixels[X, Y];
_SubImageInfo.Color := _Color;
_SubImageInfoList.Add(_SubImageInfo);
X := X + 3;
end;
Y := 0;
X := _SubimageBitmap.Width div 2;
while Y < _SubimageBitmap.Height - 1 do
begin
_SubImageInfo.X := X;
_SubImageInfo.Y := Y;
_Color := _SubimageBitmap.Canvas.Pixels[X, Y];
_SubImageInfo.Color := _Color;
_SubImageInfoList.Add(_SubImageInfo);
Y := Y + 3;
end;
X := 0;
Y := _SubimageBitmap.Height div 4;
while X < _SubimageBitmap.Width - 1 do
begin
_SubImageInfo.X := X;
_SubImageInfo.Y := Y;
_Color := _SubimageBitmap.Canvas.Pixels[X, Y];
_SubImageInfo.Color := _Color;
_SubImageInfoList.Add(_SubImageInfo);
X := X + 3;
end;
Y := 0;
X := _SubimageBitmap.Width div 4;
while Y < _SubimageBitmap.Height - 1 do
begin
_SubImageInfo.X := X;
_SubImageInfo.Y := Y;
_Color := _SubimageBitmap.Canvas.Pixels[X, Y];
_SubImageInfo.Color := _Color;
_SubImageInfoList.Add(_SubImageInfo);
Y := Y + 3;
end;
X := 0;
Y := (_SubimageBitmap.Height div 4) + (_SubimageBitmap.Height div 2);
while X < _SubimageBitmap.Width - 1 do
begin
_SubImageInfo.X := X;
_SubImageInfo.Y := Y;
_Color := _SubimageBitmap.Canvas.Pixels[X, Y];
_SubImageInfo.Color := _Color;
_SubImageInfoList.Add(_SubImageInfo);
X := X + 3;
end;
Y := 0;
X := (_SubimageBitmap.Width div 4) + (_SubimageBitmap.Width div 2);
while Y < _SubimageBitmap.Height - 1 do
begin
_SubImageInfo.X := X;
_SubImageInfo.Y := Y;
_Color := _SubimageBitmap.Canvas.Pixels[X, Y];
_SubImageInfo.Color := _Color;
_SubImageInfoList.Add(_SubImageInfo);
Y := Y + 3;
end;
_Desktop := GetDC(0);
_ScreenBitmap.PixelFormat := pf32bit;
_ScreenBitmap.Width := Screen.Width;
_ScreenBitmap.Height := Screen.Height;
BitBlt(_ScreenBitmap.Canvas.Handle, 0, 0, _ScreenBitmap.Width,
_ScreenBitmap.Height, _Desktop, 0, 0, SRCCOPY);
_MatchingPixels := 0;
_SmallWidth := _SubimageBitmap.Width - 1;
_SmallHeight := _SubimageBitmap.Height - 1;
_BigWidth := _ScreenBitmap.Width;
_BigHeight := _ScreenBitmap.Height;
_LTColor := _SubimageBitmap.Canvas.Pixels[0, 0];
_RTColor := _SubimageBitmap.Canvas.Pixels[_SmallWidth, 0];
_LBColor := _SubimageBitmap.Canvas.Pixels[0, _SmallHeight];
_RBColor := _SubimageBitmap.Canvas.Pixels[_SmallWidth, _SmallHeight];
for X := 1 to 3 do
begin
for Y := 1 to 3 do
begin
_SubImageInfo.X := X;
_SubImageInfo.Y := Y;
_SubImageInfo.Color := _SubimageBitmap.Canvas.Pixels[X, Y];
_FirstPixels.Add(_SubImageInfo);
end;
end;
X := 0;
while X < _BigWidth - _SmallWidth do
begin
Y := 0;
while Y < _BigHeight - _SmallHeight do
begin
_Color := _ScreenBitmap.Canvas.Pixels[X, Y];
_Offset.X := 0;
_Offset.Y := 0;
for K := 0 to _FirstPixels.Count - 1 do
begin
if (_Color = _FirstPixels[K].Color) then
begin
_Offset.X := _FirstPixels[K].X;
_Offset.Y := _FirstPixels[K].Y;
Break;
end;
end;
// Check if all corners matches of smaller image
if ((_Offset.X <> 0) or (_Color = _LTColor)) and
(_ScreenBitmap.Canvas.Pixels[X + _SmallWidth, Y] = _RTColor) and
(_ScreenBitmap.Canvas.Pixels[X, Y + _SmallHeight] = _LBColor) and
(_ScreenBitmap.Canvas.Pixels[X + _SmallWidth, Y + _SmallHeight]
= _RBColor) then
begin
// Checking if content matches
for K := 0 to _SubImageInfoList.Count - 1 do
begin
_Pos.X := X - _Offset.X + _SubImageInfoList[K].X;
_Pos.Y := Y - _Offset.Y + _SubImageInfoList[K].Y;
if (_ScreenBitmap.Canvas.Pixels[_Pos.X, _Pos.Y] = _SubImageInfoList
[K].Color) then
_MatchingPixels := _MatchingPixels + 1
else
begin
_Pos.X := X - _Offset.X - 1 + _SubImageInfoList[K].X;
_Pos.Y := Y - _Offset.Y + 1 + _SubImageInfoList[K].Y;
if (_ScreenBitmap.Canvas.Pixels[_Pos.X, _Pos.Y]
= _SubImageInfoList[K].Color) then
_MatchingPixels := _MatchingPixels + 1
else
begin
_MatchingPixels := 0;
Break;
end;
end;
end;
if (_MatchingPixels - 1 = _SubImageInfoList.Count - 1) then
begin
Result.Left := X - _Offset.X;
Result.Top := Y - _Offset.Y;
Result.Width := _SubimageBitmap.Width;
Result.Height := _SubimageBitmap.Height;
Exit;
end;
end;
Y := Y + 3;
end;
X := X + 3;
end;
finally
FreeAndNil(_FirstPixels);
FreeAndNil(_ScreenBitmap);
FreeAndNil(_SubimageBitmap);
FreeAndNil(_SubImageInfoList);
end;
end;
What it does is it loads sub-image from file and searches it on the screen (it identifies image by corner colors then if those matches it searches as in attached image), but you can easily adapt it.
Result would be a screen coordinates next to PDF file icon letter E.
If you're searching for an exact match (i.e. not a single pixel is different between the pattern you're looking for and the area in the image you want to find), you can actually use the Boyer Moore algorithm. It should be quite straight-forward to adapt it for looking for a 2D pattern.
Let's say the pattern you look for is 20x20 pixels big. You build a table mapping greyvalues (or colors) to positions in the pattern image. Now can go through the search image in large strides, starting at pixel 19/19: If this pixel contains a greyvalue that's not contained in the pattern, you can skip this position and all the positions in a 20x20 area around it. So the next pixel you would check would be at 39/19 in the search image. If it contains a pixel that appeard e.g. in 3 positions in the pattern image, you can test these three positions relative to your current position in the search image (39/19).
Note that this algorithm makes two assumptions:
you can only find exact matches. This is practically impossible for real-world images, unless the pattern image was extracted directly from the search image. It's even unlikely to work if source and pattern images are e.g. scanned from the same photograph with the same scanner. It won't work if the pattern or source image were compressed using a lossy compression (like jpeg) after the pattern was extracted.
The speedup depends on the number of greyvalues used. If you're looking for a binary pattern in a binary image, this algorithm won't run in O(n/m) time.
I would take a practical approach to this problem for 2D position matching:
They are probably going to be bitmaps...
Scan each line in the larger bitmap from 0 to Larger.height - Smaller.Height and from 0 to Larger.Width - Smaller.Width to find Smaller.TopLeft matching Pixels. When found:
IF Smaller.TopRight and smaller.bottomLeft and smaller.bottomRight are all equal to the corresponding pixels in the Larger bitmap (all the corners match) then initiate a full compare of that section.
Make sure that all comparisons fail early (do not continue comparing after any mismatch).
On average you will only need to scan less that 50% of the larger bitmap and will not start many full comparisons that fail.