Shareware Overload/ShartewareOverload.cdr/database/prtdrv.zip/PRTSETUP.PRG

Text File | 1987-03-04 | 6KB | 226 lines

* Program...: PrtSetup.PRG
* Author....: Kent Irwin
* Date......: May 1, 1987
* Version...: dBASE III PLUS
* Note(s)...: Program to store printer control codes to a memory file.
*
*
SET TALK OFF
SET BELL OFF
SET PROCEDURE TO PrtSetup
blanks = SPACE(30)
row    = 24
STORE blanks TO p_six, p_eight, p_10cpi, p_12cpi, p_name, p_cmpr_on,;
                p_cmpr_off, p_nlq_on, p_nlq_off, p_bold_on, p_bold_off,;
                p_und_on, p_und_off, p_ital_on, p_ital_off, p_emph_on

STORE blanks TO p_emph_off, p_dbl_on, p_dbl_off, p_expn_on, p_expn_off,;
                p_supr_on, p_supr_off, p_sub_on, p_sub_off, p_msb_on,p_msb_off
CLEAR
f_name = SPACE(8)
@ 10, 15 SAY "Name of Setup .MEM file" ;
    GET f_name;
    PICTURE "@!"
READ
IF AT('.MEM', f_name) = 0
  IF AT('.', f_name) <> 0
    f_name = LEFT(f_name, AT('.', f_name) - 1)
  ENDIF
  f_name = LEFT(f_name, MIN(8, LEN(TRIM(f_name)))) + '.MEM'
ENDIF
IF FILE(f_name)
  CLEAR
  @ row, 20 SAY "Loading, please wait "
  column = COL()
  @ row, column + 1 SAY REPLICATE('.', 20)
  offset = 0
  RESTORE FROM &f_name ADDITIVE
  DO Dconvert WITH p_six
  DO Dconvert WITH p_cmpr_on
  DO Dconvert WITH p_eight
  DO Dconvert WITH p_10cpi
  DO Dconvert WITH p_12cpi
  DO Dconvert WITH p_cmpr_off
  DO Dconvert WITH p_nlq_ON
  DO Dconvert WITH p_nlq_OFF
  DO Dconvert WITH p_bold_on
  DO Dconvert WITH p_bold_off
  DO Dconvert WITH p_und_on
  DO Dconvert WITH p_und_off
  DO Dconvert WITH p_ital_on
  DO Dconvert WITH p_ital_off
  DO Dconvert WITH p_emph_on
  DO Dconvert WITH p_emph_off
  DO Dconvert WITH p_dbl_on
  DO Dconvert WITH p_dbl_off
  DO Dconvert WITH p_expn_on
  DO Dconvert WITH p_expn_off
  DO Dconvert WITH p_supr_ON
  DO Dconvert WITH p_supr_off
  DO Dconvert WITH p_sub_on
  DO Dconvert WITH p_sub_off
  DO Dconvert WITH p_msb_on
  DO Dconvert WITH p_msb_off
  @ 24, 0
ENDIF
CLEAR
@  1, 28 SAY "Printer Setup Program"
@  3, 12 SAY "Printer Name"
@  4, 10 SAY "Six Lines/Inch"
@  5,  8 SAY "Eight Lines/Inch"
@  6, 17 SAY "Ten CPI"
@  7, 14 SAY "Twelve CPI"
@  9, 28 SAY "ON"
@  9, 62 SAY "OFF"
@ 10,  4 SAY "Compressed"
@ 11,  0 SAY "Letter Quality"
@ 12, 10 SAY "Bold"
@ 13,  5 SAY "Underline"
@ 14,  8 SAY "Italic"
@ 15,  4 SAY "Emphasized"
@ 16,  1 SAY "Double-Strike"
@ 17,  6 SAY "Expanded"
@ 18,  3 SAY "Superscript"
@ 19,  5 SAY "Subscript"
@ 20,  4 SAY "No 8th bit"
@ 24, 15 SAY "Press Ctrl-Q to quit, or Ctrl-W to Save."
*
@  3, 25 GET p_name
@  4, 25 GET p_six
@  5, 25 GET p_eight
@  6, 25 GET p_10cpi
@  7, 25 GET p_12cpi
@ 10, 15 GET p_cmpr_on
@ 10, 49 GET p_cmpr_off
@ 11, 15 GET p_nlq_ON
@ 11, 49 GET p_nlq_OFF
@ 12, 15 GET p_bold_on
@ 12, 49 GET p_bold_off
@ 13, 15 GET p_und_on
@ 13, 49 GET p_und_off
@ 14, 15 GET p_ital_on
@ 14, 49 GET p_ital_off
@ 15, 15 GET p_emph_on
@ 15, 49 GET p_emph_off
@ 16, 15 GET p_dbl_on
@ 16, 49 GET p_dbl_off
@ 17, 15 GET p_expn_on
@ 17, 49 GET p_expn_off
@ 18, 15 GET p_supr_ON
@ 18, 49 GET p_supr_off
@ 19, 15 GET p_sub_on
@ 19, 49 GET p_sub_off
@ 20, 15 GET p_msb_on
@ 20, 49 GET p_msb_off
READ
CLEAR
choice = " "
@ 12, 15 SAY "Save This Setup File?" GET choice PICTURE "@!"
READ
CLEAR
IF UPPER(choice) <> "Y"
  CLOSE PROCEDURE
  SET TALK ON
  RETURN
