Codierbeispiel: Hardcopy erstellen
Autor: Rainer Nehls

Mit Hilfe des folgenden Codings kann unter zuhilfenahme der PC-Printer-Routinen von Micro Focus, eine Hardcopy erstellt werden:

   IDENTIFICATION DIVISION.
   PROGRAM-ID.                 U012.
   AUTHOR.                     RAINER NEHLS.
   DATE-WRITTEN.               13.06.96.

  ******************************************************************
  *
  *       KURZBESCHREIBUNG:    DAS UNTERPROGRAMM HAT DIE AUFGABE,
  *                            EINE HARDCOPIE MIT DEN PC_PRINTER-
  *                            ROUTINEN VON MICRO FOCUS ZU DRUCKEN.
  *
  *       INPUT:               BS
  *
  *       OUTPUT:              PC_PRINTER
  *
  ******************************************************************
  *
  *       AENDERUNGEN:         VERSION 002 / 00.00.00 / NEHLS
  *                            XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
  *
  ******************************************************************

   ENVIRONMENT DIVISION.
   SPECIAL-NAMES.
       DECIMAL-POINT IS COMMA.

   INPUT-OUTPUT SECTION.
   FILE-CONTROL.

   DATA DIVISION.
   FILE SECTION.

   WORKING-STORAGE SECTION.

   01  WS-FELDER.

       05  Z-FELDER.
           10  Z-PGRNM         PIC  X(04) VALUE "U012".
           10  Z-VERS          PIC  9(04) COMP VALUE 001.

  *                                          BS-ZWISCHENSPEICHER
       05  Z-BS-BEREICH.
           10  Z-BS-ZEICHEN.
               15  Z-BS-ZEILEN PIC  X(80) OCCURS 25
                                          INDEXED BY IX-1.
           10  Z-BS-ATRIBUT    PIC  X(2000).
           10  Z-BS-LAENGE     PIC  X(02) COMP-X VALUE 2000.
           10  Z-BS-POS.
               15  Z-BS-ZEILE  PIC  X(01) COMP-X VALUE ZERO.
               15  Z-BS-SPALTE PIC  X(01) COMP-X VALUE ZERO.

   01  K-FELDER.
       05  K-COURI.
           10  FILLER          PIC  X(02) COMP-5 VALUE 11.
           10  FILLER          PIC  X(11) VALUE "Courier New".
       05  K-LDRAW.
           10  FILLER          PIC  X(02) COMP-5 VALUE 11.
           10  FILLER          PIC  X(11) VALUE "MS LineDraw".

  *
  *    DRUCKERDEFINITIONEN FšR PC_PRINTER - ROUTINEN   32-BIT
  *
   01  PRN-INFO-1 IS TYPEDEF.
       03  PI-STRUCT-SIZE      PIC  X(04) COMP-5.
       03  HDC                 PIC  X(04) COMP-5.
       03  HPS                 PIC  X(04) COMP-5.
       03  ORIENTATION         PIC  X(04) COMP-5.
       03  ROWS                PIC  X(04) COMP-5.
       03  COLS                PIC  X(04) COMP-5.
       03  ROWS-LEFT           PIC  X(04) COMP-5.
       03  MAX-HORIZ           PIC  X(04) COMP-5.
       03  MAX-VERT            PIC  X(04) COMP-5.
       03  MIN-HORIZ           PIC  X(04) COMP-5.
       03  MIN-VERT            PIC  X(04) COMP-5.
       03  CURR-HORIZ          PIC  X(04) COMP-5.
       03  CURR-VERT           PIC  X(04) COMP-5.
       03  COPIES              PIC  9(04) COMP-5.
       03  QUALITY             PIC  9(04) COMP-5.
       03  COLOR               PIC  9(02) COMP-5.
       03  RESERVED1           PIC  X(01) COMP-5.
       03  DRIVER-VER          PIC  9(04) COMP-5.
       03  PNAME.
           05  CBSIZE          PIC  X(04) COMP-5.
           05  BUFFER          POINTER.
       03  PTYPE.
           05  CBSIZE          PIC  X(04) COMP-5.
           05  BUFFER          POINTER.
       03  PDEVICE.
           05  CBSIZE          PIC  X(04) COMP-5.
           05  BUFFER          POINTER.
       03  PLOCATION.
           05  CBSIZE          PIC  X(04) COMP-5.
           05  BUFFER          POINTER.
       03  PCOMMENT.
           05  CBSIZE          PIC  X(04) COMP-5.
           05  BUFFER          POINTER.
       03  PPAPERSIZE.
           05  CBSIZE          PIC  X(04) COMP-5.
           05  BUFFER          POINTER.

   01  PRN-NAME.
       05  PRN-DAT-L           PIC  X(02) COMP-5 VALUE 0.
       05  PRN-DAT-N           PIC  X(20) VALUE SPACE.
   01  PRN-FONT.
       10  FILLER              PIC  X(02) COMP-5 VALUE 11.
       10  FILLER              PIC  X(11) VALUE "Courier New".
   01  PRN-FON-S               PIC  X(02) COMP-5 VALUE 0.
   01  PRN-FON-A               PIC  X(02) COMP-5 VALUE 0.
   01  PRN-FON-1               PIC  X(02) COMP-5 VALUE 1.
   01  PRN-INFO                PRN-INFO-1.
   01  PRN-STAT                PIC  X(04) COMP-5 VALUE 1.
   01  PRN-CONT                PIC  X(04) COMP-5 VALUE 2.
   01  PRN-HANDL               PIC  X(04) COMP-5.
   01  PRN-BUFFER-L            PIC  X(02) COMP-5 VALUE 88.
   01  PRN-BUFFER.
       05  PRN-BUF             PIC  X(01) OCCURS 256
                                          INDEXED BY IX-B.
   01  FILLER REDEFINES PRN-BUFFER.
       05  FILLER              PIC  X(08).
       05  PRN-BUF-80          PIC  X(248).
   01  PRN-TYPE                PIC  X(255).
   01  PRN-DEVICE              PIC  X(255).
   01  PRN-LOCATION            PIC  X(255).
   01  PRN-COMMENT             PIC  X(255).
   01  PRN-PAPERSIZE           PIC  X(255).

   PROCEDURE DIVISION.

  *    A-00  :  HAUPTSTEUERLEISTE

   A-00 SECTION.
   A-10.
  *                                          SICHERN BS-INHALT
       CALL "CBL_READ_SCR_CHATTRS" USING
                               Z-BS-POS
                               Z-BS-ZEICHEN
                               Z-BS-ATRIBUT
                               Z-BS-LAENGE.
  *                                          DRUCKEN
       PERFORM W-00.
   A-99.
       EXIT PROGRAM.

  *    W-00  :  DRUCKEN

   W-00 SECTION.
   W-00-10.
       MOVE "Bildschirmkopie"  TO PRN-DAT-N.
       MOVE 15                 TO PRN-DAT-L.

       CALL "PC_PRINTER_OPEN"     USING BY REFERENCE PRN-HANDL
                                        BY REFERENCE PRN-NAME
                                        BY VALUE 1 SIZE 2
                                        BY VALUE 0
                                        RETURNING PRN-STAT.

       IF PRN-STAT           > ZERO          GO TO W-00-99.

       MOVE K-LDRAW            TO PRN-FONT.
       MOVE 10                 TO PRN-FON-S.
       MOVE ZERO               TO PRN-FON-A.
       MOVE SPACE              TO PRN-BUFFER.
       MOVE 88                 TO PRN-BUFFER-L.
  *                                          SCHRIFTART EINSTELLEN
       PERFORM W-50.
  *                                          ZEILENVORSCHUB
       PERFORM W-10.
       PERFORM W-10.
       PERFORM W-10.

       PERFORM W-20 VARYING IX-1 FROM 1 BY 1 UNTIL IX-1 > 24.
   W-00-90.
       CALL "PC_PRINTER_CLOSE"    USING BY REFERENCE PRN-HANDL
                                        RETURNING PRN-STAT.
   W-00-99.
       EXIT.

  *    W-10  :  ZEILENVORSCHUB

   W-10 SECTION.
   W-10-10.
       CALL "PC_PRINTER_CONTROL"  USING BY REFERENCE PRN-HANDL
                                        BY VALUE 4 SIZE 2
                                        RETURNING PRN-STAT.

       IF PRN-STAT           > ZERO     PERFORM W-90.
   W-10-99.
       EXIT.

  *    W-20  :  ZEILEN AUSGEBEN

   W-20 SECTION.
   W-20-10.
       MOVE Z-BS-ZEILEN (IX-1) TO PRN-BUF-80.
  *                                            BUFFER AUSGEBEN
       PERFORM W-40.
  *                                            ZEILENVORSCHUB
       PERFORM W-10.
   W-20-99.
       EXIT.

  *    W-40  :  BUFFER AUSGEBEN

   W-40 SECTION.
   W-40-10.
       CALL "PC_PRINTER_WRITE"    USING BY REFERENCE PRN-HANDL
                                        BY REFERENCE PRN-BUFFER
                                        BY VALUE PRN-BUFFER-L
                                        RETURNING PRN-STAT.

       IF PRN-STAT           > ZERO     PERFORM W-90.
   W-40-99.
       EXIT.

  *    W-50  :  WECHSEL DER SCHRIFTART

   W-50 SECTION.
   W-50-10.
       CALL "PC_PRINTER_SET_FONT" USING BY REFERENCE PRN-HANDL
                                        BY REFERENCE PRN-FONT
                                        BY VALUE PRN-FON-S
                                        BY VALUE PRN-FON-A
                                        RETURNING PRN-STAT.

       IF PRN-STAT           > ZERO     PERFORM W-90.
   W-50-99.
       EXIT.

  *    W-90  :  ABBRUCH

   W-90 SECTION.
   W-90-10.
       EVALUATE PRN-STAT
           WHEN = 1
                MOVE "Drucker kann nicht geöffnet werden."
                               TO M0008-TEXT
           WHEN = 2
                MOVE "Falscher Drucker Controlcode."
                               TO M0008-TEXT
           WHEN = 3
                MOVE "Kein Drucker (Handle)."
                               TO M0008-TEXT
           WHEN = 4
                MOVE "Nicht genügend Speicher."
                               TO M0008-TEXT
           WHEN = 5
                MOVE "Fehler beim öffnen der Druckdatei."
                               TO M0008-TEXT
           WHEN = 6
                MOVE "Nicht genügend Plattenplatz (Spool)"
                               TO M0008-TEXT
           WHEN = 7
                MOVE "Druckjob abgebrochen."
                               TO M0008-TEXT
           WHEN = 8
                MOVE "Falsche Druckerinformation."
                               TO M0008-TEXT
           WHEN = 9
                MOVE "Kein Standarddrucker definiert."
                               TO M0008-TEXT
           WHEN = 10
                MOVE "Dialogfehler."
                               TO M0008-TEXT
           WHEN = 11
                MOVE "Schreibfehler."
                               TO M0008-TEXT
           WHEN = 12
                MOVE "Keine Schriftart für den Drucker vorhanden."
                               TO M0008-TEXT
           WHEN = 13
                MOVE "Schriftart nicht installiert."
                               TO M0008-TEXT
           WHEN = 14
                MOVE "Abbruch durch Anwender."
                               TO M0008-TEXT
           WHEN = 15
                MOVE " "       TO M0008-TEXT
           WHEN = 16
                MOVE " "       TO M0008-TEXT
           WHEN = 17
                MOVE " "       TO M0008-TEXT
           WHEN = 18
                MOVE "Kann Bitmap nicht laden."
                               TO M0008-TEXT
           WHEN = 19
                MOVE "Falsche Bitmap-ID."
                               TO M0008-TEXT
           WHEN = 20
                MOVE "Kann Bitmap nicht löschen."
                               TO M0008-TEXT
           WHEN = 21
                MOVE "Fehler beim Druck der Bitmap."
                               TO M0008-TEXT
           WHEN = 22
                MOVE "Falscher Parameter."
                               TO M0008-TEXT
           WHEN = 23
                MOVE "Interner Fehler."
                               TO M0008-TEXT
           WHEN OTHER
                MOVE "Unbekannter Druckerfehler."
                               TO M0008-TEXT
       END-EVALUATE.

       DISPLAY ....... Fehlermeldung ausgeben ...........

  *                                     DRUCK ABBRECHEN UND
  *                                     DRUCKERSCHLIESSEN
       CALL "PC_PRINTER_CONTROL"  USING BY REFERENCE PRN-HANDL
                                        BY VALUE 1 SIZE 2
                                        RETURNING PRN-STAT.
       EXIT PROGRAM.
   W-90-99.
       EXIT.


...