Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : HELPDEMO.ZIP
Filename : HELPDEMO.PRG
** AUTHOR: CRAIG HESSEL
** DATE WRITTEN: DEC 1989
** REQUIRES: SUMMER '87 CLIPPER
parameters mono
* M/m in command-line argument forces mono display (e.g., for laptops)
if type("mono")="U"
mono=""
endif
* Set some program constants
set wrap on
c_norm="w/b,w+/b,bg"
c_err1="gr+/r"
c_err2="n/r"
m_norm="w/n,n/w"
m_err1="w+/n"
m_err2="w/n"
if iscolor() .and. !("M"$upper(mono))
norm=c_norm
err1=c_err1
err2=c_err2
else
norm=m_norm
err1=m_err1
err2=m_err2
endif
set color to &norm
* Explicit call, displaying block 1 with defaults--creates public help[]
clear
do help with "",1
* Set some help parameters
debug_on=.f.
cursor_on=set_cursor(.f.) && Flag should always match cursor state
f1_on=set_f1(.t.) && Flag should always match F1 key state
init_help(10,46,20,76,3,err1,err2)
* MAIN MENU LOOP
choice=1
do while .t.
clear
@ 1,26 say " H E L P D E M O "
@ 3,24 to 13,55 double
@ 4,26 prompt "1. Display HELP.PRG "
@ 5,26 prompt "2. Display HELPDEMO.PRG "
@ 6,26 prompt "3. Toggle Help Colors "
@ 7,26 prompt "4. Toggle Help Debug "
@ 8,26 prompt "5. Toggle F1 Help "
@ 9,26 prompt "6. Toggle Border/Shadow "
@ 10,26 prompt "7. Resize Help Window "
@ 11,26 prompt "8. Change Title/Footer/Etc. "
@ 12,26 prompt "Q. Quit (F1 demos no help) "
menu to choice
do case
* OPTION 1: Display HELP.PRG
case choice=1
dispfile("HELP.PRG")
* OPTION 2: Display HELPDEMO.PRG
case choice=2
dispfile("HELPDEMO.PRG")
* OPTION 3: Toggle Help Colors
case choice=3
store "" to c1,c2
read_help(.f.,.f.,.f.,.f.,.f.,@c1,@c2)
init_help(.f.,.f.,.f.,.f.,.f.,c2,c1)
center(15,"Border and interior colors now swapped")
waitpass(3) && Wait up to 3 seconds, passing key
* OPTION 4: Toggle Help Debug
case choice=4
debug_on=!debug_on
center(15,"Debug help now "+iif(debug_on,"ON","OFF"))
waitpass(3) && Wait up to 3 seconds, passing key
* OPTION 5: Toggle F1 Help
case choice=5
f1_on=set_f1(!f1_on)
center(15,"F1 key now "+iif(f1_on,"ON","OFF"))
waitpass(3) && Wait up to 3 seconds, passing key
* OPTION 6: Toggle Border/Shadow
case choice=6
store 0 to border
read_help(.f.,.f.,.f.,.f.,@border)
border=iif(border=3,0,border+1)
init_help(.f.,.f.,.f.,.f.,border)
center(15,"Now "+iif(border<2,"sing","doub")+"le bar border with"+;
iif(mod(border,2)=1,""," NO")+" shadow")
waitpass(3) && Wait up to 3 seconds, passing key
* OPTION 7: Resize Help Window
case choice=7
store 0 to t,l,b,r
read_help(@t,@l,@b,@r)
@ 15,32 say " Top: " get t picture "99" valid valid_udf()
@ 16,32 say " Left: " get l picture "99" valid valid_udf()
@ 17,32 say "Bottom: " get b picture "99" valid valid_udf()
@ 18,32 say " Right: " get r picture "99" valid valid_udf()
cursor_on=set_cursor(.t.)
read
cursor_on=set_cursor(.f.)
if lastkey()<>27
init_help(t,l,b,r)
endif
* OPTION 8: Change Title/Footer/Etc.
case choice=8
store "" to title,footer,errmsg,eotmark
read_help(.f.,.f.,.f.,.f.,.f.,.f.,.f.,;
@title,@footer,@errmsg,@eotmark)
title=left(title+space(20),20)
footer=left(footer+space(20),20)
errmsg=left(errmsg+space(20),20)
eotmark=left(eotmark+space(20),20)
@ 15,22 say " Title: " get title valid valid_udf()
@ 16,22 say " Footer: " get footer valid valid_udf()
@ 17,22 say "Error message: " get errmsg valid valid_udf()
@ 18,22 say " EOT marker: " get eotmark valid valid_udf()
cursor_on=set_cursor(.t.)
read
cursor_on=set_cursor(.f.)
if lastkey()<>27
init_help(.f.,.f.,.f.,.f.,.f.,.f.,.f.,;
alltrim(title),alltrim(footer),alltrim(errmsg),alltrim(eotmark))
endif
* OPTION Q: Return to DOS
case choice=9
cursor_on=set_cursor(.t.)
clear
exit
endcase
enddo
quit
**********
* Display (first 63K of) file. Memory hog function. Use with care.
* Needs more than twice RAM required for displayed text.
**********
FUNCTION DISPFILE
parameters filename
if type("help_")<>"A"
init_help() && Insure help_[] created
endif
private savehelp[len(help_)],ok
acopy(help_,savehelp) && Preserve current parameters
release help_ && So defaults regenerated, except next
ok=init_help(.f.,.f.,.f.,.f.,.f.,.f.,.f.,;
filename,.f.,.f.,.f.,.f.,"",filename,"")
&& Last null prevents read of wrong index
do help with "",1 && Display first (only) block
acopy(savehelp,help_) && Restore parameters
return ok
**********
* Center display message on line after clearing line.
**********
FUNCTION CENTER
parameters line,message
message=left(alltrim(message),80)
@ line,0 clear to line,79
@ line,40-len(message)/2 say message
return 0
**********
* Wait up to indicated number of seconds, passing key if possible.
**********
FUNCTION WAITPASS
parameters sec
sec=inkey(sec)
if sec>-1 .and. sec<256
keyboard chr(sec)
endif
return 0
**********
* This function returns block number 1, 2, 3, ... of help block within the
* help text file, or 0 if help is unavailable. Not called on explicit HELP
* calls.
*
* The function is application-specific. Use readvar(), prog/line/var, or
* any necessary global parameters to pinpoint desired block of help text.
**********
FUNCTION HELP_UDF
parameters prog,line,var
do case
case var=="CHOICE"
return &var + 1
case var=="T" .or. var=="L" .or. var=="B" .or. var=="R"
return 8
case var=="TITLE" .or. var=="FOOTER" .or.;
var=="ERRMSG" .or. var=="EOTMARK"
return 9
endcase
return 0 && HELP unavailable
**********
* On error, return .f. and stuff F1 key into keyboard buffer to force
* appropriate help display.
**********
FUNCTION VALID_UDF
do case
case readvar()=="T"
if t>=0 .and. t<=22
return .t.
endif
case readvar()=="L"
if l>=0 .and. l<=71
return .t.
endif
case readvar()=="B"
if b>=t+2 .and. b<=24
return .t.
endif
case readvar()=="R"
if r>=l+8 .and. r<=79
return .t.
endif
case readvar()=="ERRMSG" && Just to demo string error--error message
if !empty(errmsg) && may be null, although not recommended
return .t.
endif
otherwise
return .t.
endcase
tone(100,3) && Beep and force help display on error
keyboard chr(28) && F1 key
return .f.
* EOF
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/