Mega Code Archive
Printbitmap
<![CDATA[
// efg, 10 Feb 2000
// Print JPEGImage displayed in TImage
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
jpeg, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
ButtonPrint: TButton;
Image1: TImage;
procedure ButtonPrintClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
USES Printers;
// Based on posting to borland.public.delphi.winapi by Rodney E Geraghty, 8/8/97.
// Used to print bitmap on any Windows printer.
PROCEDURE PrintBitmap(Canvas: TCanvas; DestRect: TRect; Bitmap: TBitmap);
VAR
BitmapHeader: pBitmapInfo;
BitmapImage : POINTER;
HeaderSize : DWORD; // Use DWORD for D3-D5 compatibility
ImageSize : DWORD;
BEGIN
GetDIBSizes(Bitmap.Handle, HeaderSize, ImageSize);
GetMem(BitmapHeader, HeaderSize);
GetMem(BitmapImage, ImageSize);
TRY
GetDIB(Bitmap.Handle, Bitmap.Palette, BitmapHeader^, BitmapImage^);
StretchDIBits(Canvas.Handle,
DestRect.Left, DestRect.Top, // Destination Origin
DestRect.Right - DestRect.Left, // Destination Width
DestRect.Bottom - DestRect.Top, // Destination Height
0, 0, // Source Origin
Bitmap.Width, Bitmap.Height, // Source Width & Height
BitmapImage,
TBitmapInfo(BitmapHeader^),
DIB_RGB_COLORS,
SRCCOPY)
FINALLY
FreeMem(BitmapHeader);
FreeMem(BitmapImage)
END
END {PrintBitmap};
FUNCTION CenterText(s: STRING): INTEGER;
BEGIN
RESULT := (Printer.PageWidth - Printer.Canvas.TextWidth(s)) DIV 2
END {CenterText};
PROCEDURE PrintFooterTimeStamp (CONST LeftMargin: INTEGER);
VAR
s: STRING;
BEGIN
// Footer
Printer.Canvas.Font.Name := 'Arial';
Printer.Canvas.Brush.Color := clWhite;
Printer.Canvas.Font.Height :=
MulDiv(GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSY), 8, 72);
s := FormatDateTime('m/d/yy h:nn', Now);
Printer.Canvas.TextOut(LeftMargin,
Printer.PageHeight-Printer.Canvas.TextHeight('X'),
s);
END {PrinterFooterTimeStamp};
////////////////////////////////////////////////////////////////////
//
// Print Bitmap in landscape orientation, with printed image width 80% of page.
//
procedure TForm1.ButtonPrintClick(Sender: TObject);
VAR
Bitmap : TBitmap;
iFromLeftMargin : INTEGER;
iPrintedImageWidth : INTEGER;
jDelta : INTEGER;
jFromTopOfPage : INTEGER;
jPrintedImageHeight: INTEGER;
s : STRING;
begin
Screen.Cursor := crHourGlass;
TRY
Printer.Orientation := poLandscape;
Printer.BeginDoc;
// Header
Printer.Canvas.Font.Height :=
MulDiv(GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSY), 12, 72);
Printer.Canvas.Font.Name := 'Arial';
jDelta := Printer.Canvas.TextHeight('X');
jFromTopOfPage := 3*jDelta;
s := 'Image Title';
Printer.Canvas.TextOut(CenterText(s), jFromTopOfPage, s);
// 5th line from top
jFromTopOfPage := 5*jDelta;
// Image position and size
// 12% left and right margin
iFromLeftMargin := MulDiv(Printer.PageWidth,12,100); // 12%
// Set printed bitmap with to be 76% of paper width
iPrintedImageWidth := MulDiv(Printer.PageWidth,76,100); // 76%
// Set printed bitmap height to maintain aspect ratio
jPrintedImageHeight := Image1.Picture.Height*iPrintedImageWidth DIV
Image1.Picture.Width; // maintain aspect ratio of bitmap
Bitmap := TBitmap.Create;
TRY
Bitmap.Width := Image1.Picture.Width;
Bitmap.Height := Image1.Picture.Height;
Bitmap.PixelFormat := pf24bit;
// Convert JPEG to BMP
Bitmap.Canvas.Draw(0,0, Image1.Picture.Graphic);
// Print Image
PrintBitmap (Printer.Canvas,
Rect(iFromLeftMargin, jFromTopOfPage,
iFromLeftMargin + iPrintedImageWidth,
jFromTopOfPage + jPrintedImageHeight),
Bitmap)
FINALLY
Bitmap.Free
END;
PrintFooterTimeStamp (iFromLeftMargin);
Printer.EndDoc;
FINALLY
Screen.Cursor := crDefault
END;
end;
end.
]]>