Adattare un programma Cobol per la stampa in Windows

Altre pagine:	1] Gestire le stampanti		3] Esempio pratico
	2] Fasi preparative		4] Adattare i programmi esistenti

Adattare un programma di stampa tradizionale alle stampanti di Windows.

In questa pagina vorrei proporre una possibile soluzione per poter utilizzare le stampanti di Windows con programmi RM/COBOL tradizionali.
Generalmente si rende necessario un intervento minimo sui programmi sorgente.
Questo a dipendenza da come è stato scritto il programma di stampa.
Programmi in cui è stato fatto uso dei LINAGE o WRITE AFTER ZERO eccetera richiede qualche modifica in più. Di regola posso dire che si tratta di comandi poco utilizzati.
Gli esempi di programma realizzati per questa pagina servono solo per spiegare il principio che ho adottato per poter utilizzare i miei circa 300 programmi di stampa con una qualsiasi stampante di Windows.

La soluzione

Consiste nel ridirezionare la stampa su di un file ed, in seguito, stamparlo usando un programma che include le routines per poter accedere alle stampanti di Windows.
Questo programma, meglio detto modulo, oltre ad offrire la possibilità di scelta della stampante da utilizzare, svolge le seguenti funzioni:

Processo di stampa differenziato in funzione della tecnologia della stampante.
Soppressione della stampa della prima pagina bianca.
Eliminazione dei caratteri non stampabili per le stampanti generiche.
Conversione del set di caratteri.

Il programma di stampa classico

Questo potrebbe essere un programma di stampa che deve essere adattato.
Alla stampante viene attribuito il nome PRINTER.

LP-EX-02.CBL

000000 IDENTIFICATION DIVISION.
000001*
000002*
000003*                 Stampa di un file testo
000004*
000005 PROGRAM-ID.         LP-EX-02.
000006*
000007*
000008*
000009 ENVIRONMENT DIVISION.
000010 CONFIGURATION SECTION.
000011 SOURCE-COMPUTER.  RMC10.
000012 OBJECT-COMPUTER.  RMC10.
000013*
000014*
000015 INPUT-OUTPUT SECTION.
000016 FILE-CONTROL.
000017*
000018*
000019     SELECT F01        ASSIGN            DISC
000020                       "Testo.txt"
000021                       ORGANIZATION LINE SEQUENTIAL
000022                       ACCESS            SEQUENTIAL
000023                       STATUS            ERF01.
000024*
000025*
000026*
000027*
000028     SELECT LO          ASSIGN PRINTER
000029                        "PRINTER".
000030*
000031/
000032 DATA DIVISION.
000033 FILE SECTION.
000034*                      FILE DI INPUT
000035*
000036 FD           F01      RECORD VARYING FROM 1 TO 128
000037                       DEPENDING ON LUNGO
000038                       LABEL RECORD   STANDARD.
000039*
000040 1   F01REC              PIC X(128).
000041 1   F01REC-MIN          PIC X.
000042*
000043*
000044*
000045 FD           LO       LABEL RECORD OMITTED.
000046*
000047 1   RIGA                PIC X(132).
000048*
000049/
000050 WORKING-STORAGE SECTION.
000051*
000052*
000053 1   PROGRAMMA.
000054  2  FILLER           PIC X(08)        VALUE "LP-EX-02".
000055  2  FILLER           PIC X            VALUE "-".
000056  2  COMPILATO        PIC 9(6).
000057*
000058 78  DATE-COMP                         VALUE IS DATE-COMPILED.
000059*
000060*
000061*      Campi riservati per la gestione degli status files.
000062*
000063 1    TXE.
000064  2   FILLER     PIC X(14)       VALUE "Error on file ".
000065  2   FILEN      PIC X(11).  *> Nome del file
000066*
000067 1    TXE1.
000068  2   FILLER     PIC X(14)       VALUE "Status is  ".
000069  2   FILESTEX.
000070  3   FILEST     PIC XX.     *> Status primario
000071  3   FILLER     PIC XX.     *> Status secondario
000072*
000073 1    TXS        PIC X(80)       VALUE SPACES.
000074*      Costanti & campi di lavori
000075*
000076 1    WC         PIC XX          VALUE "00".
000077 1    SLF        PIC  9.     *> Per la gestione del record lock
000078 1    A1         PIC  X.
000079 1    ZZ         PIC 9(2).   *> Contatore righe
000080*
000081*      Campi specifici ogni ogni file
000082*
000083 1    LUNGO      PIC 9(4).
000084 1    ERF01      PIC XX.
000085*
000086/
000087 PROCEDURE DIVISION.
000088*
000089 DECLARATIVES.
000090*
000091 DEC01 SECTION.
000092     USE AFTER ERROR PROCEDURE F01.
000093 DEC0101.
000094     MOVE ERF01        TO FILEST.
000095     MOVE "Testo.txt"  TO FILEN.
000096 END DECLARATIVES.
000097/
000098*
000099 HAUPT SECTION.
000100*
000101*
000102*             INIZALIZZARE PROGRAMMA
000103 A-1.
000104     DISPLAY PROGRAMMA           LINE 1 POSITION 1 ERASE.
000105     DISPLAY "Stampa file"       LINE 1 POSITION 30.
000106*
000107     MOVE 90 TO ZZ.
000108*           
000109 A-2.
000110     MOVE WC TO FILEST.
000111     OPEN INPUT F01.
000112     PERFORM TR THRU TRE.
000113*
000114     OPEN OUTPUT LO.
000115*
000116 A-3.
000117     MOVE SPACES TO F01REC.
000118*
000119     MOVE WC TO FILEST.
000120     READ F01.
000121     IF FILEST = "10" GO A-9.
000122     IF FILEST = "97" GO A-3.
000123     PERFORM TR THRU TRE.
000124*
000125     IF ZZ > 40
000126            WRITE RIGA FROM F01REC AFTER PAGE
000127            MOVE 0 TO ZZ 
000128        ELSE
000129            WRITE RIGA FROM F01REC AFTER 1.
000130*
000131     ADD 1 TO ZZ.
000132*           
000133     GO A-3.
000134*
000135 A-9.
000136     MOVE WC TO FILEST.
000137     CLOSE F01.
000138     PERFORM TR THRU TRE.
000139*
000140     CLOSE LO.
000141 A-99.
000142     GOBACK.
000143/
000144*        Routine controllo status file I-O
000145 TR.
000146      MOVE 0 TO SLF.
000147      IF FILEST = WC GO TRE.
000148      CALL "c$rerr"  USING FILESTEX.
000149*
000150      DISPLAY TXS LINE 18 POSITION 2 SIZE 25
000151              TXS LINE 19 POSITION 2 SIZE 25
000152              TXE LINE 18 POSITION 2 TXE1 LINE 19 POSITION 2.
000153*
000154      ACCEPT A1 LINE 19 POSITION 30 PROMPT.
000155*
000156      DISPLAY TXS LINE 18 POSITION 2 SIZE 25
000157              TXS LINE 19 POSITION 2 SIZE 25.
000158*
000159      IF A1      = "$" GOBACK.
000160      IF FILEST = "99" MOVE 1 TO SLF GO TRE. 
000161      IF A1 NOT = "#"                GO TR.
000162 TRE.
000163      EXIT.
000164*                   *** FINE LP-EX-02.CBL ***

