home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
dedit.zip
/
DEDIT.PRG
< prev
next >
Wrap
Text File
|
1986-06-26
|
7KB
|
287 lines
CLEAR
SET TALK OFF
Store "Tex-a-Caid RBBS (512) 465-4690 Presents..." TO anline
Store 8 to mline
Store 60 to scol
STORE LEN(anline) TO mlen
STORE mlen TO mstart
DO WHILE mstart > 0
@ mline-1,0 SAY SUBSTR(anline,mstart)
STORE mstart - 1 TO mstart
ENDDO
STORE " " TO mspace
STORE 1 TO mcount
DO WHILE mcount < scol
IF mcount > scol-mlen
EXIT
ENDIF
@ mline-1,0 SAY mspace + SUBSTR(anline,1,mlen)
STORE mspace + " " TO mspace
STORE mcount + 1 TO mcount
ENDDO
SET TALK OFF
Store " Dedit & Utilities, A Clippered External Editor for DBF Files." TO anline
Store 10 to mline
Store 70 to scol
STORE LEN(anline) TO mlen
STORE mlen TO mstart
DO WHILE mstart > 0
@ mline-1,0 SAY SUBSTR(anline,mstart)
STORE mstart - 1 TO mstart
ENDDO
STORE " " TO mspace
STORE 1 TO mcount
DO WHILE mcount < scol
IF mcount > scol-mlen
EXIT
ENDIF
@ mline-1,0 SAY mspace + SUBSTR(anline,1,mlen)
STORE mspace + " " TO mspace
STORE mcount + 1 TO mcount
ENDDO
SET TALK OFF
Store " Create .DBF Files, Edit .DBF Files, List Contents of .DBF Files" TO anline
Store 12 to mline
Store 71 to scol
STORE LEN(anline) TO mlen
STORE mlen TO mstart
DO WHILE mstart > 0
@ mline-1,0 SAY SUBSTR(anline,mstart)
STORE mstart - 1 TO mstart
ENDDO
STORE " " TO mspace
STORE 1 TO mcount
DO WHILE mcount < scol
IF mcount > scol-mlen
EXIT
ENDIF
@ mline-1,0 SAY mspace + SUBSTR(anline,1,mlen)
STORE mspace + " " TO mspace
STORE mcount + 1 TO mcount
ENDDO
SET TALK OFF
Store "This Program incorporates a number of PD dBase routines, and is offered" TO anline
Store 14 to mline
Store 74 to scol
STORE LEN(anline) TO mlen
STORE mlen TO mstart
DO WHILE mstart > 0
@ mline-1,0 SAY SUBSTR(anline,mstart)
STORE mstart - 1 TO mstart
ENDDO
STORE " " TO mspace
STORE 1 TO mcount
DO WHILE mcount < scol
IF mcount > scol-mlen
EXIT
ENDIF
@ mline-1,0 SAY mspace + SUBSTR(anline,1,mlen)
STORE mspace + " " TO mspace
STORE mcount + 1 TO mcount
ENDDO
SET TALK OFF
Store "Free of Charge and restriction. The combined source code is available" TO anline
Store 16 to mline
Store 73 to scol
STORE LEN(anline) TO mlen
STORE mlen TO mstart
DO WHILE mstart > 0
@ mline-1,0 SAY SUBSTR(anline,mstart)
STORE mstart - 1 TO mstart
ENDDO
STORE " " TO mspace
STORE 1 TO mcount
DO WHILE mcount < scol
IF mcount > scol-mlen
EXIT
ENDIF
@ mline-1,0 SAY mspace + SUBSTR(anline,1,mlen)
STORE mspace + " " TO mspace
STORE mcount + 1 TO mcount
ENDDO
SET TALK OFF
Store "For Downloading from TEX-A-CAID. 24 Hours a Day 7 Days a Week" TO anline
Store 18 to mline
Store 68 to scol
STORE LEN(anline) TO mlen
STORE mlen TO mstart
DO WHILE mstart > 0
@ mline-1,0 SAY SUBSTR(anline,mstart)
STORE mstart - 1 TO mstart
ENDDO
STORE " " TO mspace
STORE 1 TO mcount
DO WHILE mcount < scol
IF mcount > scol-mlen
EXIT
ENDIF
@ mline-1,0 SAY mspace + SUBSTR(anline,1,mlen)
STORE mspace + " " TO mspace
STORE mcount + 1 TO mcount
ENDDO
SET TALK OFF
Store "Jim Westbrook & Warren Watford Co-Sysops" TO anline
Store 20 to mline
Store 59 to scol
STORE LEN(anline) TO mlen
STORE mlen TO mstart
DO WHILE mstart > 0
@ mline-1,0 SAY SUBSTR(anline,mstart)
STORE mstart - 1 TO mstart
ENDDO
STORE " " TO mspace
STORE 1 TO mcount
DO WHILE mcount < scol
IF mcount > scol-mlen
EXIT
ENDIF
@ mline-1,0 SAY mspace + SUBSTR(anline,1,mlen)
STORE mspace + " " TO mspace
STORE mcount + 1 TO mcount
ENDDO
SET TALK OFF
Store " " TO anline
Store 22 to mline
Store 60 to scol
STORE LEN(anline) TO mlen
STORE mlen TO mstart
DO WHILE mstart > 0
@ mline-1,0 SAY SUBSTR(anline,mstart)
STORE mstart - 1 TO mstart
ENDDO
STORE " " TO mspace
STORE 1 TO mcount
DO WHILE mcount < scol
IF mcount > scol-mlen
EXIT
ENDIF
@ mline-1,0 SAY mspace + SUBSTR(anline,1,mlen)
STORE mspace + " " TO mspace
STORE mcount + 1 TO mcount
ENDDO
wait
DO WHILE .T.
CLEAR
SET TALK OFF
SET ESCAPE OFF
SET PROCEDURE TO menprc
Rev_Scrn = Space(8)
Norm_Scrn = Space(8)
message1='[1] Edit Existing DBF'
command1='do edit.prg'
help1='Field Editor for DBF '
message2='[2] Directory Listing'
command2='do dir.prg'
help2='Lists Contents of the Current Directory'
message3='[3] List Records in Selected DBF'
command3='do lister.prg'
help3='List the Contents of a DBF'
message4='[4] Create a New DBF'
command4='do creator.prg'
help4='Create a New DBF'
bar=REPLICATE(CHR(205),78)
u_bar=REPLICATE(CHR(196),78)
a= DATE()
message0='[0] Quit to DOS'
help0='Exit Program and Return to DOS'
normal = 'W/N'
reverse = 'N/W'
up_arrow =5
down_arrow =24
space_bar =32
car_return =13
min_choice =47
max_choice = 52
cdate = CMONTH(a) + STR(DAY(a),3) + ','+ STR(YEAR(a),5)
hdrmessage = ' '
max_count= 4
hdrmessage='External Editior for DBF Files'
counter = 1
new_counter = 1
*** START MAIN PROGRAM
SET COLOR TO &normal
CLEAR
DO banner WITH hdrmessage
@ 7,30 SAY message1
@ 8,30 SAY message2
@ 9,30 SAY message3
@ 10,30 SAY message4
@ 15,30 SAY message0
@ 22,3 SAY ' Press Arrow Keys To Move Highlighted Bar [Enter] To Select'
@ 23,3 SAY ' Or Press Number Indicating Your Selection '
SET COLOR TO &reverse
@ 7,30 SAY message1
SET COLOR TO &normal
DO WHILE .T.
selection = 0
DO WHILE selection = 0
selection = INKEY()
ENDDO
DO CASE
CASE (selection = up_arrow)
new_counter = counter - 1
CASE (selection = space_bar .OR. selection = down_arrow)
new_counter = counter + 1
CASE (selection = car_return)
exit
CASE (selection >= min_choice .AND. selection <= max_choice)
counter = selection - 48
exit
ENDCASE
IF new_counter > max_count
new_counter = 0
ENDIF
IF new_counter < 0
new_counter = 1
ENDIF
SET COLOR TO &normal
oldmessage = 'message'+STR(counter,1)
IF counter <> 0
@ counter+6,30 SAY &oldmessage
@ 23,0
ELSE
@ 15,30 SAY &oldmessage
ENDIF
SET COLOR TO &reverse
message = 'message' + STR(new_counter,1)
IF new_counter <> 0
@new_counter+6,30 SAY &message
ELSE
@ 15,30 SAY &message
ENDIF
Mhelp = 'help' + STR(new_counter,1)
@ 22,1
@ 22,3 SAY &Mhelp
counter = new_counter
ENDDO
mprogram = 'program'+STR(counter,1)
SET COLOR TO &normal
DO CASE
CASE counter = 1
do edit.prg
CASE counter = 2
do dir.prg
CASE counter = 3
do lister.prg
CASE counter = 4
do creator.prg
CASE counter = 0
SET COLOR TO &normal
@ 0,0 clear
Quit
ENDCASE
SET COLOR TO &normal
ENDDO [WHILE .T.]