Prdemo: Delphi Version

The Delphi version of Prdemo uses a global instance of the TPrinter object, which is accessed through the Printer() function. For printer control, we obtain the printer device context from the TPrinter object's Handle property and use the TPrinter BeginDoc() and EndDoc() methods instead of fg_printer().

{*****************************************************************************
*                                                                            *
*  Prdemo.dpr                                                                *
*  PrdemoU.pas                                                               *
*                                                                            *
*  This program shows how to print the contents of a virtual buffer.  It     *
*  first loads a 640x480 BMP file into a virtual buffer and displays it.     *
*  When the user clicks the Print selection on the top-level menu, a 6-inch  *
*  by 4-inch copy of the BMP image is sent to the selected printer.          *
*                                                                            *
*****************************************************************************}
unit PrdemoU;
interface
uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, Menus, Printers, FGWin;
type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    Print: TMenuItem;
    Exit1: TMenuItem;
    PrintDialog: TPrintDialog;
    procedure AppOnActivate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure PrintClick(Sender: TObject);
    procedure ExitClick(Sender: TObject);
  end;
var
  Form1: TForm1;
implementation
{$R *.DFM}
const
  vbWidth  = 640;
  vbHeight = 480;
var
  dc   : hDC;
  hPal : hPalette;
  hVB  : integer;
  cxClient, cyClient : integer;
procedure TForm1.AppOnActivate(Sender: TObject);
begin
  fg_realize(hPal);
  Invalidate;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
  fg_realize(hPal);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  dc := GetDC(Form1.Handle);
  fg_setdc(dc);
  hPal := fg_defpal;
  fg_realize(hPal);
  fg_vbinit;
  hVB := fg_vballoc(vbWidth,vbHeight);
  fg_vbopen(hVB);
  fg_vbcolors;
  fg_showbmp('PORCH.BMP'+chr(0),0);
  Application.OnActivate := AppOnActivate;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
  fg_vbscale(0,vbWidth-1,0,vbHeight-1,0,cxClient-1,0,cyClient-1);
end;
procedure TForm1.FormResize(Sender: TObject);
begin
  cxClient := ClientWidth;
  cyClient := ClientHeight;
  Invalidate;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
  fg_vbclose;
  fg_vbfree(hVB);
  fg_vbfin;
  DeleteObject(hPal);
  ReleaseDC(Form1.Handle,dc);
end;
procedure TForm1.PrintClick(Sender: TObject);
begin
  if (PrintDialog.Execute = False) then Exit;
  Cursor := crHourGlass;
  Printer.BeginDoc;
  fg_printdc(Printer.Handle);
  fg_vbprint(0,vbWidth-1,0,vbHeight-1,0,600,0,400,2);
  Printer.EndDoc;
  Cursor := crDefault;
end;
procedure TForm1.ExitClick(Sender: TObject);
begin
  Close;
end;
end.