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

**||INTERACT.PRG updated on- Friday, October 30, 1987 at- 2:43 pm
**||(c)1987, D M Sampson Consulting




function incomplete
private temp,chr1,chr2
save screen to temp
@ 10,10 clear to 16,69
@ 10,10 to 16,69 double
chr1 = 'This section has not been completed yet.'
chr2 = 'Hit any key to return'
center(12,chr1)
center(14,chr2)
set console off
?? chr(07)
wait
set console on
restore screen from temp
return .t.




function response
parameter chr1,chr2,time,vald
@ 23,00
@ 24,00
@ 23,(80 - len(chr1))/2 say upper(chr1)
@ 24,(80 - len(chr2))/2 say upper(chr2)
if time > 0
inkey(time)
else
set console off
wait '' to answr
set console on
endif
@ 23,00
@ 24,00
chr1 = ''
chr2 = ''
answr = upper(answr)
return iif(upper(vald) = 'ALL',.t.,(answr$upper(vald)))




function ndexdisp
parameter _row, _mess
private _expr
_expr = _mess+str(recno(),4)+' of '+str(lastrec(),4)
@ row,10 say _expr
return ('')




function message
parameter _c1,_c2,_c3
private ckey,nkey,pause
save screen && remember how screen looked prior to call
pause = '10'
@ 05,10 clear to 15,70 && clear screen for box outline
@ 05,10 to 15,70 double && draw actual box outline
center(07,_c1) && display line #1 centered at row 07
center(09,_c2) && display line #2 centered at row 09
center(11,_c3) && display line #3 centered at row 11
center(13,'After &pause seconds I will move on without you')
set console off
nkey = inkey(val(pause)) && waiting for user input
ckey = chr(nkey)
set console on
restore screen && return screen to its original appearance
return upper(ckey) && return user input in uppercase




function stop
set console off
wait
set console on
return .t.




function ascresp
parameter chr1,chr2
private key
@ 23,00
center(23,chr1)
@ 24,00
center(24,chr2)
key = 0
do while key = 0
key = inkey()
enddo
return ascupper(key)




function ascupper
parameter code
return iif( code >= 97 .and. code <= 122, code-32, code )




function readsave
parameter add
@ 23,00
center(23,iif(add,'***** ADDING NEW RECORD *****',;
'***** EDITING CURRENT RECORD *****'))
@ 24,00
center(24,'^End or Esc to drop to bottom')
read save
return updated()




function validfield
parameter fld
private ok
ok = .f.
for i = 1 to fcount()
if fld = field(i)
ok = .t.
i = fcount()
endif
next
return ok
**||End of File-> INTERACT.PRG