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

 
Output of file : AC_READ.PRG contained in archive : AC_READ.ZIP
**************************
* Author: Ron Lane
* Date: 04/12/89
* BBS: Ron's ROS (817) 540-4183
* Description: Allows for scrolling reads using ACHOICE()
* Achoice works in its normal manner with the ability to edit and
* change the contents of the array. Pressing the Space Bar will
* enter the read, which stays in use till a ESC or pressed
* on a empty GET.
* If array is larger than window, contents will scroll off screen but
* can be scrolled back into view using normal achoice keys.
*
* This PRG will compile to a Demo.
*

DECLARE A_name[20]
AFILL(A_name,SPACE(20))
L_place = 1 && start with first element
L_row = 0 && Position on screen
L_dowhile = .T. && stay in ACHOICE
L_top = 5 && Top of ACHOICE window
L_left = 10 && left
L_bott = 10 && bottom
L_rite = 29 && right

CLEA
@ 1,21 SAY "Press Space bar to Edit, ESC to Exit"

DO WHIL L_dowhile
ACHOICE(L_top,L_left,L_bott,L_rite,A_name,.T.,"GET_READ",L_place,L_row)
ENDD

QUIT

***************************** Get_Read ************************************
* Used by ACHOICE() to get & read
FUNC GET_READ
*
PARA L_mode,L_element,L_position


L_retuum = 2

IF L_mode = 1 .OR. L_mode = 2 && ck mode from ACHOICE
?? CHR(7)

******
ELSEIF L_mode = 3 && keyboard excepition
******

L_Keyp = LASTKEY() && stor lastkey pressed

DO CASE
*
*
CASE L_Keyp = 27 && ESC
*
L_dowhile = .F. && time to quit
L_retuum = 0
*
*
CASE L_Keyp = 13 && CR
*
IF ! EMPTY(A_name[L_element])
KEYBOARD CHR(24) && down one line
ELSE
?? CHR(7)
ENDI
*
*
CASE (L_Keyp > 32 .AND. L_Keyp < 127) && character, return & match
*
L_retuum = 3
*
*
CASE L_Keyp = 1 && home
*
L_element = 1
L_retuum = 1
*
*
CASE L_Keyp = 6 && end
*
L_element = ASCAN(A_name," ") -1 && last element with data
L_retuum = 1
*
*
********************************* Read
CASE L_Keyp = 32 && Space bar, start read
*
SET KEY 5 TO UPKEY && UP arrow
SET KEY 24 TO DNKEY && DOWN arrow

L_ckkey = 0 && ck for up/down after read


SET CURSOR ON && must sub len of (SAY + 1)
@ L_position + L_top,COL()-6 SAY "Name:" GET A_name[L_element]
READ
SET CURSOR OFF

L_row = L_position && set row() to last position

@ L_position + L_top, 0 SAY SPACE(80) && clear @ SAY

IF ! EMPTY(A_name[L_element]) .AND. LASTKEY() != 27 .AND. L_ckkey = 0 .AND. ;
L_element < LEN(A_name)
KEYBOARD CHR(32) && stay in read
L_element = L_element + 1 && next element
IF L_row < (L_bott - L_top)
L_row = L_row + 1
ENDI
ENDI
&& remove this last .AND. to stay in read
IF L_ckkey = 5 .AND. L_element > 1 .AND. ! EMPTY(A_name[L_element])
KEYBOARD CHR(32) && up arrow
L_element = L_element - 1 && prev element
IF L_row <= L_top .AND. L_row > 0
L_row = L_row - 1
ENDI
ENDI
&& remove this last .AND. to stay in read
IF L_ckkey = 24 .AND. L_element < LEN(A_name) .AND. ! EMPTY(A_name[L_element])
KEYBOARD CHR(32) && dn arrow
L_element = L_element + 1 && next element
IF L_row < (L_bott - L_top)
L_row = L_row + 1
ENDI
ENDI

SET KEY 5 TO && clear up/down arrow PROCs
SET KEY 24 TO


L_retuum = 1
*
*
ENDC * --- rl_keyp

ENDI * --- L_mode


L_place = L_element && So we come back in at proper
RETU( L_retuum ) && element
* --- eof get_read

*********************************** Upkey *********************************
PROC UPKEY
CLEA GETS && kill read
L_ckkey = 5
RETU
* --- eof upkey

************************************ Dnkey *********************************
PROC DNKEY
CLEA GETS && kill read
L_ckkey = 24
RETU
* --- eof dnkey

* --- eof ac_read.prg


  3 Responses to “Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : AC_READ.ZIP
Filename : AC_READ.PRG

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. 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/