FoxPro Tutorial & Source Code
* Author : Team of Pelagian Softwares
* Date : 22/04/2004
* Source : listinky.prg
* Description : Program to locate database list at key
set esca off
set talk off
set stat off
set safe off
clos data
use student
index on upper(stname) to student
DO getnm WITH 9,48,22,77,'stname',29
proc getnm
para trow,lcol,btrow,rcol,name1,callno,tmname
priv ln,r,c,k,crec,trec,brec,ir,SetClr,scrgetnm
priv nm2,ext,w
nm2=''
ext=.n.
save scre to scrgetnm
w=len(&name1)
IF w<40
w=40
endI
GOTO TOP
crec=iif(EOF(),recc(),recn())
loca for &name1>='0'
GOTO TOP
trec=recn()
GO BOTTOM
brec=recn()
GO crec
flag=.y.
c=lcol
set colo to "GR/BG+"
@0, 0 say "Program written by Pelagian Softwares (2005-06)" colo "w+"
@1, 0 to 1,79 colo "w+"
@12,0 clea to 14,31
@12,0 to 14,31 doub
@trow-4,lcol-1 CLEA TO btrow+2,rcol+1
@trow-4,lcol-1 TO btrow+2,rcol+1
@trow,rcol+1 TO btrow,rcol+1 colo nw+/r+
@trow,rcol+1 say chr(24) colo nw+/r+
@btrow,rcol+1 say chr(25) colo nw+/r+
@trow-3,lcol FILL TO trow-3,rcol colo nw+/b+
@trow-2,lcol TO trow-2,rcol
seekrecord=.t.
@trow-3,lcol+1 say chr(17)+" STUDENT LIST" colo nw+/b+
tmname=btrow-trow+1
*24,0 say tmname
decl tmn[tmname]
i=1
for i=1 to tmname
tmn[i]=''
next i
set colo to w
DO whil .t.
IF flag
crec=recn()
r=trow
I=1
DO whil .not. EOF() .AND. r<=btrow
tmn[i]=&name1
cl="GR+/BG+"
if upper ( &name1 ) = upper(nm2) .and. len(nm2)>0
cl="WB+/BG+"
endI
@r,lcol say &name1 colo (cl)
i=i+1
Skip
r=r+1
IF EOF()
IF r<=btrow
set colo to "GR/BG+"
@r,lcol clea to btrow,rcol
set colo to w
endI
EXIT
endI
endD
msg=i
for i=msg to tmname
tmn[i]=''
next i
if crec<=recc()
go crec
endI
if crec>recc()
goto top
endI
r=trow
flag=.n.
endI
nm1=&name1
nm2=subs(nm1,1,c-lcol)
@r,lcol say &name1 colo /w
@13,1 say spac(30) colo nw+/r+
do mgetnmr with 'rb+/bg+'
@13,1 say nm2 colo nw+/r+
k=inkey(0,'M')
@r,lcol say &name1 colo "GR/BG+"
IF k=27
ext=.y.
exit
endI
do case
case k=13
wait window "Roll No.: "+alltrim(str(roll_no))+" Name: "+alltrim(stname)
case k=19 .or. k=127
c=iif(c>lcol,c-1,lcol)
ln=len(nm2)
if seekrecord
seek UPPER( left(nm2,ln-1) )
endI
if .not. seekrecord
loca for upper(&name1)=left(UPPER(nm2),ln-1)
endi
flag=.y.
case k=4
c=iif(c case k=5
IF recn()=trec
??chr(7)
else
Skip-1
r=r-1
IF r r=trow
DO Scrol WITH trow,lcol,btrow,rcol,-1
endI
endI
case k=24 .or. k=0
IF recn()=brec
??chr(7)
else
Skip
r=r+1
IF r>btrow
r=btrow
DO Scrol WITH trow,lcol,btrow,rcol,1
endI
endI
case k=1
@trow,lcol clea to btrow,rcol
goto top
x=btrow-trow+r-trow
flag=.y.
case k=6
@trow,lcol clea to btrow,rcol
goto bott
x=btrow-trow+r-trow
flag=.y.
case k=18
x=btrow-trow+r-trow
DO whil x>0 .and. recn()#trec
Skip-1
x=x-1
endD
flag=.y.
case k=3
x=btrow-r
DO whil x>0 .and. .not. EOF()
Skip
x=x-1
endD
IF EOF()
go trec
endI
flag=.y.
case k>=32 .and. k<123
k=IIF(k>96,k-32,k)
nm2=subs(nm1,1,c-lcol)+chr(k)
crec=recn()
*IF nm1=nm2
* flag=.y.
* c=iif(c *else
if seekrecord
seek UPPER( nm2 )
endI
if .not. seekrecord
loca for upper(&name1)=UPPER(nm2)
endi
IF EOF()
do NoMatch
go crec
else
flag=.y.
c=iif(c endI
*endI
othe
??chr(7)
eNDC
endD
set colo to w
rest scre from scrgetnm
retu .t.
proc mgetnmr
para clr
orc=recn()
trw=r
if .not. eof()
skip
endI
do whil .not. bof()
skip-1
if trow=trw
exit
endI
trw=trw-1
endD
@trow-1,lcol say ' ' colo (clr)
if .NOT. BOF() .and. trec#recn()
@trow-1,lcol say chr(30)+'... More' colo (clr)
endI
if orc<=recc()
go orc
endI
trw=r
skip-1
do whil .not. eof()
skip
if btrow=trw
exit
endI
trw=trw+1
endD
@btrow+1,rcol-8 say ' ' colo (clr)
if .NOT. EOF() .and. brec#recn()
@btrow+1,rcol-8 say 'More... '+chr(31) colo (clr)
endI
if orc<=recc()
go orc
endI
retu .t.
func scrol
para t,l,b,r,n
scro t,l,b,r,n
REturn .t.
proc nomatch
set bell to 1000,5
??cHR(7)
set bell to 512,2
wait window "No Match.....! TRY AGAIN"
REturn .t.
Also download:
database/student.dbf
|
|
