I am trying to capture Printer.Canvas as a Bitmap using BitBlt. I want to then take that Bitmap and display it on a paintbox. However, when I attempt this I am given only a white rectangle proportionate to the values I entered for Bitmap.SetSize. My printout looks correct, so I am almost positive the canvas of the printer is being properly drawn to. I attempted the following code using the variable bitmap as the destination and the paintbox as the source (in essence I was drawing a simple rectangle and line of text to the Paintbox, bitblt-ing it to a bitmap, clearing it, and then posting it back to the paintbox), but now that Printer.Canvas.Handle is the source it doesn't display.
I understand that the dimensions between the screen and printer are different so I will clearly indicate dimensions, just in case I am doing it wrong.
procedure TForm2.btnDrawClick(Sender: TObject);
begin
Printer.BeginDoc;
Printer.Canvas.Font.Size := 10; //Not Sure if this is necessary
Printer.Canvas.Font.Name := 'Arial'; //Not Sure if this is necessary
Printer.Canvas.Font.Color := clBlack; //Not Sure if this is necessary
Printer.Canvas.Rectangle(100,100,200,200); //Should print very tiny to paper
//But will look bigger when posted to
//The Paintbox
Printer.Canvas.TextOut(120,120,'XRay-Cat');
PCBitmap.SetSize(Paintbox1.Width,Paintbox1.Height); //Paint box is 300W,300H
Application.ProcessMessages;
BitBlt(PCBitmap.Canvas.Handle, //PCBitmap, is created on create, freed on destroy,
//Defined in the private section
0,
0,
PCBitmap.Width, //300
PCBitmap.Height, //300
Printer.Canvas.Handle,
0,
0,
SRCCOPY);
Application.ProcessMessages;
Printer.EndDoc;
procedure TForm2.btnPostBMClick(Sender: TObject);
begin
PaintBox1.Canvas.Draw(0,0,PCBitmap);
end;
I expect that the canvas would be written too, the canvas would be copied to a bitmap, then be available to be drawn on the paintbox. However all I see is a white rectangle. I am setting the dimensions of the bitmap to be the entire paintbox rather than the entire canvas of the printer. I am doing this because if I understand it correctly I should be only be drawing between the printer canvas's TopLeft 0,0 and BottomRight 300,300 the same way I would on my paint box. I would expect to see the same results as I would if I did this directly to the Paintbox.
Any help would be greatly appreciated. Thanks in advance.
Given the comments I've received it seems what I was trying to do was not possible. What I wanted to do was to write to a printers canvas and then get the image data of that canvas and store it in a bitmap. Since BitBlt can't be used is there a way to do what I wanted? I assume not, as I was told Printer.Canvas cannot be read from. At this point I have Found a way around it but I am just curious.
Switch your logic...draw to the PaintBox...and Print the PaintBox
procedure TForm55.Button1Click(Sender: TObject);
var
a_BM: TBitMap;
begin
a_BM := TBitmap.Create;
try
PaintBox1.Canvas.Font.Size := 10; //Not Sure if this is necessary
PaintBox1.Canvas.Font.Name := 'Arial'; //Not Sure if this is necessary
PaintBox1.Canvas.Font.Color := clBlack; //Not Sure if this is necessary
PaintBox1.Canvas.Rectangle(0,0,300,300); //Should print very tiny to paper
//But will look bigger when posted to
//The Paintbox
PaintBox1.Canvas.TextOut(120,120,'XRay-Cat');
PaintBox1.Width := 300;
PaintBox1.Height := 300;
a_BM.SetSize(PaintBox1.Width, PaintBox1.Height);
BitBlt(a_BM.Canvas.Handle, 0, 0, a_BM.Width, a_BM.Height, PaintBox1.Canvas.Handle, 0, 0, SRCCOPY);
Application.ProcessMessages;
Printer.BeginDoc;
Printer.Canvas.Draw(a_BM.Canvas.ClipRect.Left, a_BM.Canvas.ClipRect.Top, a_BM);
Printer.EndDoc;
Application.ProcessMessages;
finally
a_BM.Free;
end;
end;
Related
I have a form which I need to print but only a certain section of it and then enlarge it (increase the scale). So far I have the following code:
procedure TForm1.PrintButtonClick(Sender: TObject);
var
printDialog : TPrintDialog;
begin
printDialog := TPrintDialog.Create(Form1);
if printDialog.Execute then
begin
Printer.Orientation := poLandscape; //Better fit than portrait
Form1.PrintScale:=poPrintToFit;
Form1.Print;
end;
end;
However, this prints the whole form. I've googled around and found a few different things that might help but I'm not sure how to use them:
GetFormImage - Is there a way of selecting a specific area with this or does it just take the whole form?
Using a rectangle with given coordinates e.g rectangle1:= rect(Left, Top, Right, Bottom); but then how do I print scale the rectangle to a larger size and print it? As well, seen as though Delphi only gives Left and Top properties, is Right just another name for the furthest left value you want to go to?
UPDATE:
I have tried to create a custom bitmap and then stretch it but I'm not using the strechdraw correctly. It doesn't actually stretch when printed:
procedure TForm1.PrintButtonClick(Sender: TObject);
var
printDialog: TPrintDialog;
Rectangle, stretched: TRect;
Bitmap: TBitmap;
begin
Bitmap := TBitmap.Create;
try
Rectangle := Rect(0, 90, 1450, 780);
stretched := Rect(0, 0, 5000, 3000); //what numbers do i put in here for streching it?
Bitmap.SetSize(Form1.Width, Form1.Height);
Bitmap.Canvas.CopyRect(Rectangle, Form1.Canvas, Rectangle);
Bitmap.Canvas.StretchDraw(stretched, Bitmap); //not sure how to use this
finally
printDialog := TPrintDialog.Create(Form1);
if printDialog.Execute then
begin
with printer do
begin
BeginDoc;
Canvas.Draw(0, 90, Bitmap);
EndDoc;
end;
end;
Bitmap.Free;
end;
end;
Is the try and finally necessary?
When I printed without the stretchdraw it was really small but when I printed with the stretchdraw, a lot of the image was missing so I must be using it wrong
Get rid of your stretched variable and the Bitmap.Canvas.StretchDraw (you can also get rid of the TPrintDialog if you'd like).
// Capture your bitmap content here, and then use this code to scale and print.
Printer.Orientation := poLandscape;
Printer.BeginDoc;
Printer.Canvas.StretchDraw(Rect(0, 0, Printer.PageWidth, Printer.PageHeight), Bitmap);
Printer.EndDoc;
I have created a print preview object which allows me to organise several graphic objects from different sources onto a printed page.
In order to render these objects on the printer canvas I have to first render them to a bitmap of the calculated size and then render the bitmap to the Tprinter canvas at the correct positions using the canvas.draw(x,y,bitmap) method.
I found out early on that a device independent bitmap is required and set the pixel format to pf24bit.
Tried this on the office HP laserjet, works fine, HP colour Deskjet works fine, Cannon colour printer however does not work or occasionally gives intermittent graphics at random points.
Now if I get the graphical objects to render directly to the printer canvas, then all work OK.
Rendering directly to the printer canvas however is not a workable long term solution for me for various reasons.
So, my question is, what is it about the Tprinter.canvas that makes it hardware dependent and is there any workarounds ?
Some example code which divides the page up into 4 quadrants with margins and cell padding and puts a graphical object in each quadrant. Each graphical object has a RenderToBitmap method which draws the graphics.
procedure TMultiPrintForm.PrintBtnClick(Sender: TObject);
var w,h,h2,w2,mv,iw,ih,pv,cw,ch:integer; Abmp:Tbitmap;
begin
Abmp:=Tbitmap.create;
Abmp.PixelFormat := pf24bit;
try
with Printer do
begin
w:=pagewidth;
h:=pageheight;
h2:=h div 2;
w2:=w div 2;
mv:=h*margin.value div 200; //margin percentage div 2
pv:=h*padding.value div 400; //padding percentage div 4
iw:=w-mv; //internal width
ih:=h-mv; //internal height
cw:=(iw-mv) div 2-pv; //Quadrant Cell Width
ch:=(ih-mv) div 2-pv; //Quadrant Cell Height
Abmp.width:=cw;
Abmp.height:=ch;
If Fsources[0]<>nil then
begin
Fsources[0].rendertoBitmap(Abmp);
canvas.draw(mv,mv,Abmp);
end;
If Fsources[1]<>nil then
begin
Fsources[1].rendertoBitmap(Abmp);
canvas.draw(w2+pv,mv,Abmp);
end;
If Fsources[2]<>nil then
begin
Fsources[2].rendertoBitmap(Abmp);
canvas.draw(mv,h2+pv,Abmp);
end;
If Fsources[3]<>nil then
begin
Fsources[3].rendertoBitmap(Abmp);
canvas.draw(w2+pv,h2+pv,Abmp);
end;
end;
finally
printer.Enddoc;
Abmp.free;
end
end;
On further investigation around the net, I accumulated some suggestions into a PrintBitmap procedure which uses a technique recommended by Microsoft.
I replaced all the Canvas.draw calls with PrintBitmap calls (it assumes begindoc and enddoc are set outside the calls).
Being as its the weekend, I can't test it on the problem printers in the office but it does at least not break the printing on the home HP Deskjet printer (which works anyway with both methods).
procedure PrintBitmap(X,Y:integer; Abmp:Tbitmap);
var Info: PBitmapInfo;
InfoSize,ImageSize: DWORD; Image: Pointer;
DIBWidth, DIBHeight: LongInt;
begin
with Printer do
begin
GetDIBSizes(Abmp.Handle, InfoSize, ImageSize);
Info := AllocMem(InfoSize);
Image := AllocMem(ImageSize);
try
GetDIB(Abmp.Handle, 0, Info^, Image^);
with Info^.bmiHeader do
begin
DIBWidth := biWidth;
DIBHeight := biHeight;
end;
StretchDIBits(Canvas.Handle, X, Y, DIBWidth, DIBHeight, 0, 0,
DIBWidth, DIBHeight, Image, Info^, DIB_RGB_COLORS, SRCCOPY);
finally
FreeMem(Image, ImageSize);
FreeMem(Info, InfoSize);
end
end;
end;
Good afternoon.
I'm working on a drawing program that allows the user to drag and drop TImages loaded with a Bitmap over a canvas. (In a Firemonkey HD application in RAD Studio XE2) The user can then change x and y scales and rotation before saving the image.
All TImages are kept in a list and this list is then written to the underlying canvas using this simple procedure:
for i := 0 to DroppedList.Count - 1 do
begin
AImage := DroppedList[i];
SourceRect.Left := 0;
SourceRect.Right := AImage.Bitmap.Width;
SourceRect.Top := 0;
Sourcerect.Bottom := AImage.Bitmap.Height;
TargetRect.Left := AImage.Position.X;
TargetRect.Right := AImage.Position.X + AImage.Bitmap.Width;
TargetRect.Top := AImage.Position.Y;
TargetRect.Bottom := AImage.Position.Y + AImage.Bitmap.Height;
with FImage.Bitmap do
begin
Canvas.BeginScene;
Canvas.DrawBitmap(AImage.Bitmap, SourceRect, TargetRect, 1, True);
Canvas.EndScene;
BitmapChanged
end;
end;
FImage.Bitmap.SaveToFile('test.bmp');
The problem with this is that transformations to the scale and rotation of the images that are visible in the window are not taken into account by DrawBitmap, and are lost when saving.
I am looking for a way to apply the transformations to the bitmap before drawing it to the background.
I was unable to find any info on this, so i was hoping someone here could help.
Thank you,
Daniël
the problem seems to be that the Scaling and the Rotation are applyed to a source TImage. In this "source TImage", the transformations are not done to the bitmap but rather at the TImage level (beause it's a TControl and as all TControl they can be scaled and rotated). Later you copy the source Bitmap elsewhere, but actually this Bitmap has never changed.
So would have to rotate and scale the bitmap in the loop, according to the settings in the source TImage:
with FImage.Bitmap do
begin
Canvas.BeginScene;
LBmp := TBitmap.Create;
try
// create a copy on which transformations will be applyed
LBmp.Assign(AImage.Bitmap);
// rotate the local bmp copy according to the source TImage.
if AImage.RotationAngle <> 0 then
LBmp.Rotate( AImage.RotationAngle);
// scale the local bmp copy...
If AImage.Scale.X <> 1
then ;
Canvas.DrawBitmap(LBmp, SourceRect, TargetRect, 1, True);
finally
LBmp.Free;
Canvas.EndScene;
BitmapChanged
end;
end;
This simple code sample explains well the problem. For example, RotatationAngle is a property of AImage and not of AImage.Bitmap.
A workaround that would avoid to implement the transformations would be to use TControl.MakeScreenshot(). (to be verified, this coulds fail)
with FImage.Bitmap do
begin
Canvas.BeginScene;
LBmpInclTranformations := AImage.MakeScreenShot;
Canvas.DrawBitmap(LBmpInclTranformations, SourceRect, TargetRect, 1, True);
Canvas.EndScene;
BitmapChanged
end;
In this question I asked about the correct use of the CopyRect method. I got an answer which fixed my problem, but now the colors of the copied rectangle are wrong (limited to 256 values?).
This is the code:
var
Bmp: TBitmap;
begin
Image1.Picture.LoadFromFile(SomeJPGimage);
Bmp := TBitmap.Create;
try
Bmp.Assign(Image1.Picture.Graphic);
with Bmp do
Image2.Canvas.CopyRect(Image2.Canvas.ClipRect, Canvas, Canvas.ClipRect);
finally
Bmp.Free;
end;
end;
The inset with the false colors is Image2. The colors are right if I don't resize.
How do I get the 24 bit color of the source image (a JPG) when resizing?
edit
Draw is not an alternative; I want to copy a scaled version of part of the source image.
This is not caused because of color reduction, or a wrong pixelformat etc.. You're probably shrinking the image while copying and 'StretchBlt' compresses the image to fit in, and depending on the mode, produces some artifacts. For instance the below 128x128 image
is displayed exactly the same if no resizing is applied. However if it is applied on a 90x100 image for instance, the output is .
You can change the stretching mode for a slightly better result:
var
Bmp: TBitmap;
begin
Image1.Picture.LoadFromFile(SomeJPGimage);
Bmp := TBitmap.Create;
try
Bmp.Assign(Image1.Picture.Graphic);
SetStretchBltMode(Image2.Canvas.Handle, HALFTONE); // <- here
with Bmp do
Image2.Canvas.CopyRect(Image2.Canvas.ClipRect, Canvas, Canvas.ClipRect);
finally
Bmp.Free;
end;
end;
For the above source picture the output now becomes:
(Having browsed a little 'graphics.pas', the VCL seems to be using halftone only for 8-bit images. I may be wrong or right in this assessment, but in any case halftone stretching mode has no such constraint.)
For anything better, I believe, you have to use a proper graphics library.
Edited again:
Turns out the issue is going against the WRONG canvas (too easy with TImage if you're not used to it). Tried to save files on my last sample and got a huge file on the one I assigned. So I Started looking into some of the other values and found that you need to work against the Bitmap Canvas...
var
BMP: TBitmap;
MyClipRect: TRect;
begin
if OpenDialog1.Execute then
begin
Image1.Picture.LoadFromFile(OpenDialog1.FileName);
Bmp := TBitmap.Create;
try
Bmp.Assign(Image1.Picture.Graphic);
myClipRect.Left := (Bmp.Width div 2);
myClipRect.Top := (Bmp.Height div 2);
myClipRect.Right := (Bmp.Width);
myClipRect.Bottom := (Bmp.Height);
with Image2.Picture.Bitmap do
begin
Width := Bmp.Width div 2;
Height := Bmp.Height div 2;
Canvas.CopyRect(Canvas.ClipRect, Bmp.Canvas, MyClipRect);
end;
Image2.Picture.SaveToFile('image2.bmp');
finally
Bmp.Free;
end;
end;
end;
Hope that finally got it. Yeesh.
Context
I am drawing to a canvas, this is updated regularly and it flashes.
Logically thinking I assumed this is because my redraw method clears the Canvas then draws one element at a time to the canvas. so my idea was to write to a Timage then set the picture to the Timage.
Information
here is my code
procedure Tmainwindow.Button3Click(Sender: TObject);
var bufferpicture:TImage;
begin
//draw stuff to bufferpicture
//***
//draw stuff to bufferpicture
myrealpicture.picture:=bufferpicture.picture;
end;
Upon running the code I get a error show below.
Question
How do I set the canvas of one to another since canvas is a read only property? or is there a better way to do what i am trying to do?
It looks like you did not create myrealpicture
I would use the method Assign
MyRealPicture.Picture.Assign(BufferPicture.Picture);
You can copy the content of one canvas to another using BitBlt:
var
BackBuffer: TBitmap;
begin
BackBuffer := TBitmap.Create;
try
{ drawing stuff goes here}
BitBlt(Form1.Canvas.Handle, 0, 0, BackBuffer.Width, BackBuffer.Height,
BackBuffer.Canvas.Handle, 0, 0, SRCCOPY);
finally
BackBuffer.Free;
end;
end;
You can just use the DoubleBuffered property
use the DoubleBuffered property