ENDIF
@ row, 20 SAY "Now processing "
column     = COL()
offset     = 0
x_msb_flag = .F.
@ row, column + 1 SAY REPLICATE('.', 20)
DO Convert WITH p_msb_on
DO Convert WITH p_msb_off
x_msb_flag = (LEN(TRIM(p_msb_on)) <> 0 .AND. LEN(TRIM(p_msb_off)) <> 0)
DO Convert WITH p_six
DO Convert WITH p_cmpr_on
DO Convert WITH p_eight
DO Convert WITH p_10cpi
DO Convert WITH p_12cpi
DO Convert WITH p_cmpr_off
DO Convert WITH p_nlq_ON
DO Convert WITH p_nlq_OFF
DO Convert WITH p_bold_on
DO Convert WITH p_bold_off
DO Convert WITH p_und_on
DO Convert WITH p_und_off
DO Convert WITH p_ital_on
DO Convert WITH p_ital_off
DO Convert WITH p_emph_on
DO Convert WITH p_emph_off
DO Convert WITH p_dbl_on
DO Convert WITH p_dbl_off
DO Convert WITH p_expn_on
DO Convert WITH p_expn_off
DO Convert WITH p_supr_ON
DO Convert WITH p_supr_off
DO Convert WITH p_sub_on
DO Convert WITH p_sub_off
@ 24, 0
*
SET SAFETY OFF
SAVE TO &f_name ALL LIKE p_*
SET SAFETY ON
CLOSE PROCEDURE
SET TALK ON
RETURN
* EOP PrtSetup.PRG

PROCEDURE Dconvert
PARAMETERS string
*
temp      = 1
newstring = ""
*
* Comment out the next line to disable 'walking arrow' and
* speed up the operation.
*
DO Walk WITH row, column, offset
macro = "LTRIM(STR(ASC(SUBSTR(string, temp, 1)), 3))"
DO WHILE temp <= LEN(string)
  newstring = IIF(LEN(newstring) <> 0, newstring + ',' + ¯o, ¯o)
  temp      = temp + 1
ENDDO
newstring = LEFT(newstring + blanks, 30)
string    = newstring
RETURN
* EOP DConvert

PROCEDURE Convert
PARAMETERS string
*
string    = TRIM(string)
newstring = ""
*
* Comment out the next line to disable 'walking arrow' and
* speed up the operation.
*
DO Walk WITH row, column, offset
x_msb_ok = .F.
pos      = AT("," , SUBSTR(string, 1, LEN(string)))
DO WHILE pos <> 0
  char      = SUBSTR(string, 1, pos - 1)
  x_msb_ok  = x_msb_ok .OR. (x_msb_flag .AND. (char = '0'))
  newstring = newstring + IIF(x_msb_ok, CHR(128), CHR(VAL(char)))
  string    = SUBSTR(string, pos + 1, LEN(string) - pos + 1)
  pos       = AT("," , string)
ENDDO
x_msb_ok  = x_msb_ok .OR. (x_msb_flag .AND. (string = '0'))
newstring = newstring + IIF(x_msb_ok, CHR(128), CHR(VAL(string)))
IF x_msb_ok
  string = p_msb_on + newstring + p_msb_off
ELSE
  string = newstring
ENDIF
RETURN
* EOP Convert

PROCEDURE Walk
PARAMETERS row, column, offset

@ row, column + offset SAY '.'
offset = MOD(offset + 1, 20)
@ row, column + offset SAY CHR(16)
@ row, column + offset SAY SPACE(0)
RETURN
* EOP Walk