Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/PAS_ALL.ZIP/TI552.ASC

Text File | 1992-05-13 | 20.6 KB | 859 lines

  PRODUCT  :  Turbo Pascal                           NUMBER  :  552
  VERSION  :  1.0
       OS  :  Windows
     DATE  :  May 13, 1992                            PAGE  :  1/13

    TITLE  :  Unit for Printing in Windows




  {***********************************************}
  {                                               }
  {   Turbo Pascal for Windows                    }
  {   WinPrint Unit                               }
  {   Printer Module for use with OWL             }
  {                                               }
  {***********************************************}

  unit WinPrint;

  {$R PRINTER}
  interface

  uses WinTypes, WinProcs, WObjects, Strings;

  type

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

  { 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.}

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

  { 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.}













  PRODUCT  :  Turbo Pascal                           NUMBER  :  552
  VERSION  :  1.0
       OS  :  Windows
     DATE  :  May 13, 1992                            PAGE  :  2/13

    TITLE  :  Unit for Printing in Windows




  {/// TPrinterInfo ///}
    PPrinterInfo = ^TPrinterInfo;
    TPrinterInfo = object
      AbortDialog: PAbortDialog;
      AbortDlg: HWnd;
      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; AbortBox: Boolean); virtual;
      procedure NewFrame; virtual;
      procedure NextBand(var R:TRect); virtual;
      procedure EndDoc; virtual;
    end;

  { 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.














  PRODUCT  :  Turbo Pascal                           NUMBER  :  552
  VERSION  :  1.0
       OS  :  Windows
     DATE  :  May 13, 1992                            PAGE  :  3/13

    TITLE  :  Unit for Printing in Windows




    -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.

    For most programs, there is no need to access the data fields
    of this object directly.  Call the appropriate method for the
    operations detailed below.

    -Init retrieves the current printer configuration and sets up
    the ExtDEviceMode and DeviceMode address from the current
    printer's library.













  PRODUCT  :  Turbo Pascal                           NUMBER  :  552
  VERSION  :  1.0
       OS  :  Windows
     DATE  :  May 13, 1992                            PAGE  :  4/13

    TITLE  :  Unit for Printing in Windows




    -Done frees the library associated with the current printer.

    -SelectPrinter displays a printer select dialog permitting the
    user to change the current printer information.

    -GetPrinterDC retrieves the device control associated with the
    printer. Must be called after StartDoc.

    -DeviceMode calls the printer driver's DeviceMode routine.

    -BitMapCapable returns true if the current printing device can
    handle bitmap graphics.

    -BandingRequired returns true if banding of bitmap images will
    enhance printing speed.

    -StartDoc is called immediately before printing is to begin.
    Establishes the device control.  Sets up the abort dialog and
    sends the STARTDOC escape call.

    -NewFrame sends the NEWFRAME escape call and performs
    appropriate error checking.

    -EndDoc sends the ENDDOC escape call and closes the Abort
    Dialog if no errors have occurred.
  }

  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;













  PRODUCT  :  Turbo Pascal                           NUMBER  :  552
  VERSION  :  1.0
       OS  :  Windows
     DATE  :  May 13, 1992                            PAGE  :  5/13

    TITLE  :  Unit for Printing in Windows




  { 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;
                        I+1
    if S[0]<>#0 then S:=   ;
  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













  PRODUCT  :  Turbo Pascal                           NUMBER  :  552
  VERSION  :  1.0
       OS  :  Windows
     DATE  :  May 13, 1992                            PAGE  :  6/13

    TITLE  :  Unit for Printing in Windows




      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













  PRODUCT  :  Turbo Pascal                           NUMBER  :  552
  VERSION  :  1.0
       OS  :  Windows
     DATE  :  May 13, 1992                            PAGE  :  7/13

    TITLE  :  Unit for Printing in Windows




    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 AbortDlgProc(Dlg: HWnd; Message, WParam: Word;
                        LParam:  LongInt) : Bool; export;
  var
    Result: Bool;
  begin
    case Message of
      WM_INITDIALOG:
      begin
        PrinterAbort := False;
        SetFocus(Dlg);
        AbortWindow := Dlg;
        Result :=true;
      end;
      WM_COMMAND:
      begin
        Result := true;
      end;
    else Result := false;
    end;
    AbortDlgProc := Result;
  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













  PRODUCT  :  Turbo Pascal                           NUMBER  :  552
  VERSION  :  1.0
       OS  :  Windows
     DATE  :  May 13, 1992                            PAGE  :  8/13

    TITLE  :  Unit for Printing in Windows




          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;













  PRODUCT  :  Turbo Pascal                           NUMBER  :  552
  VERSION  :  1.0
       OS  :  Windows
     DATE  :  May 13, 1992                            PAGE  :  9/13

    TITLE  :  Unit for Printing in Windows




  { 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(Nil, '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;

  var Parent: PWindowsObject;













  PRODUCT  :  Turbo Pascal                           NUMBER  :  552
  VERSION  :  1.0
       OS  :  Windows
     DATE  :  May 13, 1992                           PAGE  :  10/13

    TITLE  :  Unit for Printing in Windows




  procedure TPrinterInfo.StartDoc(Name: PChar; AbortBox: Boolean);
  { Called immediately before printing is to begin.  Establishes
    the device control.  Sets up the Abort Dialog. And send the
    STARTDOC escape call.}
  var
    AbortProc: TFarProc;
  begin
    Error:=0;
    PrintDC:=CreateDC(Driver, PrinterType, Port, nil);
    if LowMemory  then
      AbortBox := false
    else
    if AbortBox then
    begin
  (*
      new(AbortDialog, Init(Application^.MainWindow, 'PIABORT'));
      AbortDialog^.Create;
  *)
      AbortProc := MakeProcInstance(@ AbortDlgProc, HInstance);
      AbortDlg := CreateDialog(HInstance, 'PIABORT',
                               GetFocus, AbortProc);
    end
    else
      AbortDialog := Nil;
    if AbortBox 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













  PRODUCT  :  Turbo Pascal                           NUMBER  :  552
  VERSION  :  1.0
       OS  :  Windows
     DATE  :  May 13, 1992                           PAGE  :  11/13

    TITLE  :  Unit for Printing in Windows




        SP_ERROR: MessageBox(GetFocus,
          'General Printer Error', nil, mb_Ok or mb_IconStop);
        SP_OUTOFDISK: MessageBox(GetFocus,
          'No disk space for spooling', nil, mb_Ok or mb_IconStop);
        SP_OUTOFMEMORY: MessageBox(GetFocus,
          'No memory space for spooling', nil,
          mb_Ok or mb_IconStop);
        SP_USERABORT: MessageBox(GetFocus,
          'Printing Terminated by User', nil,
          mb_Ok or mb_IconStop);
      else
        MessageBox(GetFocus,
          '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(GetFocus,
          'General Printer Error', nil, mb_Ok or mb_IconStop);
        SP_OUTOFDISK: MessageBox(GetFocus,
          'No disk space for spooling', nil, mb_Ok or mb_IconStop);
        SP_OUTOFMEMORY: MessageBox(GetFocus,
          'No memory space for spooling', nil,
          mb_Ok or mb_IconStop);
        SP_USERABORT: MessageBox(GetFocus,
          'Printing Terminated by User', nil,
          mb_Ok or mb_IconStop);
      else
        MessageBox(GetFocus,
          '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













  PRODUCT  :  Turbo Pascal                           NUMBER  :  552
  VERSION  :  1.0
       OS  :  Windows
     DATE  :  May 13, 1992                           PAGE  :  12/13

    TITLE  :  Unit for Printing in Windows




     errors have occurred.}
  begin
    if Error>=0 then
      Error:=Escape(PrintDC, WINTYPES.ENDDOC, 0, nil, nil);
    if Error>=0 then
    begin
      DeleteDC(PrintDC);
      if AbortDlg <> 0 then
  (*
       AbortDialog^.CloseWindow;
  *)
       DestroyWindow(AbortDlg);
    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(GetFocus,
                    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 is the descriptions of the dialogs PIABORT and PISELECT
    found in the resources file PRINTER.RES














  PRODUCT  :  Turbo Pascal                           NUMBER  :  552
  VERSION  :  1.0
       OS  :  Windows
     DATE  :  May 13, 1992                           PAGE  :  13/13

    TITLE  :  Unit for Printing in Windows




  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
  }