Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : DB4LESS3.ZIP
Filename : CUSTOMER.LBG
* Date...............: 11-17-88
* Version............: dBASE IV, Label 1
*
* Label Specifics:
* Wide - 35
* Tall - 5
* Indentation - 0
* Number across - 2
* Space between - 2
* Lines between - 1
* Blankable lines - 2
* Print formatted - 4
*
PARAMETER ll_sample
*-- Set printer variables for this procedure only
PRIVATE _peject, _ploffset, _wrap
*-- Test for End of file
IF EOF()
RETURN
ENDIF
IF SET("TALK")="ON"
SET TALK OFF
gc_talk="ON"
ELSE
gc_talk="OFF"
ENDIF
gc_space = SET("SPACE")
SET SPACE OFF
gc_time=TIME() && system time for predefined field
gd_date=DATE() && system date " " " "
gl_fandl=.F. && first and last record flag
gl_prntflg=.T. && Continue printing flag
gn_column=1
gn_element=0
gn_line=1
gn_memowid=SET("MEMOWIDTH")
SET MEMOWIDTH TO 254
gn_page=_pageno && capture page number for multiple copies
_plineno=0
_wrap = .F.
IF ll_sample
DO Sample
IF LASTKEY() = 27
RETURN
ENDIF
ENDIF
*-- Setup Environment
ON ESCAPE DO prnabort
*-- Initialize array(s) for 2 across labels
DECLARE isfound[1]
DECLARE tmp4lbl[1,6]
DECLARE gn_line2[2]
PRINTJOB
*-- set page number for multiple copies
_pageno=gn_page
DO WHILE FOUND() .AND. .NOT. EOF() .AND. gl_prntflg
STORE .F. TO isfound[1]
tmp4lbl[1,1]=CUSTNAME
tmp4lbl[1,2]=ADDRESS
tmp4lbl[1,3]=CITY
tmp4lbl[1,4]=STATE
tmp4lbl[1,5]=ZIP
tmp4lbl[1,6]=CONTACT
CONTINUE
IF FOUND() .AND. .NOT. EOF()
isfound[1]=.T.
ENDIF
gn_line=3
*-- Check for blank lines
DO chk4null WITH 0, 2, 4
*-- Column 1
?? tmp4lbl[1,3] PICTURE "@T" AT 0 ;
,", " ;
,tmp4lbl[1,4] PICTURE "@T" ;
," " ;
,tmp4lbl[1,5] PICTURE "@T" ,
*-- Column 2
IF isfound[1]
?? CITY PICTURE "@T" AT 37 ;
,", " ;
,STATE PICTURE "@T" ;
," " ;
,ZIP PICTURE "@T"
ENDIF
?
?
*-- Column 1
?? "ATTN: " AT 0 ;
,tmp4lbl[1,6] PICTURE "@T XXXXXXXXXXXXXXXXXXXXXXXXXXXX" AT 7 ,
*-- Column 2
IF isfound[1]
?? "ATTN: " AT 37 ;
,CONTACT PICTURE "@T XXXXXXXXXXXXXXXXXXXXXXXXXXXX" AT 44
ENDIF
?
DO WHILE gn_line < 6
?
gn_line=gn_line+1
ENDDO
CONTINUE
ENDDO
IF .NOT. gl_prntflg
SET MEMOWIDTH TO gn_memowid
SET SPACE &gc_space.
SET TALK &gc_talk.
ON ESCAPE
RETURN
ENDIF
ENDPRINTJOB
SET MEMOWIDTH TO gn_memowid
SET SPACE &gc_space.
SET TALK &gc_talk.
ON ESCAPE
RETURN
* EOP: D:\DBSYS\CLASSES\BT4W\CUSTOMER.LBG
PROCEDURE prnabort
gl_prntflg=.F.
RETURN
* EOP: prnabort
*
*-- The next 4 function files are for blank line checking
FUNCTION ___01
lc_ret=.F.
*-- Test for blank line
IF LEN(TRIM( tmp4lbl[1,1] )) > 0
ll_output=.T.
?? tmp4lbl[1,1] PICTURE "@T" AT 0 ,
ELSE
lc_ret=.T.
ENDIF
RETURN lc_ret
FUNCTION ___02
lc_ret=.F.
*-- Column 2
IF isfound[1]
*-- Test for blank line
IF LEN(TRIM( CUSTNAME )) > 0
ll_output=.T.
?? CUSTNAME PICTURE "@T" AT 37
ELSE
lc_ret=.T.
ENDIF
ENDIF
RETURN lc_ret
FUNCTION ___11
lc_ret=.F.
*-- Test for blank line
IF LEN(TRIM( tmp4lbl[1,2] )) > 0
ll_output=.T.
?? tmp4lbl[1,2] PICTURE "@T" AT 0 ,
ENDIF
RETURN lc_ret
FUNCTION ___12
lc_ret=.F.
*-- Column 2
IF isfound[1]
*-- Test for blank line
IF LEN(TRIM( ADDRESS )) > 0
ll_output=.T.
?? ADDRESS PICTURE "@T" AT 37
ENDIF
ENDIF
RETURN lc_ret
PROCEDURE chk4null
*-- Parameters:
*
*-- 1) line number on the design surface
*-- 2) maximum number of printable lines
*-- 3) parameter 2 times number of labels across
*
PARAMETERS ln_line, ln_nolines, ln_element
gn_element=0
gn_line2[1]=ln_line
gn_line2[2]=ln_line
lc_temp=SPACE(7)
ll_output=.F.
DO WHILE gn_element < ln_element
gn_column=1
ll_output=.F.
DO WHILE gn_column <= 2
IF gn_line2[gn_column] < ln_line+ln_nolines
lc_temp=LTRIM(STR(gn_line2[gn_column]))+LTRIM(STR(gn_column))
DO WHILE ___&lc_temp.()
gn_element=gn_element+1
gn_line2[gn_column]=gn_line2[gn_column]+1
lc_temp=LTRIM(STR(gn_line2[gn_column]))+LTRIM(STR(gn_column))
ENDDO
gn_element=gn_element+1
gn_line2[gn_column]=gn_line2[gn_column]+1
ENDIF
gn_column=gn_column+1
ENDDO
IF ll_output
?
gn_line=gn_line+1
ENDIF
ENDDO
RETURN
* EOP: chk4null
PROCEDURE SAMPLE
PRIVATE x,y,choice
DEFINE WINDOW w4sample FROM 15,20 TO 17,60 DOUBLE
choice="Y"
x=0
DO WHILE choice = "Y"
y=0
?
DO WHILE y < 5
x=0
DO WHILE x < 2
?? REPLICATE("X",35)+SPACE(2)
x=x+1
ENDDO
?
y=y+1
ENDDO
x=0
DO WHILE x < 1
?
x=x+1
ENDDO
ACTIVATE WINDOW w4sample
@ 0,3 SAY "Do you want more samples? (Y/N)";
GET choice PICTURE "!" VALID choice $ "NY"
READ
DEACTIVATE WINDOW w4sample
IF LASTKEY() = 27
EXIT
ENDIF
ENDDO
RELEASE WINDOW w4sample
RETURN
* EOP: SAMPLE
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/