Power-Programmierung/CD1.mdf/pascal/library/windows/printit/winprint.pas

Pascal/Delphi Source File | 1994-04-11 | 14.4 KB | 457 lines

{************************************************}
{                                                }
{   Turbo Pascal for Windows                     }
{   Tips & Techniques Demo Program               }
{   Copyright (c) 1991 by Borland International  }
{                                                }
{************************************************}

unit WinPrint;

{$R PRINTER}

interface

uses WinTypes, WinProcs, WObjects, Strings;

type

{ TComboXferRec }
{ The transfer buffer used for the ComboBox in the TPrinterInfo method
  SelectPrinter.  The fields, Strings and Selection, are set up in the
  TPrinterInfo constructor Init.  The routine GetCurrentPrinter is used
  to find current printing device which is placed in Selection.  And the
  routine GetPrinterTypes is used to fill out the Strings field.}

  TComboXferRec = record
    Strings: PStrCollection;
    Selection: array[0..80] of Char;
  end;

{ TAbortDialog }
{ A descendant of TDialog used for the Abort Dialog seen when printing is
  in progress. The AbortDialog is installed as a data field of TPrinterInfo
  and is initialized and displayed in its StartDoc method. The EndDoc
  method will Close the dialog if necessary.}

  PAbortDialog = ^TAbortDialog;
  TAbortDialog = object(TDlgWindow)
   procedure SetUpWindow; virtual;
   procedure WMCommand(var Msg: TMessage);
     virtual wm_First + wm_Command;
  end;

{ TPrinterInfo }
{ The controlling object for printing.  It is intended that this object be
  initialized as a data field of a TWindow or TApplication descendant. This
  printing object must be used OWL based applications. The data fields are
  not supposed to be used directly but may need to be accessed in special
  situations.  PrintDC and Error are the two most likely to be used without
  a specific method call.  The description of the data fields are as
  follows.

  -AbortDialog holds a pointer to the abort dialog when it valid.  It is
  valid only after a call to the method StartDoc and before the call to the
  method EndDoc.

  -AbortCallBackProc holds the address of the Abort Dialog's callback
  function.  It's definition is found in the function AbortCallBack in the
  implementation section of this unit.

  -SelectDialog is a pointer to the dialog used when selecting the current
  printer. To be used when overriding the function of the SelectPrinter
  method.

  -SelectInfo is the transfer record used in SelectDialog.  Holds
  descriptions of all printers available and the currently selected printer.

  -Driver, PrinterType, Port are null terminated strings holding information
  relevant to the current printer.

  -DriverHandle is a handle to the library of the current printer driver. It
  is setup in Init constructor and is freed in the Done destructor.  It is
  used for setting up the DeviceMode configuration call.

  -PrintDC is the device control established for printing. It is created by
  the StartDoc method and valid until the EndDoc method call. May be
  accessed directly or by the GetPrinterDC method call.

  -Error holds the results of printer escape calls.  If an error occurs, the
  result is placed here.  Is tested to determine if further printing output
  is appropriate.

  -ExtDeviceMode holds the ExtDeviceMode procedure used for retrieving,
  installing, and prompting for printing configurations.

  -DeviceModeVar holds the DeviceMode procedure used for prompting the
  user for printer configurations.
}

  PPrinterInfo = ^TPrinterInfo;
  TPrinterInfo = object
    AbortDialog: PAbortDialog;
    AbortCallBackProc: TFarProc;
    SelectDialog: PDialog;
    SelectInfo: TComboXferRec;
    Driver,
    PrinterType,
    Port: PChar;
    DriverHandle: THandle;
    PrintDC: HDC;
    Error: Integer;
    ExtDeviceMode: TExtDeviceMode;
    DeviceModeVar: TDeviceMode;
    RasterCaps: integer;
    constructor Init;
    destructor Done;
    procedure SelectPrinter; virtual;
    function GetPrinterDC: HDC;
    procedure DeviceMode;
    function BitMapCapable: boolean;
    function BandingRequired: boolean;
    procedure StartDoc(Name: PChar); virtual;
    procedure NewFrame; virtual;
    procedure NextBand(var R:TRect); virtual;
    procedure EndDoc; virtual;
  end;


var
  PrinterAbort: Boolean;
{ Holds true when the user has aborted printing. }

implementation

