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

** PROGRAM: 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