isCOBOL Evolve : Appendices : Library Routines : WIN$PRINTER : WINPRINT-SET-HEADER-FOOTER
WINPRINT-SET-HEADER-FOOTER
The WINPRINT-SET-HEADER-FOOTER function specifies the information to be printed on every page header and footer.
Syntax:
 CALL "WIN$PRINTER" USING WINPRINT-SET-HEADER-FOOTER 
                          headerContent
                          footerContent
                         [font]
                   GIVING returnCode
Parameters:
WINPRINT-SET-HEADER-FOOTER
Constant
 
headerContent
PIC X(n)
Specifies the text to be printed on the page header.
The following escape characters can be used inside this text:
 
&p = page number;
&P = total number of pages;
&b = the following information will be printed on the right side of the sheet;
&d = current date in short format according to the locale, e.g. 4/16/15;
&D = current date in long format according to the locale, e.g. April 16, 2015;
&u = name of the report;
&w = not handled;
&& = the character '&'
footerContent
PIC X(n)
Specifies the text to be printed on the page footer.
The following escape characters can be used inside this text:
 
&p = page number;
&P = total number of pages;
&b = the following information will be printed on the right side of the sheet;
&d = current date in short format according to the locale, e.g. 4/16/15;
&D = current date in long format according to the locale, e.g. April 16, 2015;
&u = name of the report;
&w = not handled;
&& = the character '&'
font
USAGE HANDLE OF FONT
Optional parameter.
Specifies the font handle to be used for the header and footer text. It should be previously loaded with the WFONT-GET-FONT or the WFONT-GET-CLOSEST-FONT function.
Do not destroy this handle before closing the print file.
Return code:
returnCode can be any signed numeric data item and provides additional information:
1
Operation successful.
WPRTERR-UNSUPPORTED
The WIN$PRINTER library routine is not supported.
WPRTERR-BAD-ARG
The WIN$PRINTER library routine has been called with bad parameters.
Example:
The following code will print page count information on the bottom right of each page.
 move "&bPage &p of &P" to footer-data.
 call "win$printer"  using winprint-set-header-footer
                           header-data, footer-data.