// efg, www.efg2.com/Lab
//
// From:  http://www.efg2.com/Lab/Library/Delphi/Printing/StretchDIBitsDemo.txt
// Updated 11 January 2000 to fix minor clerical error and make D3-D5 compatibile.
// Updated 22 February 2001 to make a complete working example.
//
// Load bitmap from file, force to pf24bit DIB, and use printer
// setup to select printer and page orientation.
//
// Thanks to Daniel Leonard for suggesting improvements to this example.

(*
==========================================================================

How can this be used with a DBImage?

Change "BitmapPrint" above (which was an in-memory TBitmap) to something
like:  DBImage1.Picture.Bitmap

For example:

// Print DBImage
PrintBitmap (Printer.Canvas,
             Rect(iFromLeftMargin, jFromTopOfPage,
                  iFromLeftMargin + iPrintedImageWidth,
                  jFromTopOfPage  + jPrintedImageHeight),
                  DBImage1.Picture.Bitmap);

==========================================================================

Also See Printer Demo #1 for comparison of StretchDIBits and StretchDraw:
http://www.efg2.com/Lab/OtherProjects/PrinterDemo1.htm

To print an M-by-N matrix of images on a single page:
http://www.efg2.com/Lab/ImageProcessing/SlideShow.htm

Delphi Printing Info and Links
http://www.efg2.com/Lab/Library/Delphi/Printing

*)

unit ScreenPrintBitmap;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtDlgs, StdCtrls, ExtCtrls;

type
  TFormPrintBitmap = class(TForm)
    ButtonPrint: TButton;
    OpenPictureDialog: TOpenPictureDialog;
    ButtonLoad: TButton;
    Image: TImage;
    CheckBoxStretch: TCheckBox;
    PrinterSetupDialog: TPrinterSetupDialog;
    Edit: TEdit;
    procedure ButtonPrintClick(Sender: TObject);
    procedure ButtonLoadClick(Sender: TObject);
    procedure CheckBoxStretchClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    BitmapPrint:  TBitmap;
  public
    { Public declarations }
  end;

var
  FormPrintBitmap: TFormPrintBitmap;

implementation
{$R *.DFM}

USES
  Printers;

////////////////////////////////////////////////////////////////////
//
//  Utility routines used below in Click method
//

// 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.
// Assumes bitmap to print is a TBitmap in BitmapPrint.  Don't Print a DDB in
// a TImage.  Try always to print a DIB from an in-memory TBitmap.


procedure TFormPrintBitmap.ButtonPrintClick(Sender: TObject);
  VAR

    iFromLeftMargin    :  INTEGER;
    iPrintedImageWidth :  INTEGER;
    jDelta             :  INTEGER;
    jFromTopOfPage     :  INTEGER;
    jPrintedImageHeight:  INTEGER;
    s                  :  STRING;
begin
  ASSERT(BitmapPrint.PixelFormat = pf24bit);

  IF   PrinterSetupDialog.Execute
  THEN BEGIN

    Screen.Cursor := crHourGlass;
    TRY
      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 := Edit.Text;

        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 := BitmapPrint.Height*iPrintedImageWidth DIV
                               BitmapPrint.Width;  // maintain aspect ratio of bitmap

        // Print Image
        PrintBitmap (Printer.Canvas,
                     Rect(iFromLeftMargin, jFromTopOfPage,
                          iFromLeftMargin + iPrintedImageWidth,
                          jFromTopOfPage  + jPrintedImageHeight),
                     BitmapPrint);
        ShowMessage('Bitmap printed');
        PrintFooterTimeStamp (iFromLeftMargin);

        Printer.EndDoc

     FINALLY
       Screen.Cursor := crDefault
     END

  END

end;


procedure TFormPrintBitmap.ButtonLoadClick(Sender: TObject);
begin
  IF   OpenPictureDialog.Execute
  THEN BEGIN
    IF   Assigned(BitmapPrint)
    THEN BitmapPrint.Free;

    BitmapPrint := TBitmap.Create;
    BitmapPrint.LoadFromFile(OpenPictureDialog.Filename);

    // FORCE to DIB by assigning PixelFormat to pf24bit
    BitmapPrint.PixelFormat := pf24bit;
    Image.Picture.Graphic := BitmapPrint;

    ButtonPrint.Enabled := TRUE
  END
end;


procedure TFormPrintBitmap.CheckBoxStretchClick(Sender: TObject);
begin
  Image.Stretch := CheckBoxStretch.Checked
end;


procedure TFormPrintBitmap.FormDestroy(Sender: TObject);
begin
  IF   Assigned(BitmapPrint)
  THEN BitmapPrint.Free
end;

end.