Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : BROWZE.ZIP
Filename : MAKELETR.PRG

 
Output of file : MAKELETR.PRG contained in archive : BROWZE.ZIP
* program to create free-form text letters including data fields.
* (C) 1991 Complete Computer Services, Inc
* 2412 Ocean Crest Boulevard, Far Rockaway, NY 11691 (718) 868-3000
* written by Yisroel Goodman
* with thanks to Brian Cleverly of Anzam Software for his help
* in streamlining some of the code.
clear
@ 1,28 say "Edit/Create Form Letters"
set memowidth to 65
select a
use person index person
select b
use children
set relation to no into person
select c
use workletr
select d
use fieldlst index fieldlst
store "PERSON " to proj
set filter to project="PERSON "
select workletr
* initializing variables used by browze.prg
store "Desc" to fld1
store .f. to indx, srchkey
store .t. to addrecrd
define window browpop from 5,5 to 15,32 panel title " Select Letter " ;
shadow nozoom nogrow nofloat color scheme 20
do browze with "","desc :h='Description'"
if lastkey()=27
store " " to addletr
@ 12,5 say "Create a new letter (Y/N)? " get addletr pict "Y"
read
if addletr="N"
cancel
endif
store space(25) to letdesc
@ 15,5 say "Description: " get letdesc
read
locate for upper(desc)=upper(letdesc)
if found()
@23,5 prompt " This letter already exists. You can now change it. Press return. "
menu to ki
else
append blank
replace desc with letdesc
endif
endif
define window helptxt from 0,0 to 23,79 panel title " Fields Available: " ;
shadow nozoom nogrow nofloat color scheme 18
define window memwin from 12,6 to 21,74 panel shadow nozoom nogrow nofloat ;
color scheme 17 ;
title " ("+trim(desc)+") F1: Help F2: Save ESC: cancel "
define window dispmem from 0,6 to 11,74 panel shadow nozoom nogrow nofloat ;
color scheme 19 ;
title " ("+trim(desc)+") F2: Save ESC: Re-edit "
activate window helptxt
go top in 4
do while .not. eof(4)
? " "+fieldlst->fieldno+" "+fieldlst->desc
skip in 4
enddo
show window helptxt bottom
select workletr
do while .t.
do editletr
if lastkey()=27
exit
endif
do displetr
modi memo workletr->actual window dispmem noedit
on key label f2
if lastkey()=27
activate window dispmem
clear
? workletr->actual
else
exit
endif
enddo
clear windows
close databases
return

proc editletr
on key label f1 do helptxt
on key label f2 keyboard chr(23)
modi memo workletr->workletr window memwin
on key label f1
* lines below adds a blank line to the end of the memo before
* printing. for some reason, sometimes the last line doesn't print
if right(workletr->workletr,3) <> "~" + chr(13) + "~"
replace workletr->workletr with "~"+chr(13)+"~" additive
endif
return


procedure helptxt
activate window helptxt
clear
go top in 4
do while .not. eof(4)
? " "+fieldlst->fieldno+" "+fieldlst->desc
skip in 4
enddo
?
if prow() > 12
@21,25 prompt " Press return to continue "
menu to ki
@21,25 say " "
endif
text
To use any of these fields, preceed them with a # sign, as in #A. The #
sign can not be used in the letter in any other way as it will be ignored
along with the character which follows it. The lines of the letter will be
no longer than 65 characters, and will break at this point, regardless of
where they were broken in the text that you entered. If you want to break
a line at a specific point, as in Dear #A; <-(break here), enter a tilde
(~), as in Dear #A;~ (the tilde will not print). Naturally, the tilde can
not be used in the letter for any other purpose.
endtext
@21,25 prompt " Press return to continue "
menu to ki
@21,25 say " "
show window helptxt bott
return


proc displetr
select children
go top
bday=ctod(left(dtoc(birth),6)+right(str(year(date())),2))
replace workletr->actual with ""
for lyne=1 to memline(workletr->workletr)
store mline(workletr->workletr,lyne) to workline
if empty(workline)
replace workletr->actual with chr(13)+chr(13) additive
loop
endif
do while "#" $ workline
checkdig=substr(workline,at("#",workline)+1,1)
fillexpr=""
do checkcar
workline=strtran(workline,"#"+checkdig,fillexpr,1,1)
enddo
if "~" $ workline
workline=strtran(workline,"~",chr(13))
else
if right(workline,1) # " "
workline=workline+" "
endif
endif
replace workletr->actual with workline additive
endfor
return

proc checkcar
select fieldlst
if seek(proj+upper(checkdig))
fld=feeld
select children
fillexpr=&fld
else
wait window " Error: undefined character "+checkdig+" used - press return. "
endif
return

  3 Responses to “Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : BROWZE.ZIP
Filename : MAKELETR.PRG

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. 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/