If I print at half the size, or at 300dpi instead of 600dpi, then it works
fine.
Help, I can't expect all users to change their printer settings to fit my
program, and I don't really want half sized form prints.
Dave.
This is the code from the Forms unit which I have changed a bit.
TForm.Print;
var
FormImage: TBitmap;
Info: PBitmapInfo;
InfoSize: DWORD;
Image: Pointer;
ImageSize: DWORD;
Bits: HBITMAP;
DIBWidth, DIBHeight: Longint;
PrintWidth, PrintHeight: Longint;
begin
Printer.BeginDoc;
try
FormImage := GetFormImage;
Canvas.Lock;
try
{ Paint bitmap to the printer }
with Printer, Canvas do
begin
Bits := FormImage.Handle;
GetDIBSizes(Bits, InfoSize, ImageSize);
Info := AllocMem(InfoSize);
try
Image := AllocMem(ImageSize);
try
if not GetDIB(Bits, 0, Info^, Image^) then
Showmessage('Ouch!!!') ;
with Info^.bmiHeader do
begin
DIBWidth := biWidth;
DIBHeight := biHeight;
end;
case PrintScale of
poProportional:
begin
PrintWidth := MulDiv(DIBWidth, GetDeviceCaps(Handle,
LOGPIXELSX), PixelsPerInch);
PrintHeight := MulDiv(DIBHeight, GetDeviceCaps(Handle,
LOGPIXELSY), PixelsPerInch);
end;
poPrintToFit:
begin
PrintWidth := MulDiv(DIBWidth, PageHeight, DIBHeight);
if PrintWidth < PageWidth then
PrintHeight := PageHeight
else
begin
PrintWidth := PageWidth;
PrintHeight := MulDiv(DIBHeight, PageWidth, DIBWidth);
end;
end;
else
PrintWidth := DIBWidth;
PrintHeight := DIBHeight;
end;
// Changed to print half size.
StretchDIBits(Canvas.Handle, 0, 0, Trunc(PrintWidth*0.5),
Trunc(PrintHeight*0.5), 0, 0,
DIBWidth, DIBHeight, Image, Info^, DIB_RGB_COLORS, SRCCOPY);
{ StretchDIBits(Canvas.Handle, 0, 0, PageHeight, PageWidth, 0, 0,
DIBWidth, DIBHeight, Image, Info^, DIB_RGB_COLORS, SRCCOPY);}
finally
FreeMem(Image, ImageSize);
end;
finally
FreeMem(Info, InfoSize);
end;
end;
finally
Canvas.Unlock;
FormImage.Free;
end;
finally
Printer.EndDoc;
end;
end;
---------------------------------------------------------------------------
New Zealand Delphi Users group - Delphi List - [EMAIL PROTECTED]
Website: http://www.delphi.org.nz
To UnSub, send email to: [EMAIL PROTECTED]
with body of "unsubscribe delphi"
