[Back to PRINTING SWAG index] [Back to Main SWAG index] [Original]

    {
    RANDALL WOODMAN

    NOTE: There is a call to a Procedure called YNWin.  It is defined as:
         YNWin(s : String; Var ch : Char; Color : ColorSet);
    Color set comes from the ObjectProfessional package from TurboPower software.
    YNWin is derived from one of their Objects.  Basically it pops up a Window,
    displays the String, s, in the colors specified, and waits For a Y or N Char
    from the user.  It returns that result in CH.
         I did not include YNWin in this post.  However, you can easily Write
    a Procedure to take it's place.  I only left the calls in place to show you
    what I do when I do need interaction from the user.
         The Printer codes used are specific to an Epson compatible Printer.
    Check your user manual For other Printer support.
    }

    Unit IThinkClintonsDefecetReductionPackageSucks;

    Uses
      Dos;

    Const
      TimedOut   = $01;  { Used to determine the Type of Printer error }
      IOError    = $08;
      OutOfPaper = $20;
      NotBusy    = $80;
      TestAll    = TimedOut+IOError+OutOfPaper;

    Var
      PrnStatus : Byte;

    Function PrinterReady : Boolean;
    { checks the status of the Printer and returns True if ready      }
    { to recieve a Character                                          }
    { This Function will return the status of your Printer.  Status   }
    { should be interpreted as follows:  (x'90' (d'144') is "Ready"): }
    { $01 = Printer Time-out          $02 = Not Used                  }
    { $04 = Not Used                  $08 = I/O Error                 }
    { $10 = Printer Selected          $20 = Out Of Paper              }
    { $40 = Acknowledge               $80 = Not Busy                  }

    Var
       Regs : Registers;
       TempStatus : Byte;
    begin
      With Regs Do
      begin
        DX := 0;
        AX := $0200;
        Intr($17,Regs);
        PrnStatus := Hi(AX);
        TempStatus := PrnStatus;
        PrinterReady := (TempStatus and TestAll = $00);
      end;
    end;

    Procedure GetPrnError(Var ESC : Boolean);
    { gets the error that occured With the Printer and gives the user a chance to }
    { correct the problem and continue. }
    Var
      CH : Char;
    begin
      Repeat
        PrnStatus := PrnStatus and TestAll;
        Case PRnStatus OF
          TimedOut   : YNWin('Printer timed out.  Retry??? (Y/N)',Ch,Mycolor);
          IOError    : YNWin('An IOError has occured.  Retry??? (Y/N)',CH,Mycolor);
          OutOfPaper : YNWin('Printer out of paper.  Retry??? (Y/N)',CH,Mycolor);
        else
          YNWin('A Print Device Error has occured.  Retry??? (Y/N)',CH,Mycolor);
        end; { Case }
        if CH = 'N' then
          esc := True;
      Until ESC or PrinterReady;
    end;

    Function EscapePushed : Boolean;
    { Checks the keyboard buffer For a Character and test to see if it was the }
    { Esc key.  if it was it returns True else it returns False.               }
    Var
      CH : Char;
    begin
      if KeyPressed then        { Check the keyboard buffer For a Character }
      begin
        CH := ReadKey;          { if Character then check it }
        CH := UpCase(CH);
        EscapePushed := (Ch = Chr(27));
      end
      else
        EscapePushed := False;
    end;

    Procedure ConfirmQuit(Var ESC : Boolean);
    { confirms that the user wants to quit printing }
    Var
      CH : Char;
    begin
      YNWin('Cancel all print jobs? (Y/N)',Ch,Mycolor);
      ESC := (CH = 'Y');
    end;

    Procedure PrintCh(CH : Char; Underline : Boolean; Var OK : Boolean);
    { Writes a single Character to the Printer }
    begin
      if UnderLine then
        {$I-} Write(LST, #27#45#1, CH, #27#45#0) {$I+}
      else
        {$I-} Write(lst,CH); {$I+}
      OK := (IOResult = 0);
    end;

    Procedure MakeLine(Start, Stop : Integer; Return : Boolean; Var ESC : Boolean);
    { Draws a line on the paper starting at Start and ending at Stop. }
    Var
      PrnReady,
      Ok       : Boolean;
    begin
      PrnReady := True;
      Repeat
        PrnReady := PrinterReady;
        if not PRnReady then
          GetPrnError(ESC);
      Until PrnReady or ESC;

      PrnReady := True;
      While prnReady and not Esc and (Start <> Stop + 1) DO
      begin
        prnReady := PrinterReady;  { do three test to be sure }
        if not PRnReady then
          GetPrnError(ESC);
        if not ESC then
          PrintCH('_',False,OK);
        if not ESC then
          if EscapePushed then
            ConfirmQuit(ESC);
        if OK then
          Inc(Start);
      end;
      if not Esc and PrnReady and RETURN then
        {$I-} Writeln(LST); {$I+}
    end;

    Procedure WriteStr(TheStr : String; Return, UnderLine : Boolean;
                       Var ESC : Boolean);
    Var
      PrnReady,
      OK       : Boolean;
      I        : Byte;
    begin
      Repeat
        PrnReady := PrinterReady;
        if not PRnReady then
          GetPrnError(ESC);
      Until PrnReady or ESC;
      I := 1;

      While PrnReady and not Esc and (I <> Length(theStr)+1) DO
      begin
        PrnReady := PrinterReady;
        if not PRnReady then
          GetPrnError(ESC);
        if not ESC then
          PrintCh(theStr[I], UnderLine, OK);
        if not esc then
          if EscapePushed then
            confirmQuit(Esc);
        if OK then
          Inc(I);
      end;
      if PrnReady and Not ESC And RETURN then
        {$I-} Writeln(LST); {$I+}
    end;

[Back to PRINTING SWAG index] [Back to Main SWAG index] [Original]