📄 gen_pd.prg
字号:
IF EMPTY(_pdparms[13]) AND EMPTY(_pdparms[14]) OR ;
(_pdparms[5] = 1 AND _pdparms[6] = 1)
IF NOT EMPTY(_pdparms[16])
_pdparms[18] = _pdparms[18] + _pdparms[15] + _pdparms[16]
ENDIF
ELSE
IF (_pdparms[6] = 2) && Bold
_pdparms[18] = _pdparms[18] + _pdparms[15] + _pdparms[13]
IF _pdparms[5] = 2 && Bold and Italic
_pdparms[18] = _pdparms[18] + _pdparms[15] + _pdparms[13]
ENDIF
ELSE
IF _pdparms[5] = 2
IF _pdparms[38] && Italic include Normal
_pdparms[18] = _pdparms[18] + _pdparms[15] + _pdparms[16] + _pdparms[14]
ELSE && Italic do not include Normal
_pdparms[18] = _pdparms[18] + _pdparms[15] + _pdparms[14]
ENDIF
ENDIF
ENDIF
ENDIF
ELSE
_pdparms[12] = "/Times"
_pdparms[13] = "Bold"
_pdparms[14] = "Italic"
_pdparms[15] = "-"
_pdparms[16] = "Roman"
_pdparms[38] = .F.
ENDIF
USE
_pdparms[17] = _pdparms[36] / 80
_pdparms[22] = VAL(_pdparms[21]) * .5
_pdparms[23] = _pdparms[22] * .5
_pdparms[19] = ALLTRIM(STR(_pdparms[22]))
_pdparms[20] = ALLTRIM(STR(_pdparms[23]))
=ACOPY(g_pdfiles, _pdparms, 1, 9, 24)
_pdparms[39] = IIF(TYPE('_pdparms[39]') = 'N', _pdparms[39] + 1, 0)
*
* If you would like to use the XBase version of the printer drivers,
* uncomment the line below
*
_PDRIVER = "PS.PRG"
* and make the lines below a comment.
*IF "WINDOWS" $ UPPER(VERSION())
* IF ADIR(pd_api, SYS(2004) + "PSAPI.FLL") > 0
* _PDRIVER = SYS(2004) + "PSAPI.FLL"
* ELSE
* DIMENSION _pdparms[1]
* _pdparms = -1
* DO alrt WITH SYS(2004) + "PSAPI.FLL file not found."
* RETURN
* ENDIF
*ELSE
* IF ADIR(pd_api, SYS(2004) + "PSAPI.PLB") > 0
* _PDRIVER = SYS(2004) + "PSAPI.PLB"
* ELSE
* DIMENSION _pdparms[1]
* _pdparms = -1
* DO alrt WITH SYS(2004) + "PSAPI.PLB file not found."
* RETURN
* ENDIF
*ENDIF
ELSE
PUBLIC _pdparms[53]
_pdparms[42] = ""
SELECT 0
m.select = SELECT()
USE p_codes AGAIN
LOCATE FOR p_name == m.g_pddriver
IF FOUND()
SCATTER FIELDS p_name, p_outport, p_setup, p_reset, ;
p_flen, p_ff, (IIF(m.g_pdlpi = 1, "p_6lpi", "p_8lpi")), ;
p_10cpi, p_compress, ;
(IIF(m.g_pdorientation = 1,"p_portrait", "p_landscap")), ;
p_boldon, p_boldoff, p_ulineon, p_ulineoff, p_italon, ;
p_italoff, p_superon, p_superoff, p_subon, p_suboff, ;
p_fixed, p_crlf, p_horzmv1, p_horzmv2 ;
TO _pdparms
DO CASE
CASE g_pdcpi = 1
_pdparms[8] = p_10cpi
CASE g_pdcpi = 2
_pdparms[8] = p_12cpi
CASE g_pdcpi = 3
_pdparms[8] = p_compress
ENDCASE
IF p_codes.p_fonts
_pdparms[44] = VAL(m.g_pdfontsize)
SELECT 0
USE fonts AGAIN
LOCATE FOR m.g_pdfont == fonts.fontname AND ;
m.g_pddriver == fonts.printer
IF FOUND()
IF fonts.scalable
DO embedednum WITH p_codes.p_fontsize, 8, m.g_pdfontsize
m.val_font = VAL(m.g_pdfontsize)
m.supersize = ALLTRIM(STR(m.val_font/2, 6,2))
m.movement = ALLTRIM(STR(m.val_font * 3.5,6,2))
DO embedednum with fonts.superon, 17, m.supersize
DO embedednum with _pdparms[17], 17, m.movement
DO embedednum with fonts.superoff, 18, m.g_pdfontsize
DO embedednum with _pdparms[18], 18, m.movement
m.movement = ALLTRIM(STR(m.val_font * 3,6,2))
DO embedednum with fonts.subon, 19, m.supersize
DO embedednum with _pdparms[19], 19, m.movement
DO embedednum with fonts.suboff, 20, m.g_pdfontsize
DO embedednum with _pdparms[20], 20, m.movement
ELSE
_pdparms[17] = fonts.superon
_pdparms[18] = fonts.superoff
_pdparms[19] = fonts.subon
_pdparms[20] = fonts.suboff
ENDIF
_pdparms[45] = ALLTRIM(fonts.regular)
_pdparms[49] = fonts.inch_point
_pdparms[51] = fonts.num_width * _pdparms[44] * fonts.dpi
IF NOT EMPTY(fonts.horzmove1)
_pdparms[23] = RTRIM(fonts.horzmove1)
_pdparms[24] = RTRIM(fonts.horzmove2)
ENDIF
IF NOT EMPTY(p_codes.p_lpi) AND fonts.scalable
DO embedednum WITH p_codes.p_lpi, 7, ALLTRIM(STR(m.g_pdleading,5,2))
ENDIF
*
* Check what size paper and assign appropriate values.
*
DO CASE
CASE m.g_pdpgsize = 1 && 8.5 by 11 paper
m.horizpts = 8.5
m.vertpts = 11
_pdparms[10] = RTRIM(_pdparms[10]) + RTRIM(p_codes.p_letterpg)
CASE m.g_pdpgsize = 2 && Legal paper
m.horizpts = 8.5
m.vertpts = 14
_pdparms[10] = RTRIM(_pdparms[10]) + RTRIM(p_codes.p_legalpg)
CASE m.g_pdpgsize = 3 && A4 paper
m.horizpts = 8.27
m.vertpts = 11.69
_pdparms[10] = RTRIM(_pdparms[10]) + RTRIM(p_codes.p_a4pg)
********************************************************
* Added two Paper Sizes, A3 + 8.5 x 12 Inch Paper. *
* The Fieldnames are p_codes.p_a3pg & p_codes.p_8x12pg *
* respectively. - Garydo 11/26/92 *
********************************************************
CASE m.g_pdpgsize = 4 && A3 paper
m.horizpts = 11.69
m.vertpts = 16.53
_pdparms[10] = RTRIM(_pdparms[10]) + RTRIM(p_codes.p_a3pg)
CASE m.g_pdpgsize = 5 && 8.5 by 12 paper
m.horizpts = 8.5
m.vertpts = 12
_pdparms[10] = RTRIM(_pdparms[10]) + RTRIM(p_codes.p_8x12pg)
ENDCASE
*
* Calculate the Dots per Column. If fonts.dpi is 0, it will indicate
* that a column movement command is used.
*
IF m.g_pdorientation = 1
_pdparms[47] = fonts.dpi * m.horizpts
ELSE
_pdparms[47] = fonts.dpi * m.vertpts
ENDIF
ELSE
DO embedednum with p_codes.p_superon, 17
DO embedednum with p_codes.p_superon, 18
_pdparms[45] = ""
STORE 0 to _pdparms[49], _pdparms[50], _pdparms[47], _pdparms[51]
ENDIF
USE
SELECT p_codes
ELSE
_pdparms[45] = ""
STORE 0 to _pdparms[49], _pdparms[50], _pdparms[47], _pdparms[44]
DO CASE
CASE m.g_pdpgsize = 1 && 8.5 by 11 paper
_pdparms[10] = RTRIM(_pdparms[10]) + RTRIM(p_codes.p_letterpg)
CASE m.g_pdpgsize = 2 && Legal paper
_pdparms[10] = RTRIM(_pdparms[10]) + RTRIM(p_codes.p_legalpg)
CASE m.g_pdpgsize = 3 && A4 paper
_pdparms[10] = RTRIM(_pdparms[10]) + RTRIM(p_codes.p_a4pg)
CASE m.g_pdpgsize = 4 && A3 paper
_pdparms[10] = RTRIM(_pdparms[10]) + RTRIM(p_codes.p_a3pg)
CASE m.g_pdpgsize = 5 && 8.5 by 12 paper
_pdparms[10] = RTRIM(_pdparms[10]) + RTRIM(p_codes.p_8x12pg)
ENDCASE
ENDIF
m.first = AT("{#",p_topmarg)
IF m.first > 0
_pdparms[40] = LEFT(p_topmarg,m.first-1) + ;
ALLTRIM(STR(m.g_pdtmargin)) + ALLTRIM(SUBSTR(p_topmarg, m.first+3))
ELSE
_pdparms[40] = ""
ENDIF
_pdparms[41] = m.g_pdtmargin
ELSE
DO alrt WITH "Unable to install printer driver."
RETURN
ENDIF
*
* Remove the special characters: {NULL} = CHR(0)
* {CR} = CHR(13)
* {LF} = CHR(10)
* {TAB} = CHR(9)
DO specchar WITH 1,24 && replace _pdparms[1] .. _pdparms[24]
DO specchar WITH 45,45 && replace _pdparms[45]
*
* Set up the codes for Bold and Italic. Reset the line counter.
*
_pdparms[46] = 0
_pdparms[25] = IIF(m.g_pdstyle = 1, _pdparms[16], _pdparms[15])
_pdparms[26] = IIF(m.g_pdstroke = 1, _pdparms[12], _pdparms[11])
_pdparms[27] = 1
_pdparms[21] = .F.
_pdparms[28] = 66
=ACOPY(g_pdfiles, _pdparms, 1, 9, 30)
_pdparms[39] = .F.
_pdparms[43] = 0
USE
SELECT (m.select)
*
* If you would like to use the XBase version of the printer drivers,
* uncomment the line below
* _PDRIVER = "DRIVER.PRG"
* and make the lines below a comment.
IF "WINDOWS" $ UPPER(VERSION())
IF ADIR(pd_api, SYS(2004) + "DRIVER2.FLL") > 0
_PDRIVER = SYS(2004) + "DRIVER2.FLL"
ELSE
DIMENSION _pdparms[1]
_pdparms = -1
DO alrt WITH SYS(2004) + "DRIVER2.FLL file not found."
RETURN
ENDIF
ELSE
IF ADIR(pd_api, SYS(2004) + "DRIVER2.PLB") > 0
_PDRIVER = SYS(2004) + "DRIVER2.PLB"
ELSE
DIMENSION _pdparms[1]
_pdparms = -1
DO alrt WITH SYS(2004) + "DRIVER2.PLB file not found."
RETURN
ENDIF
ENDIF
ENDIF
IF TYPE("_pdparms") != "N" OR (TYPE("_pdparms") = "N" AND _pdparms != -1)
_PDSETUP = "-" + ALLTRIM(m.g_pdname)
ELSE
DO alrt WITH "Unable to install printer driver."
ENDIF
RETURN
*!*********************************************************************
*!
*! Procedure: SPECCHAR
*!
*! Called by: SETPDRIVER (procedure in GEN_PD.PRG)
*!
*!*********************************************************************
PROCEDURE specchar
PARAMETER m.start,m.stop
PRIVATE m.i
*
* Format the codes in the array by removing trailing blanks and checking
* for embeded nulls, carriage returns, line feeds, and tabs
*
* m.start and m.stop represent the lower and upper bounds of the array
* elements that are to be processed.
*
FOR m.i = m.start to m.stop
_pdparms[m.i] = ALLTRIM(_pdparms[m.i])
m.first = AT("{",_pdparms[m.i])
DO WHILE m.first > 0
m.second = AT("}",_pdparms[m.i])
m.string = SUBSTR(_pdparms[m.i], m.first + 1, m.second-m.first-1)
DO CASE
CASE m.string = "NULL"
m.char = CHR(0)
CASE m.string = "CR"
m.char = CHR(13)
CASE m.string = "LF"
m.char = CHR(10)
CASE m.string = "TAB"
m.char = CHR(9)
OTHERWISE
m.first = 0
ENDCASE
IF m.first > 0
_pdparms[m.i] = SUBSTR(_pdparms[m.i], 1, first-1) + m.char + ;
SUBSTR(_pdparms[m.i],second+1)
m.first = AT("{",_pdparms[m.i])
ENDIF
ENDDO
ENDFOR
RETURN
*!*********************************************************************
*!
*! Procedure: EMBEDEDNUM
*!
*! Called by: SETPDRIVER (procedure in GEN_PD.PRG)
*!
*!*********************************************************************
PROCEDURE embedednum
PARAMETER m.field, m.element, m.embed, m.ch, m.ch2
PRIVATE m.first, m.ctrlchrs, m.ex_len
m.ctrlchrs = ""
m.ex_len = 0
m.first = AT("{#B4}", m.field)
IF m.first > 0
IF m.ch2
m.ctrlchrs = chr(28) + chr(1) + chr(3)
m.ex_len = 3
ENDIF
_pdparms[m.element] = LEFT(m.field, m.first - 1) + m.ctrlchrs + ;
RTRIM(SUBSTR(m.field, m.first + 5))
m.field = _pdparms[m.element]
ENDIF
m.first = AT("{#B3}", m.field)
IF m.first > 0
_pdparms[m.element] = LEFT(m.field, m.first - 1) + ;
CHR(LEN(m.embed) + 1) + RTRIM(SUBSTR(m.field, m.first + 5))
m.field = _pdparms[m.element]
m.first = AT("{#}", m.field)
IF m.first > 0
_pdparms[m.element] = LEFT(m.field, m.first - 1) + ;
m.embed + RTRIM(SUBSTR(m.field, m.first + 3))
m.field = _pdparms[m.element]
ENDIF
ENDIF
m.first = AT("{#B1}", m.field)
IF m.first > 0
_pdparms[m.element] = LEFT(m.field, m.first - 1) + ;
CHR(MOD((2 * (LEN(m.embed) + 4) - 1 + m.ex_len),256)) + ;
CHR(INT((LEN(m.embed) + 4 + m.ex_len)/256)) + ;
RTRIM(SUBSTR(m.field, m.first + 5))
m.field = _pdparms[m.element]
ENDIF
m.first = AT("{#B2}", m.field)
IF m.first > 0
_pdparms[m.element] = LEFT(m.field, m.first - 1) + ;
CHR(LEN(m.embed)) + RTRIM(SUBSTR(m.field, m.first + 5))
m.field = _pdparms[m.element]
ENDIF
m.first = AT("{#}", m.field)
IF m.first > 0
_pdparms[m.element] = LEFT(m.field, m.first - 1) + ;
IIF(m.ch, CHR(VAL(m.embed)), m.embed) + RTRIM(SUBSTR(m.field, m.first + 3))
ELSE
_pdparms[m.element] = m.field
ENDIF
RETURN
*!*********************************************************************
*!
*! Procedure: ALRT
*!
*! Called by: GEN_PD.PRG
*! : SETPDRIVER (procedure in GEN_PD.PRG)
*! : LOCATEPD() (function in GEN_PD.PRG)
*! : M.g_saved valid() (function in PD_EDIT.SPR)
*!
*!*********************************************************************
PROCEDURE alrt
PARAMETER m.message
PRIVATE m.remove, m.extended
DEFINE WINDOW _pvz0lhvmg ;
FROM INT((SROW()-7)/2),INT((SCOL()-50)/2) ;
TO INT((SROW()-7)/2)+6,INT((SCOL()-50)/2)+49 ;
FLOAT ;
NOCLOSE ;
SHADOW ;
DOUBLE ;
COLOR SCHEME 7
ACTIVATE WINDOW _pvz0lhvmg
m.extended = IIF(ATC("(X)", VERSION()) != 0, .T., .F.)
IF (m.extended AND RDLEVEL() != 5) OR (NOT m.extended AND RDLEVEL() < 4)
m.remove = 1
@ 1,0 SAY PADC(m.message, 48, " ")
@ 4,17 GET m.remove ;
PICTURE "@*HT \!\<OK" ;
SIZE 1,12,10 ;
DEFAULT 1
READ CYCLE MODAL
ELSE
WAIT PADC(m.message, 48, " ")
ENDIF
RELEASE WINDOW _pvz0lhvmg
RETURN
*!*****************************************************************
*!
*! Procedure: HELPED
*!
*!*****************************************************************
PROCEDURE helped
PARAMETER m.topic
PUSH KEY CLEAR
HELP &topic
POP KEY
RETURN
*!*********************************************************************
*!
*! Procedure: CLEANUP
*!
*! Called by: GEN_PD.PRG
*!
*!*********************************************************************
PROCEDURE cleanup
IF NOT EMPTY(m.g_foxuser)
SELECT (m.g_foxuser)
USE
ENDIF
SELECT (m.workarea)
IF USED() && Re-establish any relations that might have been set
IF !EOF()
GO RECNO()
ENDIF
ENDIF
IF NOT EMPTY(m.g_setfields)
SET FIELDS TO &g_setfields
ENDIF
IF NOT m.deleted
SET DELETED OFF
ENDIF
IF m.trbetween = "ON"
SET TRBET ON
ENDIF
IF m.talk
SET TALK ON
ENDIF
IF m.escape
SET ESCAPE ON
ENDIF
IF NOT m.exact
SET EXACT OFF
ENDIF
POP KEY
RETURN
*: EOF: GEN_PD.PRG
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -