home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
laserenv.zip
/
LASERENV.PRG
< prev
next >
Wrap
Text File
|
1988-12-17
|
12KB
|
464 lines
*:*********************************************************************
*:
*: Program: LASERENV.PRG
*:
*: System: LASER ENVELOPE UTILITY 1.0
*: Author: Etienne Muson
*: Copyright (c) 1988, MUSON SPECIALTIES
*: Last modified: 12/16/88 13:15
*:
*: Procs & Fncts: BARFRAME
*: : GETBIN
*: : SETBAR
*:
*: Calls: BARFRAME (procedure in LASERENV.PRG)
*: : GETBIN (procedure in LASERENV.PRG)
*: : SETBAR (procedure in LASERENV.PRG)
*:
*: Uses: ADLIST.DBF
*:
*: Indexes: ADLIST.NDX
*:
*: Memory Files: RETURN.ADD
*:
*: Documented: 12/16/88 at 13:16 FoxDoc version 1.0
*:*********************************************************************
* ---- Designed to fit a standard business envelope, 9 1/2" by 4 1/8".
* ----
SET TALK OFF
SET BELL OFF
SET STATUS OFF
SET SAFETY OFF
SET EXACT ON
SET DELIMITERS ON
SET DELIMITERS TO [▐▌]
SET CONFIRM ON
SET PROCEDURE TO LASERENV
RESTORE FROM RETURN.ADD ADDITIVE
* ---- Set Up Public Variables
PUBLIC mrow,mrow2,mcol,mcol2,m_lin,b_bin,mwide,mwide2,mhigh,fillp,fox
* ----
* The Following Lines Assume A Soft Font In Positions 14, And 15
* This May Be Changed, Or Left Alone. It Will Print In The Default
* Font If No Soft Fonts Exist At These Locations.
* ----
* ---- 12 Point Classic PS Font
font1 = CHR(27)+CHR(40)+[14]+CHR(88)
* ---- 14 Point Classic PS Font
font2 = CHR(27)+CHR(40)+[15]+CHR(88)
* ---- Default Font
fontdef= CHR(27)+CHR(40)+CHR(51)+CHR(64)
* ---- Landscape Codes
land = CHR(27)+[&l1O]
* ---- Open Name And Adress Database/Index (Index Is On CODE)
USE ADLIST INDE ADLIST
GO TOP
DO WHILE .T.
CLEAR
DO TITLINE WITH 1,5,[Laser Envelope Main Options]
m_select = 0
* ---- These Lines Of Code Can Be Removed To Remove The Message Next
* ---- To The Menu
IF CODE = [MSP]
@10,50 SAY [MUSON SPECIALTIES]
@11,50 SAY [For A Test Envelope]
@12,50 SAY [Use Code MSP]
@14,50 SAY [To Remove This Message,]
@15,50 SAY [Delete Code MSP In #1 Spot.]
ENDIF
* ---- End Of Removable Code Lines
* ---- Options Menu
@10, 10 SAY [1. Change Return Address.]
@12, 10 SAY [2. Add New Addressee.]
@14, 10 SAY [3. Browse Addressee File.]
@16, 10 SAY [4. Print An Envelope.]
@18, 10 SAY [0. Quit.]
@20, 10 SAY [Select : ] GET m_select PICT [9]
READ
DO CASE
CASE m_select = 0
EXIT
CASE m_select = 1
CLEAR
DO TITLINE WITH 1,5,[Change Return Address]
* ---- New Address Variables
n_add1 = r_add1+SPACE(40-LEN(r_add1))
n_add2 = r_add2+SPACE(40-LEN(r_add2))
n_add3 = r_add3+SPACE(40-LEN(r_add3))
n_add4 = r_add4+SPACE(40-LEN(r_add4))
* ---- Get Screen
@10, 10 SAY [Line 1 : ] GET n_add1
@12, 10 SAY [Line 2 : ] GET n_add2
@14, 10 SAY [Line 3 : ] GET n_add3
@16, 10 SAY [Line 4 : ] GET n_add4
@20, 10 SAY [Leave Blank For No Return Address.]
READ
* ---- Transfer To Address Variables
r_add1 = TRIM(n_add1)
r_add2 = TRIM(n_add2)
r_add3 = TRIM(n_add3)
r_add4 = TRIM(n_add4)
* ---- Save To File
SAVE ALL LIKE r_add* TO RETURN.ADD
LOOP
CASE m_select = 2
APPEND
CASE m_select = 3
BROWSE
CASE m_select = 4
CLEAR
m_code = SPACE(5)
DO TITLINE WITH 1,5,[Print An Envelope]
@ 8, 10 SAY [Laser Printer Envelope Printing Utility.]
@10, 10 SAY [Addressee Code ? ] GET m_code PICT [@!]
@12, 10 SAY [Blank To Quit.]
READ
m_code = TRIM(m_code)
IF LEN(m_code) = 0
EXIT
ENDIF
SEEK m_code
IF ! FOUND()
?? CHR(7)
@20, 10 SAY [That Code Not Found. Press Any Key...]
WAIT []
LOOP
ENDIF
@12, 0 CLEAR
* ---- Must Have One
DO WHILE .T.
@12, 10 SAY LINE_1
@13, 10 SAY LINE_2
@14, 10 SAY LINE_3
@15, 10 SAY LINE_4
@16, 10 SAY LINE_Z
@18, 10 SAY [Press Any Key To Print, Or 'E' To Edit...]
WAIT [] TO m_ok
IF UPPER(m_ok) = [E]
@12, 10 SAY LINE_1 GET LINE_1
@13, 10 SAY LINE_2 GET LINE_2
@14, 10 SAY LINE_3 GET LINE_3
@15, 10 SAY LINE_4 GET LINE_4
@16, 10 SAY LINE_Z GET LINE_Z
READ
@12, 0 CLEAR
LOOP
ELSE
EXIT
ENDIF
ENDDO edit
SET CONSOLE OFF
* ---- Turn On Landscape Mode.
SET PRINT ON
?? land
* ---- SET LINE SPACING 4 LPI
* ---- 48/4 = 12 For The n/48 Command
?? CHR(27)+[&l12C]
SET PRINT OFF
SET DEVICE TO PRINT
z_disp = TRIM(LINE_Z)
IF LEN(z_disp) > 5
z_disp = LEFT(z_disp,5)+[-]+RIGHT(z_disp,4)
ENDIF
* ---- Return Address
@ 8, 20 SAY font2+r_add1+fontdef
@ 9, 20 SAY font1+r_add2+fontdef
@10, 20 SAY font1+r_add3+fontdef
@11, 20 SAY font1+r_add4+fontdef
* ---- Main Address
@ 16, 65 SAY font2+TRIM(LINE_1)+fontdef
@ 17, 65 SAY font1+TRIM(LINE_2)+fontdef
@ 18, 65 SAY font1+TRIM(LINE_3)+fontdef
@ 19, 65 SAY font1+TRIM(LINE_4)+[ ]+z_disp+fontdef
SET DEVICE TO SCREEN
* --------------------------------------------------
* ---- ZIPBARS - Created For The HP LJET II, Or Close Compatible.
* ---- Prints The Standard Zip Barcode For Either A 5 Digit,
* ---- Or 9 Digit Zip Code In The Appropriate Location On An Envelope.
* ----
* ---- Designed to fit a standard business envelope, 9 1/2" by 4 1/8".
* ---- The bar code is printed on the lower right-hand corner, within
* ---- the specifications set forth by the U.S. Post office.
* ----
* ---- [mrow] = Cursor Start Row
* ---- [mwide] = Shaded Box Width (In D.P.I.)
* ---- [mhigh] = Shaded Box Height (In D.P.I.)
* ---- [fillp] = Fill Pattern # (See Below)
* ---- [fillt] = Fill Type. [P]=Pattern, [S]=Shade
* ---- Shade Values:
* ---- 100 =100% Gray
* --------------------------------------------------
* ---- Beginning Row
mrow2 = 69
* ---- Start Col. For Barcode
mcol = 145
* ---- Bar Heights In Decipoints
* ---- Low Bar = .050" (0)
mhigh0 = [15]
* ---- High Bar = .125" (1)
mhigh1 = [38]
* ---- Bar Thickness In Decipoints
* ---.O2O" Width Of Bar
mwide = [6]
* ---- Fill Pattern = 100% Gray (Black)
fillp = [100]
m_zip = TRIM(LINE_Z)
@12, 0 CLEAR
@12, 10 SAY [Printing...]
b_code = TRIM(m_zip)
b_len = LEN(b_code)
x = 1
m_sum = 0
* ---- Turn On Printer To Accept Codes
SET PRINT ON
* ---- Position Cursor To Row
mrowx = LTRIM(STR(mrow2))
?? CHR(27)+CHR(38)+CHR(97)+mrowx+CHR(82)
* ---- SET CHAR SPACING 21 CPI
* ---- 120/21 = 5.71 For The n/120 Command
?? CHR(27)+[&k5.71H]
* ---- SET LINE SPACING 13 LPI
* ---- 48/13 = 3.69 For The n/48 Command
?? CHR(27)+[&l3.69C]
* ---- As Many As Length Of Zip Code
DO WHILE x <=b_len
* ---- Do Opening Frame Bar
IF x = 1
mcol1 = LTRIM(TRIM(STR(mcol)))
mcol = mcol + 1
DO BARFRAME
ENDIF
* ---- Get Digit To Process
m_digit = SUBST(b_code,x,1)
* ---- Prepare For Checksum
m_sum = m_sum + VAL(m_digit)
* ---- Get Binary Data
DO GETBIN WITH m_digit
* ---- Now Process Binary Digits
y = 1
* ---- Five Times Per Number
DO WHILE y <6
* ---- Get A 1, Or A 0
m_lin = SUBST(b_bin,y,1)
* ---- Change Row To Character
mcol1 = LTRIM(TRIM(STR(mcol)))
* ---- Position Cursor To Column
?? CHR(27)+[&a]+mcol1+[C]
* ---- Print Bar
DO SETBAR
* ---- Move Up A Column
mcol = mcol + 1
* ---- Move To Next Digit
y = y + 1
ENDDO Binary Digits
* ---- Move To Next Number
x = x + 1
ENDDO 9 Digit Zip
* ---- Now Do Checksum
* ---- Get Remainder After Divide By 10
m_rem = MOD(m_sum,10)
* ---- Checksum Digit Is 10 - Remainder Above
m_digit = LTRIM(STR(10 - m_rem))
* ---- Get Binary Code
DO GETBIN WITH m_digit
* ---- Now Print Checksum Digits
y = 1
* ---- Five Times
DO WHILE y <6
* ---- Get A 1, Or A 0
m_lin = SUBST(b_bin,y,1)
mcol1 = LTRIM(STR(mcol))
* ---- Position Cursor To Column
?? CHR(27)+[&a]+mcol1+[C]
* ---- Print Bar
DO SETBAR
* ---- Move Up A Column
mcol = mcol + 1
* ---- Move Up A Digit
y = y + 1
ENDDO Binary Digits
* ---- Do Closing Frame Bar
mcol1 = LTRIM(TRIM(STR(mcol)))
mcol = mcol + 1
DO BARFRAME
* ---- Send Printer Reset Command (Ejects Paper, Resets To Default Values)
EJECT
?? CHR(27)+CHR(69)
* ---- Clean Up
SET PRINT OFF
SET CONSO ON
* ---- Done
ENDCASE
ENDDO While .T.
* ---- Close Up
USE
SET PROCEDURE TO
SET STATUS ON
SET SAFETY ON
SET TALK ON
SET BELL ON
RETURN
*!*********************************************************************
*!
*! Procedure: GETBIN
*!
*! Called by: ENV.PRG
*!
*!*********************************************************************
PROCEDURE getbin
PARAMETERS m_digit
* ---- Takes A Character Digit 0-9, And Returns Binary 5 Digit Number
DO CASE
CASE m_digit = [0]
b_bin = [11000]
CASE m_digit = [1]
b_bin = [00011]
CASE m_digit = [2]
b_bin = [00101]
CASE m_digit = [3]
b_bin = [00110]
CASE m_digit = [4]
b_bin = [01001]
CASE m_digit = [5]
b_bin = [01010]
CASE m_digit = [6]
b_bin = [01100]
CASE m_digit = [7]
b_bin = [10001]
CASE m_digit = [8]
b_bin = [10010]
CASE m_digit = [9]
b_bin = [10100]
ENDCASE
RETURN b_bin
*!*********************************************************************
*!
*! Procedure: SETBAR
*!
*! Called by: ENV.PRG
*!
*!*********************************************************************
PROCEDURE SETBAR
* ---- Issues Command To Print Proper Bar At Current Location
* ---- Specify Width Of Rectangle (Dots)
?? CHR(27)+CHR(42)+CHR(99)+mwide+CHR(65)
* ---- Specify Height Of Rectangle (Dots)
IF m_lin = [0]
mrowx = LTRIM(STR(mrow2+1))
?? CHR(27)+CHR(38)+CHR(97)+mrowx+CHR(82)
?? CHR(27)+CHR(42)+CHR(99)+mhigh0+CHR(66)
ELSE
mrowx = LTRIM(STR(mrow2))
?? CHR(27)+CHR(38)+CHR(97)+mrowx+CHR(82)
?? CHR(27)+CHR(42)+CHR(99)+mhigh1+CHR(66)
ENDIF
* ---- Specify Fill/Pattern ID #
?? CHR(27)+CHR(42)+CHR(99)+fillp+CHR(71)
* ---- Execute Fill/Pattern
?? CHR(27)+CHR(42)+CHR(99)+[2]+CHR(80)
RETURN
*!*********************************************************************
*!
*! Procedure: BARFRAME
*!
*! Called by: ENV.PRG
*!
*!*********************************************************************
PROCEDURE BARFRAME
* ---- Prints The Frame Bar (1) At Begin And End Of Zip Code
* ---- Position To Correct Row
mrowx = LTRIM(STR(mrow2))
?? CHR(27)+CHR(38)+CHR(97)+mrowx+CHR(82)
* ---- Position Cursor To Column
?? CHR(27)+[&a]+mcol1+[C]
* ---- Specify Width Of Rectangle (Dots)
?? CHR(27)+CHR(42)+CHR(99)+mwide+CHR(65)
* ---- Specify Height Of Rectangle (Dots)
?? CHR(27)+CHR(42)+CHR(99)+mhigh1+CHR(66)
* ---- Specify Fill/Pattern ID #
?? CHR(27)+CHR(42)+CHR(99)+fillp+CHR(71)
* ---- Execute Fill/Pattern
?? CHR(27)+CHR(42)+CHR(99)+[2]+CHR(80)
RETURN
PROCEDURE TITLINE
PARAMETERS m_top,m_bot,m_mes
@ m_top, 0 CLEAR TO m_bot,80
* ---- Foxbase ?
IF fox
@ m_top, 10, m_bot,70 BOX [╔═╗║╝═╚║░]
ELSE
@ m_top, 10 TO m_bot,70 DOUBLE
ENDIF
SET COLOR TO W+
m_sp = (80-LEN(m_mes))/2
m_mid = (m_bot-m_top)/2+1
m_lin = LEN(m_mes)+1+m_sp
@ m_mid,m_sp SAY m_mes
@ m_mid-1,m_sp-2 TO m_mid+1,m_lin
SET COLOR TO
RETURN