La modifica.

Consiste unicamente nella sostituzione del nome esterno della periferica PRINTER in un nome di un file
Per questo esempio è stato dato il nome LISTA.SPOOL.
Da questo momento l’output generato da questo programma viene inviato al file LISTA.SPOOL.

LP-EX-03.CBL

000000 IDENTIFICATION DIVISION.
000001*
000002*
000003*               Stampa di un file testo su spool-file
000004*
000005 PROGRAM-ID.         LP-EX-03.
000006*
000007*
000008*
000009 ENVIRONMENT DIVISION.
000010 CONFIGURATION SECTION.
000011 SOURCE-COMPUTER.  RMC10.
000012 OBJECT-COMPUTER.  RMC10.
000013*
000014*
000015 INPUT-OUTPUT SECTION.
000016 FILE-CONTROL.
000017*
000018*
000019     SELECT F01        ASSIGN            DISC
000020                       "Testo.txt"
000021                       ORGANIZATION LINE SEQUENTIAL
000022                       ACCESS            SEQUENTIAL
000023                       STATUS            ERF01.
000024*
000025*
000026*
000027*
000028     SELECT LO          ASSIGN PRINTER
000029                        "LISTA.SPOOL".  *> STAMPA SU FILE 
000030*
000031/
000032 DATA DIVISION.
000033 FILE SECTION.
000034*                      FILE DI INPUT
000035*
000036 FD           F01      RECORD VARYING FROM 1 TO 128
000037                       DEPENDING ON LUNGO
000038                       LABEL RECORD   STANDARD.
000039*
000040 1   F01REC              PIC X(128).
000041 1   F01REC-MIN          PIC X.
000042*
000043*
000044*
000045 FD           LO       LABEL RECORD OMITTED.
000046*
000047 1   RIGA                PIC X(132).
000048*
000049/
000050 WORKING-STORAGE SECTION.
000051*
000052*
000053 1   PROGRAMMA.
000054  2  FILLER           PIC X(08)        VALUE "LP-EX-02".
000055  2  FILLER           PIC X            VALUE "-".
000056  2  COMPILATO        PIC 9(6).
000057*
000058 78  DATE-COMP                         VALUE IS DATE-COMPILED.
000059*
000060*
000061*      Campi riservati per la gestione degli status files.
000062*
000063 1    TXE.
000064  2   FILLER     PIC X(14)       VALUE "Error on file ".
000065  2   FILEN      PIC X(11).  *> Nome del file
000066*
000067 1    TXE1.
000068  2   FILLER     PIC X(14)       VALUE "Status is  ".
000069  2   FILESTEX.
000070  3   FILEST     PIC XX.     *> Status primario
000071  3   FILLER     PIC XX.     *> Status secondario
000072*
000073 1    TXS        PIC X(80)       VALUE SPACES.
000074*      Costanti & campi di lavori
000075*
000076 1    WC         PIC XX          VALUE "00".
000077 1    SLF        PIC  9.     *> Per la gestione del record lock
000078 1    A1         PIC  X.
000079 1    ZZ         PIC 9(2).   *> Contatore righe
000080*
000081*      Campi specifici ogni ogni file
000082*
000083 1    LUNGO      PIC 9(4).
000084 1    ERF01      PIC XX.
000085*
000086/
000087 PROCEDURE DIVISION.
000088*
000089 DECLARATIVES.
000090*
000091 DEC01 SECTION.
000092     USE AFTER ERROR PROCEDURE F01.
000093 DEC0101.
000094     MOVE ERF01        TO FILEST.
000095     MOVE "Testo.txt"  TO FILEN.
000096 END DECLARATIVES.
000097/
000098*
000099 HAUPT SECTION.
000100*
000101*
000102*             INIZALIZZARE PROGRAMMA
000103 A-1.
000104     DISPLAY PROGRAMMA           LINE 1 POSITION 1 ERASE.
000105     DISPLAY "Stampa file"       LINE 1 POSITION 30.
000106*
000107     MOVE 90 TO ZZ.
000108*           
000109 A-2.
000110     MOVE WC TO FILEST.
000111     OPEN INPUT F01.
000112     PERFORM TR THRU TRE.
000113*
000114     OPEN OUTPUT LO.
000115*
000116 A-3.
000117     MOVE SPACES TO F01REC.
000118*
000119     MOVE WC TO FILEST.
000120     READ F01.
000121     IF FILEST = "10" GO A-9.
000122     IF FILEST = "97" GO A-3.
000123     PERFORM TR THRU TRE.
000124*
000125     IF ZZ > 40
000126            WRITE RIGA FROM F01REC AFTER PAGE
000127            MOVE 0 TO ZZ 
000128        ELSE
000129            WRITE RIGA FROM F01REC AFTER 1.
000130*
000131     ADD 1 TO ZZ.
000132*           
000133     GO A-3.
000134*
000135 A-9.
000136     MOVE WC TO FILEST.
000137     CLOSE F01.
000138     PERFORM TR THRU TRE.
000139*
000140     CLOSE LO.
000141 A-99.
000142     GOBACK.
000143/
000144*        Routine controllo status file I-O
000145 TR.
000146      MOVE 0 TO SLF.
000147      IF FILEST = WC GO TRE.
000148      CALL "c$rerr"  USING FILESTEX.
000149*
000150      DISPLAY TXS LINE 18 POSITION 2 SIZE 25
000151              TXS LINE 19 POSITION 2 SIZE 25
000152              TXE LINE 18 POSITION 2 TXE1 LINE 19 POSITION 2.
000153*
000154      ACCEPT A1 LINE 19 POSITION 30 PROMPT.
000155*
000156      DISPLAY TXS LINE 18 POSITION 2 SIZE 25
000157              TXS LINE 19 POSITION 2 SIZE 25.
000158*
000159      IF A1      = "$" GOBACK.
000160      IF FILEST = "99" MOVE 1 TO SLF GO TRE. 
000161      IF A1 NOT = "#"                GO TR.
000162 TRE.
000163      EXIT.
000164*                   *** FINE LP-EX-03.CBL ***

