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
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
How can I set TImage size as double value? Example Image1.width := 50.1; or what component accept it, because TImage only accept integer values.
I'm working with download files, and one image should be the number of elements to download, so Image1.width max value is 340, i need to divide this value by the amount of files who will be downloaded, and increase this value on image1.width when every download be finished, but TImage only accept Integer value.
I already did it using "Round" but it is not what I need.
As answered, you cannot set the image's size to any floating point value.
However, using coordinate spaces and transformations functions, you can set an arbitrary transformation between a logical coordinate system and the viewing device. This can be used to increase the logical extent of the image's canvas size with each download and yet keep the image on the screen with an entirely different size.
The below example demonstrates the concept by drawing 4 rows and 4 columns of a 256x256 image on a 105x105 bitmap canvas of a TPicture of a TImage. Basically it achieves to draw a single 256x256 image on a 26.25x26.25 px. surface.
uses
pngimage;
procedure TForm1.Button1Click(Sender: TObject);
const
Col = 4;
Row = 4;
var
Png: TPngImage;
ImgCanvas: TCanvas;
ExtX, ExtY: Integer;
MapMode: Integer;
Size: TSize;
i, j: Integer;
begin
Png := TPngImage.Create;
try
Png.LoadFromFile('...\Attention.png');
Png.Draw(Canvas, Rect(0, 0, Png.Width, Png.Height)); // original picture
Image1.Picture.Bitmap.Canvas.Brush.Color := Color;
Image1.Picture.Bitmap.SetSize(Image1.Width, Image1.Height);
ImgCanvas := Image1.Picture.Bitmap.Canvas;
SetStretchBltMode(ImgCanvas.Handle, HALFTONE);
MapMode := SetMapMode(ImgCanvas.Handle, MM_ISOTROPIC);
if MapMode <> 0 then
try
ExtX := Png.Width * Col;
ExtY := Png.Height * Row;
if not GetWindowExtEx(ImgCanvas.Handle, Size) then
RaiseLastOSError;
if not SetWindowExtEx(ImgCanvas.Handle, Size.cx * ExtX div Image1.Width,
Size.cy * ExtY div Image1.Height, nil) then
RaiseLastOSError;
if not SetViewportExtEx(ImgCanvas.Handle, Size.cx, Size.cy, nil) then
RaiseLastOSError;
i := 0;
j := 0;
while j < ExtY do begin
while i < ExtX do begin
Png.Draw(ImgCanvas, Rect(i, j, i + Png.Width, j + Png.Height));
Inc(i, Png.Width);
end;
i := 0;
Inc(j, Png.Height);
end;
finally
SetMapMode(ImgCanvas.Handle, MapMode);
end
else
RaiseLastOSError;
finally
Png.Free;
end;
end;
Probably worth noting that GDI may not be the best graphics system when scaling is involved. For quick reference, here's what the above yields:
Assuming you're using the VCL framework, all controls across Delphi are Integer based. You simply cannot assign a float value, not without first converting it to an integer.
The Firemonkey framework on the other hand is widely based on float values.
Im trying to check if there pixel with white (#FFFFFF) or green (#00FF00) color of the screen's region. Usualy its 500x500 (250'000 pixels). Im checking every 5th pixel:
x := iMRXDef; // starting region coordinates
y := iMRYDef;
while DoMR do // global boolean variable
begin
inc(x, 4);
if x >= iMRXMax then // ending region coordinates
if y < iMRYMax then
begin
inc(y, 4);
x := iMRXDef;
end
else
begin
x := iMRXDef;
y := iMRYDef;
end;
DC := GetDC(0);
ColorValue := GetPixel(DC, X, Y);
ReleaseDC(0, DC);
if (ColorValue = iMRColorV) or (ColorValue = iMRColorV2) then
begin
performClick(X, Y); // clicking by SendInput.
x := x + 30; // skip some area
y := y + 20;
sleep(500);
end;
end;
For some reason, on win8 running my programm takes a lot of time (couple of minutes) whilst on win7 its about couple of seconds. What causes this difference?
Take a screenshot of the area you're interested in and read the pixels from that bitmap. Then access the pixels from the scanlines property of the bitmap if possible. Should be a lot faster.
GetPixel is generally not a fast function. And some Windows 8 screen dpi changes can also slow down graphics quite a lot. So it is hard to tell what is slowing down your code. You'd have to profile your code if you want to know which part is so much slower on this Win8 PC.
Currently, I loop the Canvas.Pixels[] property and read each pixel on a canvas to swap Red/Blue bytes around (for specific reasons). However, it takes an average of 2 seconds per picture, and I have over 8,000 pictures I need to convert (overnight). I understand I can use a method of ScanLine to accomplish this much faster, but I know nothing about ScanLine - it's a much lower level of coding than I'm comfortable with. What's the fastest way to accomplish this? I'm willing to wait some time for this to run through, but it would still be nice if I could chop that time in half or more.
Right now, this is the procedure I use:
procedure SwapBytes(var Bmp: TBitmap);
var
X, Y: Integer;
R, G, B: Byte;
C: TColor;
begin
for Y := 0 to Bmp.Height - 1 do begin
for X := 0 to Bmp.Width - 1 do begin
C:= Bmp.Canvas.Pixels[X,Y];
R:= GetRValue(C);
G:= GetGValue(C);
B:= GetBValue(C);
Bmp.Canvas.Pixels[X,Y]:= RGB(B, G, R)
end;
end;
end;
Added Note: An initial conversion of over 8,000 images is the first step of why I need this. However, I also will be using the same thing in our software to automatically convert any image on the spot, as needed. So a third-party converter won't work, because I cannot distribute this to our clients.
I would try something like follows. This version is only for 24-bit bitmaps:
procedure SwapRedBluePixels(ABitmap: TBitmap);
var
X: Integer;
Y: Integer;
Red: Byte;
Pixel: PRGBTriple;
begin
// check for the bit depth, it must be 24-bit if you use PRGBTriple pointer
// for line scan; if it wouldn't the iterated line pointers would point to
// another place in the memory
if ABitmap.PixelFormat <> pf24bit then
begin
ShowMessage('Your bitmap has color depth different from 24-bit');
Exit;
end;
// iterate through the image vertically
for Y := 0 to (ABitmap.Height - 1) do
begin
// access the line of pixels and get the pointer to the first pixel of
// that line
Pixel := ABitmap.ScanLine[Y];
// iterate through the scanned line pixels horizontally
for X := 0 to (ABitmap.Width - 1) do
begin
// store the pixel's red channel value
Red := Pixel.rgbtRed;
// modify the pixel's red channel value
Pixel.rgbtRed := Pixel.rgbtBlue;
// modify the pixel's blue channel value
Pixel.rgbtBlue := Red;
// increment to get the next pixel pointer of the scanned line
Inc(Pixel);
end;
end;
end;
Update 2:
This version is for 24-bit and 32-bit bitmaps:
procedure SwapRedBluePixels(ABitmap: TBitmap);
var
X: Integer;
Y: Integer;
Red: Byte;
Size: Integer;
Pixels: PByteArray;
begin
// check the color depth and set the size of the pixel arrangement
case ABitmap.PixelFormat of
pf24bit: Size := SizeOf(TRGBTriple);
pf32bit: Size := SizeOf(TRGBQuad);
else
// if the image is not 24-bit or 32-bit go away
begin
ShowMessage('Your bitmap has unsupported color depth!');
Exit;
end;
end;
// iterate through the image vertically
for Y := 0 to (ABitmap.Height - 1) do
begin
// access the line of pixels and get the pointer to the first pixel of
// that line
Pixels := ABitmap.ScanLine[Y];
// iterate through the scanned line pixels horizontally
// for 24-bit images the pixels are stored like
// B -> G -> R -> B -> G -> R etc.
// for 32-bit images the pixels are stored like
// B -> G -> R -> A -> B -> G -> R -> A etc.
// so we can simply use e.g. byte array and iterate through
// it, if we have 24-bit image, we have to read each element,
// if 32-bit we have to skip the alpha (reserved) channel
for X := 0 to (ABitmap.Width - 1) do
begin
// store the pixel's red channel value
Red := Pixels^[(X * Size) + 2];
// modify the pixel's red channel value
Pixels^[(X * Size) + 2] := Pixels^[(X * Size)];
// modify the pixel's blue channel value
Pixels^[(X * Size)] := Red;
end;
end;
end;
Delphi & C++ Builder have a TBitmap class with a Scanline property which returns the memory of pixels of the bitmap. This seems to be different when I look in a hex editor of the BMP file.
I'm trying to port a C++ Builder app to Java, and would like to understand the algorithm in Scanline. If I have the file, how do I generate the memory array like Scanline does? What is the exact spec behind Scanline?
Clarifcation: The BMP is a Windows 24bit DIB. I don't provide any other info in the code; C++ Builder seems to load it into some type of memory structure, but it's not byte-for-byte. Would like to know what the spec of that structture is.
A bitmap file starts with a BITMAPFILEHEADER, the bfOffBits member specifies the starting address of image data. This is a DWORD at Dh (11-14th bytes). Delphi VCL has the structure defined as TBitmapFileHeader in 'windows.pas'.
The last row of the ScanLine points to this image data (bottom-up). The VCL has this value in bmBits member of the dsBm(a BITMAP) member or the DIBSECTION of the image. When a scan line is requested, the VCL calculates an offset depending on the requested row, number of pixels in a row (width of the image) and how many bits make up a pixel, and returns a pointer to an address adding this offset to bmBits. It's really byte-by-byte image data.
The below Delphi sample code reads a 24bit bitmap to a file stream and compares each read pixel with the pixel data of the Bitmap.ScanLine counterpart:
procedure TForm1.Button1Click(Sender: TObject);
var
BmpFile: string;
Bmp: TBitmap;
fs: TFileStream;
FileHeader: TBitmapFileHeader;
InfoHeader: TBitmapInfoHeader;
iHeight, iWidth, Padding: Longint;
ScanLine: Pointer;
RGBFile, RGBBitmap: TRGBTriple;
begin
BmpFile := ExtractFilePath(Application.ExeName) + 'Attention_128_24.bmp';
// laod bitmap to TBitmap
Bmp := TBitmap.Create;
Bmp.LoadFromFile(BmpFile);
Assert(Bmp.PixelFormat = pf24bit);
// read bitmap file with stream
fs := TFileStream.Create(BmpFile, fmOpenRead or fmShareDenyWrite);
// need to get the start of pixel array
fs.Read(FileHeader, SizeOf(FileHeader));
// need to get width and height of bitmap
fs.Read(InfoHeader, SizeOf(InfoHeader));
// just a general demo - no top-down image allowed
Assert(InfoHeader.biHeight > 0);
// size of each row is a multiple of the size of a DWORD
Padding := SizeOf(DWORD) -
(InfoHeader.biWidth * 3) mod SizeOf(DWORD); // pf24bit -> 3 bytes
// start of pixel array
fs.Seek(FileHeader.bfOffBits, soFromBeginning);
// compare reading from file stream with the value from scanline
for iHeight := InfoHeader.biHeight - 1 downto 0 do begin
// get the scanline, bottom first
ScanLine := Bmp.ScanLine[iHeight];
for iWidth := 0 to InfoHeader.biWidth - 1 do begin
// read RGB from file stream
fs.Read(RGBFile, SizeOf(RGBFile));
// read RGB from scan line
RGBBitmap := TRGBTriple(Pointer(
Longint(ScanLine) + (iWidth * SizeOf(TRGBTriple)))^);
// assert the two values are the same
Assert((RGBBitmap.rgbtBlue = RGBFile.rgbtBlue) and
(RGBBitmap.rgbtGreen = RGBFile.rgbtGreen) and
(RGBBitmap.rgbtRed = RGBFile.rgbtRed));
end;
// skip row padding
fs.Seek(Padding, soCurrent);
end;
end;
A picture about finding the starting of pixel data of a bitmap file in a hex-editor: