|
function InchToPixelsX (I : single) : integer;
// convert I inches into printer pixels
begin
Result:= round(I * GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSX));
end;
procedure DrawImage(Canvas : TCanvas; DestRect : TRect; ABitmap :
TBitmap);
// paint image on printer's canvas; method avoids many problems with
// using StretchDraw etc functions
var
Header, Bits : pointer;
HeaderSize : integer;
BitsSize : longint;
begin
GetDIBSizes(ABitmap.Handle, HeaderSize, BitsSize);
GetMem(Header, HeaderSize);
// Header:= MemAlloc(HeaderSize);
GetMem(Bits, BitsSize);
// Bits:= MemAlloc(BitsSize);
try
GetDIB(ABitmap.Handle, ABitmap.Palette, Header^, Bits^);
StretchDIBits(Canvas.Handle, DestRect.Left, DestRect.Top,
DestRect.Right, DestRect.Bottom, 0, 0,
ABitmap.Width, ABitmap.Height,
Bits,TBitmapInfo(Header^),
DIB_RGB_COLORS, SRCCOPY);
// might want to try DIB_PAL_COLORS instead
finally
FreeMem(Header);
FreeMem(Bits);
// MemFree(Header, HeaderSize);
// MemFree(Bits, BitsSize);
end;
end;
procedure PrintBitmap (Title : string; ABitmap: TBitmap);
// print a bitmap image in ABitmap, using the whole Printer page;
// if title provided, print it 0.5" from top, and start image 0.25" lower
var
TitleX,
TitleY,
AvailH,
RelHeight,
RelWidth : integer;
begin
Printer.BeginDoc;
if length(Title) = 0 then
TitleX:= 0
else
TitleX:= InchToPixelsX(0.5);
TitleY:= TitleX;
AvailH:= Printer.PageHeight - TitleY;
if (ABitmap.Width / ABitmap.Height) > (Printer.PageWidth / AvailH) then begin
// stretch bitmap to width of printer page
RelWidth:= Printer.PageWidth;
RelHeight:= MulDiv(ABitmap.Height,
Printer.PageWidth, ABitmap.Width);
end
else begin
// stretch bitmap to height of printer page
RelWidth:= MulDiv(ABitmap.Width, AvailH, ABitmap.Height);
RelHeight:= AvailH;
end;
DrawImage(Printer.Canvas, Rect(0, TitleY, RelWidth, RelHeight), ABitmap);
if length(Title) > 0 then
// print Title string at top of page
with Printer.Canvas do begin
Font.Name:= 'Courier New';
Font.Size:= 12;
Font.Color:= clBlack;
TextOut(TitleX, TitleY, Title);
end;
Printer.EndDoc;
end; |