const
  id_ComboBox = 101;
{ ID for the ComboBox used for Selecting the current printer }

var
  AbortWindow: HWnd;
{ Window handle for the Abort Dialog.  It is used by the
  AbortCallBackProc.}

function GetItem(var S: PChar): PChar;
{ Retrieves comma separated data from a null terminated string. It
  returns the first data item and advances the pointer S to the next
  data item in the string.}
var
  P: PChar;
  I: Integer;

begin
  I:=0;
  while (S[I]<>',') and (S[I]<>#0) do
    inc(I);
  S[I]:=#0;
  GetMem(P, Strlen(S)+1);
  StrCopy(P,S);
  GetItem:=P;
  if S[0]<>#0 then S:=@S[I+1];
end;

procedure GetPrinterTypes(var PrinterTypes: PStrCollection);
{ Retrieves all the device types from the WIN.INI and places this
  information into the PStrCollection parameter.}
var
  Buffer, BufferItem: PChar;
  Item: PChar;
  Count, I: Integer;

begin
  New(PrinterTypes, init(5,1));
  GetMem(Buffer, 1024);
  Count:=GetProfileString('devices', nil, ',,', Buffer, 1024);
  BufferItem:=Buffer;
  I:=0;
  while I<Count do
  begin
    GetMem(Item, StrLen(BufferItem)+1);
    StrCopy(Item, BufferItem);
    PrinterTypes^.Insert(Item);
    while (BufferItem[i]<>#0) and (I<Count) do
      inc(I);
    inc(I);
    if BufferItem[I]=#0 then I:=Count;
    if I<Count then
    begin
      BufferItem:=@BufferItem[I];
      Count:=Count-I;
      I:=0;
    end;
  end;
  FreeMem(Buffer, 1024);
end;

procedure GetCurrentPrinter(var Driver, PrinterType, Port: PChar);
{ Retrieves the current printing device information from the WIN.INI
  file.}
var
  ProfileInfo, CurrentItem: PChar;
begin
  GetMem(ProfileInfo, 80+1);
  GetProfileString('windows', 'device', ',,', ProfileInfo, 80);
  CurrentItem:=ProfileInfo;
  PrinterType:=GetItem(CurrentItem);
  Driver:=GetItem(CurrentItem);
  Port:=GetItem(CurrentItem);
  FreeMem(ProfileInfo, 80+1);
end;

procedure GetPrinter(PrinterType: PChar; var Driver, Port: PChar);
{ Given a PrinterType string, this procedure returns the appropriate
  driver and port information.}

var
  ProfileInfo, CurrentItem: PChar;

begin
  GetMem(ProfileInfo, 80+1);
  GetProfileString('devices', PrinterType, ',', ProfileInfo, 80);
  CurrentItem:=ProfileInfo;
  Driver:=GetItem(CurrentItem);
  Port:=GetItem(CurrentItem);
end;

procedure TAbortDialog.SetUpWindow;
{ Initializes PrinterAbort and AbortWindow. Then set the focus to the
  AbortDialog.}
begin
  PrinterAbort:=false;
  SetFocus(HWindow);
  AbortWindow:=HWindow;
end;

procedure TAbortDialog.WMCommand(var Msg: TMessage);
{ If any command messages occur, a user abort has taken place.  Normally,
  this will include pressing ENTER, ESCAPE, the SPACEBAR  or clicking the
  mouse on the Abort Dialog's Escape button.}
begin
  PrinterAbort:=true;
end;

function AbortCallBack(DC: HDC; Code: Integer): Bool; export;
{ While printing is taking place, checks to see if PrinterAbort is
  true.  Otherwise messages are passed on.}
var
  Msg: TMsg;
begin
  while (not PrinterAbort) and PeekMessage(Msg, 0, 0, 0, pm_Remove) do
  if not IsDialogMessage(AbortWindow, Msg) then
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
  if PrinterAbort then AbortCallBack:=false else AbortCallBack:=true;
end;

constructor TPrinterInfo.Init;
{ Gets the current printer information (Type, Driver, & Port) and
  the printer types currently available.  Then retrieves the
  ExtDeviceMode and DeviceModeVar address from the current printer's
  library.}
var
  I: Integer;
  FullDriverName: PChar;
  P: TFarProc;

begin
  GetCurrentPrinter(Driver, PrinterType, Port);
  for I:= 0 to StrLen(PrinterType) do
    SelectInfo.Selection[I]:=PrinterType[I];
  GetPrinterTypes(SelectInfo.Strings);

  GetMem(FullDriverName, 12+1);
  StrLCat(StrCopy(FullDriverName, Driver), '.DRV', 12);
  DriverHandle:=LoadLibrary(FullDriverName);
  FreeMem(FullDriverName, 12+1);

  P:=GetProcAddress(DriverHandle, 'ExtDeviceMode');
  ExtDeviceMode:=TExtDeviceMode(P);
  P:=GetProcAddress(DriverHandle, 'DeviceMode');
  DeviceModeVar:=TDeviceMode(P);
  PrintDC:=0;
end;

destructor TPrinterInfo.Done;
{ Frees up the library taken in the constructor Init.}
begin
  FreeLibrary(DriverHandle);
end;

procedure TPrinterInfo.SelectPrinter;
{ Displays a Printer Select dialog called PISELECT and changes the
  current printer information as is done in Init.}
var
  FullDriverName: PChar;
  P: TFarProc;
  ComboBox: PComboBox;

begin
  new(SelectDialog, Init(Application^.MainWindow,
    'PISELECT'));
  New(ComboBox, InitResource(SelectDialog, id_ComboBox, 80));

  SelectDialog^.TransferBuffer:=@SelectInfo;
  if Application^.ExecDialog(SelectDialog) = id_Ok then
  begin
    FreeLibrary(DriverHandle);
    if PrintDC<>0 then DeleteDC(PrintDC);
    FreeMem(PrinterType, StrLen(PrinterType)+1);
    GetMem(PrinterType, StrLen(@SelectInfo.Selection)+1);

    StrCopy(PrinterType, @SelectInfo.Selection);

    FreeMem(Driver, StrLen(Driver)+1);
    FreeMem(Port, StrLen(Port)+1);
    GetPrinter(PrinterType, Driver, Port);

    GetMem(FullDriverName, 12+1);
    StrLCat(StrCopy(FullDriverName, Driver), '.DRV', 12);
    DriverHandle:=LoadLibrary(FullDriverName);
    FreeMem(FullDriverName, 12+1);

    P:=GetProcAddress(DriverHandle, 'ExtDeviceMode');
    ExtDeviceMode:=TExtDeviceMode(P);
    P:=GetProcAddress(DriverHandle, 'DeviceMode');
    DeviceModeVar:=TDeviceMode(P);
  end;
end;

function TPrinterInfo.GetPrinterDC: HDC;
{ Retrieves the Device control associated with the printer.  May only be
  called after a call to the StartDoc method. }
begin
  GetPrinterDC:=PrintDC;
end;

procedure TPrinterInfo.StartDoc(Name: PChar);
{ Called immediately before printing is to begin.  Establishes the
  device control.  Sets up the Abort Dialog. And send the STARTDOC
  escape call.}
begin
  Error:=0;
  PrintDC:=CreateDC(Driver, PrinterType, Port, nil);
  if LowMemory then
    AbortDialog:=Nil
  else
  begin
    new(AbortDialog, Init(Application^.MainWindow, 'PIABORT'));
    AbortDialog^.Create;
  end;
  if AbortDialog<>Nil then
  begin
    AbortCallBackProc:=MakeProcInstance(@AbortCallBack, HInstance);
    Escape(PrintDC, SETABORTPROC, 0, AbortCallBackProc, nil);
  end;
  RasterCaps:=GetDeviceCaps(PrintDC, WINTYPES.RASTERCAPS);
  Error:=Escape(PrintDC, WINTYPES.STARTDOC, StrLen(Name), Name, nil);
end;

procedure TPrinterInfo.NewFrame;
{ Sends the NEWFRAME escape call and performs appropriate error
  checking.}
begin
  if Error>=0 then
    Error:=Escape(PrintDC, WINTYPES.NEWFRAME, 0, nil, nil);
  if Error<0 then
    case Error of
      SP_ERROR: MessageBox(Application^.MainWindow^.HWindow,
        'General Printer Error', nil, mb_Ok or mb_IconStop);
      SP_OUTOFDISK: MessageBox(Application^.MainWindow^.HWindow,
        'No disk space for spooling', nil, mb_Ok or mb_IconStop);
      SP_OUTOFMEMORY: MessageBox(Application^.MainWindow^.HWindow,
        'No memory space for spooling', nil, mb_Ok or mb_IconStop);
      SP_USERABORT: MessageBox(Application^.MainWindow^.HWindow,
        'Printing Terminated by User', nil, mb_Ok or mb_IconStop);
    else
      MessageBox(Application^.MainWindow^.HWindow,
        'Printing Halted', nil, mb_OK or mb_IconStop);
    end;
end;

procedure TPrinterInfo.NextBand(var R:TRect);
{ When Bitmap banding is required, this routine returns the next
  rectangular region to be printed.  This method is not required but
  can speed up printing bitmaps.}
begin
  if Error>=0 then
    Error:=Escape(PrintDC, WINTYPES.NEXTBAND, 0, nil, @R);
  if Error<0 then
    case Error of
      SP_ERROR: MessageBox(Application^.MainWindow^.HWindow,
        'General Printer Error', nil, mb_Ok or mb_IconStop);
      SP_OUTOFDISK: MessageBox(Application^.MainWindow^.HWindow,
        'No disk space for spooling', nil, mb_Ok or mb_IconStop);
      SP_OUTOFMEMORY: MessageBox(Application^.MainWindow^.HWindow,
        'No memory space for spooling', nil, mb_Ok or mb_IconStop);
      SP_USERABORT: MessageBox(Application^.MainWindow^.HWindow,
        'Printing Terminated by User', nil, mb_Ok or mb_IconStop);
    else
      MessageBox(Application^.MainWindow^.HWindow,
        'Printing Halted', nil, mb_OK or mb_IconStop);
    end;
end;

procedure TPrinterInfo.EndDoc;
{ Sends the ENDDOC escape call and closes the Abort Dialog if no errors
  have occurred.}
begin
  if Error>=0 then
    Error:=Escape(PrintDC, WINTYPES.ENDDOC, 0, nil, nil);
  if Error>=0 then
  begin
    DeleteDC(PrintDC);
    if AbortDialog<>Nil then AbortDialog^.CloseWindow;
  end;
end;

procedure TPrinterInfo.DeviceMode;
{ Calls the printer driver's DeviceMode routine.  Normally displays a
  dialog allowing the user to change the printer's configuration.}
begin
  DeviceModeVar(Application^.MainWindow^.HWindow,
    DriverHandle, PrinterType, Port);
end;

function TPrinterInfo.BitMapCapable: boolean;
{ Returns true if the current printing device can handle bitmap
  graphics.}
begin
  BitMapCapable:=(RasterCaps and RC_BITBLT)<>0;
end;

function TPrinterInfo.BandingRequired: boolean;
{ Returns true if banding of bitmap images will enhance printing speed.}
begin
  BandingRequired:=(RasterCaps and RC_BANDING)<>0;
end;

end.

{ Here are the descriptions of the dialogs PIABORT and PISELECT found in
  the resources file PRINTER.RES

PIABORT DIALOG DISCARDABLE LOADONCALL PURE MOVEABLE 44, 46, 175, 78
STYLE WS_POPUP | WS_VISIBLE | WS_CAPTION | 0x80L
CAPTION "Printing in Progress"
BEGIN
  CONTROL "Press Escape to Halt Printing" 101, "STATIC", WS_CHILD |
    WS_VISIBLE, 37, 17, 98, 12
  CONTROL "Escape" 102, "BUTTON", WS_CHILD | WS_VISIBLE | WS_TABSTOP,
    73, 49, 40, 13
END

PISELECT DIALOG DISCARDABLE LOADONCALL PURE MOVEABLE 44, 37, 145, 85
STYLE WS_POPUP | WS_VISIBLE | WS_CAPTION | 0x80L
CAPTION "Select Printer"
BEGIN
  CONTROL "COMBOBOX" 101, "COMBOBOX", WS_CHILD | WS_VISIBLE | WS_VSCROLL |
    0x101L, 26, 11, 84, 43
  CONTROL "Ok" 1, "BUTTON", WS_CHILD | WS_VISIBLE | WS_TABSTOP,
    29, 61, 40, 12
  CONTROL "Cancel" 2, "BUTTON", WS_CHILD | WS_VISIBLE | WS_TABSTOP,
    86, 61, 40, 12
END
}