Il modulo per la stampa dello spool-file.

In questo programma troviamo le librerie e le routine che sono presentate nelle pagine precendenti.
Da notare che il file di input (LISTA.SPOOL) viene definito come ORGANIZATION BINARY SEQUENTIAL.
Questo poichè dobbiamo leggere byte per byte alla ricerca dei caratteri di controllo esadecimali 0A, 0D e 0C.
Il nome esterno della stampante è PRINTER?. Questo per fare in modo che al momento dell’open venga aperta la finestra di scelta stampante.

LP-SPOOL.CBL

000000 IDENTIFICATION DIVISION.
000001*
000002 PROGRAM-ID.  LP-SPOOL.
000003*
000004*              STAMPA DI UNO SPOOL FILE
000005*              ------------------------
000006*
000007*
000008*
000009 ENVIRONMENT DIVISION.
000010 CONFIGURATION SECTION.
000011 SOURCE-COMPUTER.  RMC10.
000012 OBJECT-COMPUTER.  RMC10.
000013*
000014*
000015 INPUT-OUTPUT SECTION.
000016 FILE-CONTROL.
000017*
000018*
000019     SELECT F01        ASSIGN            DISC
000020                       "LISTA.SPOOL"
000021                       ORGANIZATION BINARY SEQUENTIAL
000022                       STATUS            ERF01.
000023*
000024*
000025     SELECT LO         ASSIGN PRINTER
000026                       "PRINTER?".
000027*
000028*
000029/
000030 DATA DIVISION.
000031 FILE SECTION.
000032*
000033*
000034*                SPOOL FILE IN INPUT
000035*     
000036 FD          F01
000037                       LABEL RECORD STANDARD.
000038*
000039*
000040 1   F01REC     PIC X.
000041*
000042*
000043*
000044 FD           LO       LABEL RECORD OMITTED.
000045*
000046*
000047 1   RIGA         PIC X(132).
000048 1   RIGAX.
000049  2  RIGA-CHAR    PIC X       OCCURS 132.
000050*
000051/
000052 WORKING-STORAGE SECTION.
000053*
000054*
000055*
000056*
000057 1   PROGRAMMA.
000058  2  FILLER           PIC X(09) VALUE "LP-SPOOL-".
000059  2  PGRVER           PIC X(02) VALUE "01".
000060  2  FILLER           PIC X     VALUE "-".
000061  2  COMPILATO        PIC 9(6).
000062*
000063 78  DATE-COMP                         VALUE IS DATE-COMPILED.
000064*
000065*
000066*      Campi riservati per la gestione degli status files.
000067*
000068 1    TXE.
000069  2   FILLER     PIC X(14)       VALUE "Error on file ".
000070  2   FILEN      PIC X(11).  *> Nome del file
000071*
000072 1    TXE1.
000073  2   FILLER     PIC X(14)       VALUE "Status is  ".
000074  2   FILESTEX.
000075  3   FILEST     PIC XX.     *> Status primario
000076  3   FILLER     PIC XX.     *> Status secondario
000077*
000078 1    TXS        PIC X(80)       VALUE SPACES.
000079*      Costanti & campi di lavori
000080*
000081 1    WC         PIC XX          VALUE "00".
000082 1    SLF        PIC  9.      *> Per la gestione del record lock
000083 1    A1         PIC  X.
000084*
000085*      Campi specifici ogni ogni file
000086*
000087 1    LUNGO      PIC 9(4).
000088 1    ERF01      PIC XX.
000089*
000090*              CAMPI DI AIUTO PER STAMPE
000091*              ------------------------- 
000092*
000093 01 WS-ARGS.
000094     03 WS-X                     PIC 9(9)V9(3) VALUE ZERO.
000095     03 WS-Y                     PIC 9(9)V9(3) VALUE ZERO.
000096     03 WS-X-SIZE                PIC 9(9)V9(3) VALUE ZERO.
000097     03 WS-Y-SIZE                PIC 9(9)V9(3) VALUE ZERO.
000098     03 Point-Size               Pic 9(2)      Value 12.
000099     03 WS-MODE                  PIC X.
000100        88 WS-MODE-ABSOLUTE      VALUE "A".
000101        88 WS-MODE-RELATIVE      VALUE "R".
000102     03 WS-UNITS                 PIC X.
000103        88 WS-UNITS-INCHES       VALUE "I".
000104        88 WS-UNITS-CHARACTERS   VALUE "C".
000105        88 WS-UNITS-METRIC       VALUE "M".
000106        88 WS-UNITS-DEVICE       VALUE "D".
000107     03 WS-BOX                   PIC X.
000108        88 WS-DRAW-BOX           VALUE "Y" WHEN FALSE "N".
000109     03 WS-SHADE                 PIC X     VALUE "N".
000110        88 WS-SHADE-BOX          VALUE "Y" WHEN FALSE "N".
000111     03 WS-CLEAR                 PIC X.
000112        88 WS-CLEAR-FLAG         VALUE "Y" WHEN FALSE "N".
000113     03 WS-INCREMENT             PIC 9(3)  VALUE ZERO.
000114     03 WS-PERCENT               PIC 9(3)  VALUE ZERO.
000115     03 WS-RETURN                PIC S9(4) COMP-1 VALUE ZERO.
000116     03 Ws-Line       PIC 9(2)                   VALUE 00.
000117     03 Ws-SizeWidth  PIC 99V99 Binary           VALUE 00.
000118     03 Ws-SizeHeight PIC 99V99 Packed-Decimal   VALUE 00.
000119*
000120*
000121*
000122*        VALORI PER LA STAMPANTE SELEZIONATA
000123*        -----------------------------------
000124*
000125*          COSTATNTI E VARIABILI 
000126*
000127 77  Units-Per-Inch          PIC 9(5)      VALUE 0.
000128 77  Millimeters-Per-Inch    PIC 9(5)V9(2) VALUE 25.4.
000129 1   MILLIMETRI              PIC 9(8)V9.
000130 1   CENTIMETRI              PIC 9(8)V99.
000131*
000132*           AREA NON STAMPABILE IN MM
000133*
000134 1   BO-AREA-MM              PIC 9(5)V9(3).  *> ORIZZINTALE
000135 1   BV-AREA-MM              PIC 9(5)V9(3).  *> VERTICALE
000136*
000137*           AREA STAMPABILE IN MM
000138*
000139 1   AREA-STAMPA-OR          PIC 9(5)V9(3).
000140 1   AREA-STAMPA-VE          PIC 9(5)V9(3).
000141*
000142*           FORMATO CARTA IN MM
000143*
000144 1   FORMATO-FOGLIO-OR        PIC 9(5)V9(3).
000145 1   FORMATO-FOGLIO-VE        PIC 9(5)V9(3).
000146*
000147*
000148*           Posizioni e indicazioni per la stampa
000149*
000150 1   PUNTI-CARATTERE          PIC 9(2).
000151*
000152 1   TXT-STANDARD.
000153  2  MARGINE-SINISTRO         PIC 99V99.
000154  2  MARGINE-TOP              PIC 99V99.
000155  2  AREA-MAX-VE              PIC 999V9.
000156  2  CONTRASTO                PIC 9(4).
000157  2  ORIENTAMENTO             PIC X.
000158*
000159 1   LF-CONTRASTO             PIC 9(3) BINARY (2).        
000160 1   LF-POSIZIONE             PIC 9(3)V999.
000161*       
000162*
000163*
000164 1   FL-ABORT                 PIC 9.
000165 1   FL-PRIMA-PAGINA          PIC X.
000166 1   FL-LP-STREAM             PIC 9.
000167*
000168*
000169 1   CONTATORI.
000170  2  P1                       PIC 9(3).
000171  2  P2                       PIC 9(3).
000172  2  P3                       PIC 9(3).
000173  2  P9                       PIC 9(3).
000174  2  P10                      PIC 9(3).
000175  2  P11                      PIC 9(3).
000176  2  LZ                       PIC 9(3).
000177  2  FL-PRIMO                 PIC 9.
000178  2  FL-PAGE                  PIC 9.
000179  2  FL-EMPTY                 PIC 9.
000180  2  FL-CANCEL                PIC 9.
000181  2  FL-DRAW-LINE             PIC 9.
000182  2  CONTA-RIGA               PIC 9(6).
000183  2  CONTA-PAGINA             PIC 9(4).
000184* 
000185 1   LAST-CHAR                PIC X.
000186 1   SAVE-RIGA                PIC X(132).
000187*
000188*                 LIBRERIE STANDARD DI RM/COBOL 
000189*
000190 COPY "windefs.cpy".
000191 COPY "printdlg.cpy".    
000192 COPY "devcaps.cpy".
000193 COPY "logfont.cpy".
000194 COPY "txtmtric.cpy".
000195*            
000196/                                       
000197 PROCEDURE DIVISION.
000198*
000199 DECLARATIVES.
000200*
000201 DEC01 SECTION.
000202     USE AFTER ERROR PROCEDURE F01.
000203 DEC0101.
000204     MOVE ERF01        TO FILEST.
000205     MOVE "LISTA.SPOOL"  TO FILEN.
000206 END DECLARATIVES.
000207*
000208*
000209*
000210/
000211 HAUPT SECTION.
000212*
000213 A-0.
000214     MOVE DATE-COMP     TO COMPILATO
000215     DISPLAY PROGRAMMA LINE 1 POSITION 1 ERASE.
000216     DISPLAY 
000217     "ESEMPIO STAMPA SPOOL FILE"     LINE 1 POSITION 30
000218     "-------------------------"     LINE 2 POSITION 30.
000219*
000220*     Inizializzare i valori di impaginazione 
000221*     (i valori dei marigini sono espessi in centimetri)
000222*
000223     MOVE 1                           TO MARGINE-TOP.
000224     MOVE 1.75                        TO MARGINE-SINISTRO. 
000225     MOVE "O"                         TO ORIENTAMENTO.
000226*
000227*
000228*     Abilitare la visualizzazione estesa degli errori
000229*     (si potr inattivare questa riga all'uso produttivo)
000230*
000231     CALL "C$SetDevelopmentMode".       
000232*
000233*     Inizializza i campi della finestra di selezione stampante
000234*
000235     PERFORM INIT-DIALOGO THRU INIT-DIALOGO-E.
000236*      
000237*
000238 A-1.
000239*       
000240     MOVE WC TO FILEST. 
000241     OPEN INPUT F01. 
000242     PERFORM TR THRU TRE.      
000243*           
000244     OPEN OUTPUT LO.
000245*
000246*      Richiama la finestra seleziona stampante
000247*
000248     CALL "P$GETDIALOG" USING PRINTDIALOG.
000249     MOVE 0 TO FL-ABORT.
000250     EVALUATE FALSE
000251        WHEN PD-OKRETURN   MOVE 1 TO FL-ABORT *> Tasto annulla
000252     END-EVALUATE.
000253     IF FL-ABORT = 1                GO A-98.
000254*
000255 A-2.
000256*
000257*     Ricavare gli attributi della stampante scelta
000258*
000259*     Importante  la tecnologia (DC-TechnologyValue) ossia:
000260*
000261*     0 = Vector plotter 
000262*     1 = Raster display 
000263*     2 = Raster printer    (Matrici e Laser)
000264*     3 = Raster camera 
000265*     4 = Character stream  (Generiche, solo testo)
000266*     5 = Metafile 
000267*     6 = Display file 
000268*
000269*
000270     PERFORM LEGGI-DEVICE THRU LEGGI-DEVICE-E.
000271*
000272*    Reset ed initzalizzare font stampante   
000273*
000274     PERFORM INIT-FONT    THRU INIT-FONT-E.
000275*
000276*    Fissare i margini
000277*    
000278     PERFORM SET-HOR      THRU SET-HOR-E.
000279     PERFORM SET-VERT     THRU SET-VERT-E.
000280*
000281*    Caricare i font per questa stampa
000282*
000283     IF DC-TechnologyValue = 4 
000284             MOVE 1                        TO FL-LP-STREAM
000285             MOVE "Device Font 10cpi"      TO LF-FaceName
000286             MOVE 10                       TO PUNTI-CARATTERE
000287        ELSE     
000288             MOVE 0                        TO FL-LP-STREAM
000289             MOVE "Monospac821 BT"         TO LF-FaceName
000290             MOVE 8                        TO PUNTI-CARATTERE.           
000291
000292     PERFORM CARICA-FONT THRU CARICA-FONT-E.
000293*           
000294 A-3.
000295*
000296     INITIALIZE     CONTATORI.
000297     MOVE 1      TO CONTA-PAGINA.           
000298     MOVE SPACES TO RIGA F01REC.           
000299*
000300*
000301 A-4.
000302     MOVE F01REC TO LAST-CHAR.
000303     MOVE SPACES TO F01REC.
000304*
000305     MOVE WC TO FILEST.
000306     READ F01.
000307     IF FILEST = "10" GO A-98.
000308     PERFORM TR THRU TRE.
000309*
000310*
000311     IF F01REC = H"0C" AND FL-PRIMO = 0 MOVE 1 TO FL-PRIMO
000312                       GO A-4.
000313     IF FL-PRIMO = 0   MOVE 1 TO FL-PRIMO.
000314*
000315     IF F01REC = H"0A" AND LAST-CHAR = H"0C" MOVE 1 TO LZ
000316                       GO A-11.
000317*
000318     IF F01REC = H"0C" MOVE 1 TO FL-PAGE
000319                       GO A-4.
000320*
000321     IF F01REC = H"0A" ADD  1 TO LZ
000322                       GO A-4.
000323*
000324     IF F01REC = H"0D" GO A-5.
000325*
000326     ADD 1 TO P1.
000327     IF P1 > 132 GO A-4.
000328     MOVE F01REC TO RIGA(P1: 1).
000329     GO A-4.
000330*
000331*         STAMPA RIGA DOPO LZ LINEE
000332 A-5.
000333*
000334     IF FL-PAGE      = 1    GO A-8.
000335*
000336 A-6.
000337*
000338     IF FL-LP-STREAM = 1 PERFORM SOLO-ASCII THRU SOLO-ASCII-E.
000339*
000340*
000341     WRITE RIGA  AFTER LZ.
000342*
000343     ADD LZ TO CONTA-RIGA.
000344*           
000345
000346*
000347 A-7.
000348     MOVE 0      TO P1 LZ.
000349*
000350     GO A-13.
000351*
000352*
000353*         RIGA A NUOVA PAGINA
000354 A-8.  
000355*
000356     IF FL-LP-STREAM = 1 PERFORM SOLO-ASCII THRU SOLO-ASCII-E
000357                         GO A-9.
000358*               
000359     MOVE RIGA   TO SAVE-RIGA.
000360     MOVE SPACES TO RIGA.
000361*
000362 A-9.
000363*        
000364     WRITE RIGA  AFTER PAGE.
000365*
000366     PERFORM SET-HOR      THRU SET-HOR-E.
000367     PERFORM SET-VERT     THRU SET-VERT-E.
000368*
000369     MOVE SAVE-RIGA TO RIGA.
000370*           
000371     WRITE RIGA  AFTER 0.
000372*
000373 A-10.
000374*       
000375     ADD 1 TO CONTA-PAGINA.
000376*           
000377     MOVE 0      TO P1 LZ FL-PAGE.
000378*
000379     GO A-13.
000380*
000381*         SOLO SALTO PAGINA
000382 A-11.
000383     MOVE SPACES TO RIGA.
000384*           
000385     WRITE RIGA  AFTER PAGE.
000386*
000387     ADD 1 TO CONTA-PAGINA.
000388*
000389     PERFORM SET-HOR      THRU SET-HOR-E.
000390     PERFORM SET-VERT     THRU SET-VERT-E.
000391*           
000392 A-12.
000393*
000394     MOVE 0      TO P1    FL-PAGE.
000395*
000396*
000397 A-13.
000398*
000399     MOVE SPACES TO RIGA.                      
000400     GO A-4.
000401*
000402*                   FINE DELLA STAMPA
000403*
000404 A-98.
000405*
000406     CLOSE LO.
000407*
000408     MOVE WC TO FILEST. 
000409     CLOSE F01. 
000410     PERFORM TR THRU TRE.
000411*
000412*                   
000413 A-99.
000414     CALL "P$EnableDialog".  *> Riabilita il dialogo
000415*           
000416     GOBACK.
000417/
000418*            CARICARE UN FONT SPECIFICO 
000419*
000420 CARICA-FONT.
000421*
000422*          RICAVA PRESTAZIONI DELLA STAMPANTE
000423*
000424     CALL "P$GetDeviceCapabilities" Using
000425                      DC-LogicalPixelsYParam, DC-LogPixelsY.
000426*
000427*          CALCOLO ALTEZZA 
000428     COMPUTE LF-Height Rounded =
000429       - ((PUNTI-CARATTERE * Dc-LogPixelsY)/ 72).
000430*            
000431* 
000432     CALL "P$SetFont" USING LogicalFont.
000433*
000434*          RICAVA CARATTERISTICHE DEL FONT
000435*
000436     CALL "P$GetTextMetrics"  Using TextMetrics.
000437*
000438*       AGGIUSTA L'ALTEZZA 
000439*
000440     Compute LF-Height = (LF-Height * TM-Height) /
000441      (TM-Height - TM-InternalLeading).
000442*
000443      CALL "P$SetFont" USING
000444                       LF-HeightParam, LF-Height.
000445*
000446*
000447 CARICA-FONT-E.
000448     EXIT.
000449/
000450*  
000451*        STABILIRE AREA DI STAMPA E LIMITI STAMPANTE
000452*
000453 LEGGI-DEVICE.
000454*
000455*
000456     CALL "P$GetDeviceCapabilities" USING DeviceCapabilities.
000457*
000458     Move  DC-LogPixelsX                  To Units-Per-Inch.
000459     Compute BO-AREA-MM = (DC-PhysicalOffsetX / Units-Per-Inch) *
000460                           Millimeters-Per-Inch.
000461*
000462     Move  DC-LogPixelsY                  To Units-Per-Inch.      
000463*
000464     Compute BV-AREA-MM = (DC-PhysicalOffsetY / Units-Per-Inch) *
000465                           Millimeters-Per-Inch.
000466*
000467     Compute AREA-STAMPA-OR  = (DC-HorzRes / Units-Per-Inch) *
000468                                Millimeters-Per-Inch.
000469*
000470     Compute AREA-STAMPA-VE = (DC-VertRes / Units-Per-Inch) *
000471                               Millimeters-Per-Inch.
000472*
000473     Compute FORMATO-FOGLIO-OR =
000474                           (DC-PhysicalWidth / Units-Per-Inch) *
000475                            Millimeters-Per-Inch.
000476*
000477     Compute FORMATO-FOGLIO-VE =
000478                           (DC-PhysicalHeight / Units-Per-Inch) *
000479                            Millimeters-Per-Inch.
000480*
000481 LEGGI-DEVICE-E.
000482     EXIT. 
000483/
000484*               INIZIALIZZARE DIALOGO / PARAMETRI STAMPA
000485*
000486 INIT-DIALOGO.
000487*
000488*  
000489      CALL "P$GETDIALOG" USING PRINTDIALOG.     
000490*
000491      MOVE 1                        TO DM-Copies.
000492      SET DM-CopiesField            TO FALSE. *> Solo 1 copia 
000493      SET DM-OrientationField       TO TRUE.
000494      SET PD-DisablePrintToFileFlag TO TRUE.  *> No stampa su file
000495      SET PD-NOSelectionFlag        TO TRUE.  *> No selezione da/a
000496*
000497      IF ORIENTAMENTO = "O"
000498           SET DM-OrientationIsLandscape TO TRUE
000499         ELSE
000500           SET DM-OrientationIsPortrait  TO TRUE. 
000501* 
000502      CALL "P$SetDialog" USING   PRINTDIALOG.
000503*
000504 INIT-DIALOGO-E.
000505      EXIT.
000506/
000507*       INITALIZZARE FONT AL PRIMO USO DELLA STAMPANTE
000508*
000509 INIT-FONT.
000510*       
000511     CALL "P$ClearFont".
000512*           
000513     INITIALIZE LogicalFont.
000514     SET LF-PitchIsFixed                       TO TRUE.
000515     SET LF-CharSetIsANSI                      TO TRUE.
000516     SET LF-Italic, LF-UnderLine, LF-Strikeout TO FALSE.
000517*
000518 INIT-FONT-E.
000519     EXIT.           
000520/
000521*                MARGINE VERTICALE SUPERIORE
000522 SET-VERT.
000523*
000524     IF FL-LP-STREAM = 1 GO SET-VERT-E.      *> Stampante generica
000525*
000526     COMPUTE MILLIMETRI = MARGINE-TOP * 10.
000527     SUBTRACT BV-AREA-MM FROM MILLIMETRI.
000528     COMPUTE CENTIMETRI  = MILLIMETRI / 10.
000529     Move CENTIMETRI              TO Ws-SizeHeight.
000530*
000531     COMPUTE MILLIMETRI = MARGINE-SINISTRO * 10.
000532     SUBTRACT BO-AREA-MM FROM MILLIMETRI.
000533     COMPUTE CENTIMETRI  = MILLIMETRI / 10.
000534*           
000535     Move CENTIMETRI              TO Ws-SizeWidth.
000536*
000537     Call "P$SetPosition" Using  Ws-SizeWidth
000538                                 Ws-SizeHeight
000539                                "Absolute"
000540                                "Metric".
000541 SET-VERT-E.
000542     EXIT.
000543*
000544*
000545*
000546/
000547*                FISSA MARGINE SINISTRO
000548 SET-HOR.
000549*
000550     IF FL-LP-STREAM = 1 GO SET-HOR-E.       *> Stampante generica
000551*
000552*
000553     COMPUTE MILLIMETRI = MARGINE-SINISTRO * 10.
000554     SUBTRACT BO-AREA-MM FROM MILLIMETRI.
000555     COMPUTE CENTIMETRI  = MILLIMETRI / 10.
000556*           
000557     Move CENTIMETRI              TO Ws-SizeWidth.
000558*
000559*         
000560     CALL "P$SetLeftMargin"  using WS-SizeWidth
000561                                   "Metric".
000562 SET-HOR-E.
000563     EXIT.         
000564/
000565*           LEVARE CARATTERI ESTRANEI PER STAMPANTE GENERICA
000566*
000567 SOLO-ASCII.
000568*
000569 01.
000570*
000571     MOVE 0 TO P11.
000572*
000573 02.
000574     ADD 1 TO P11.
000575     IF P11 > 132 GO SOLO-ASCII-E.
000576*
000577     IF RIGA-CHAR(P11) < H"20" OR RIGA-CHAR(P11) > H"7A"
000578               MOVE SPACES TO RIGA-CHAR(P11).
000579*
000580     GO 02.                                           
000581*
000582 SOLO-ASCII-E.
000583     EXIT.       
000584/
000585*        Routine controllo status file I-O
000586 TR.
000587      MOVE 0 TO SLF.
000588      IF FILEST = WC GO TRE.
000589      CALL "c$rerr"  USING FILESTEX.
000590*
000591      DISPLAY TXS LINE 18 POSITION 2 SIZE 25
000592              TXS LINE 19 POSITION 2 SIZE 25
000593              TXE LINE 18 POSITION 2 TXE1 LINE 19 POSITION 2.
000594*
000595      ACCEPT A1 LINE 19 POSITION 30 PROMPT.
000596*
000597      DISPLAY TXS LINE 18 POSITION 2 SIZE 25
000598              TXS LINE 19 POSITION 2 SIZE 25.
000599*
000600      IF A1 = "$" GOBACK.
000601      IF FILEST = "99" MOVE 1 TO SLF GO TRE. 
000602      IF A1 NOT = "#" GO TR.
000603 TRE.
000604      EXIT.
000605*                   *** FINE LP-SPOOL.CBL ***

Come prelevare questi codici

Pagina precedente

Cobol in pratica

Adattare un programma di stampa tradizionale alle stampanti di Windows.

La soluzione

Il programma di stampa classico

La modifica.

Il modulo per la stampa dello spool-file.