Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive : NN0401.ZIP
Filename : SCROLLER.PRG
Output of file : SCROLLER.PRG contained in archive : NN0401.ZIP
* Author: David R. Alison
* Version: Clipper Summer '87
* Note(s): Program to demonstrate ACPos(), a menu
* selector with position indicator.
*
* Copyright (c) 1989 David R. Alison
* Placed into Public Domain
*
CLEAR
DECLARE test[ 100 ]
FOR i = 1 TO 100
test[ i ] = 'This is item number ' + STR( i, 3 )
NEXT
i = ACPos( 3, 27, 20, 49, test )
CLEAR
? 'You selected item number ' + LTRIM( STR( i ) )
QUIT
FUNCTION ACPos
*
* Syntax:
* ACPos(
*
* Purpose:
* To provide a scrolling position indicator on an
* ACHOICE() menu.
*
* Arguments:
*
* window coordinates respectively.
*
*
* as menu items.
*
* Returns:
* A numeric value. This value is the index of the menu
* item in the array of choices. If the selection is
* aborted with Escape, ACPos() returns zero.
*
PARAMETERS top, left, bottom, right, ac_array
PRIVATE x, frame
max = LEN( ac_array ) && Number of elements.
old_pos = 0 && Initial position.
winsize = bottom - top && Size of window.
* Frame for box generation.
frame = CHR(201) + CHR(205) + CHR(187) + CHR(186) +;
CHR(188) + CHR(205) + CHR(200) + CHR(186)
@ top - 1, left - 1, bottom + 1, right + 1 BOX frame
* Position indicator row.
@ top, right + 1 SAY CHR(178)
FOR x = top + 1 TO bottom
@ x, right + 1 SAY CHR(176)
NEXT
x = 0
x = ACHOICE(top, left, bottom, right, ac_array, .T., "ACPOS_Udf")
RETURN( x )
FUNCTION ACPos_Udf
* User-Defined function for ACPos ACHOICE().
PARAMETERS status, current, relative
ret_val = 2 && Default return value.
DO CASE
CASE status = 0 && ACHOICE() is idle; update the screen.
* First calculate the new relative position.
new_pos = INT( winsize / ( max / current ) )
IF current = 1
new_pos = 0
ELSEIF current = max
new_pos = winsize
ENDIF
* Erase the old position, write in the new position.
IF old_pos <> new_pos
@ top + old_pos, right + 1 SAY CHR( 176 )
@ top + new_pos, right + 1 SAY CHR( 178 )
old_pos = new_pos
ENDIF
CASE status = 1 .OR. status = 2 && Tried to go.
TONE( 600, 1 ) && Past the end.
CASE status = 3 && Keystroke exception
IF LASTKEY() = 27 && Escape key.
ret_val = 0
ELSEIF LASTKEY() = 13 && Enter key.
ret_val = 1
ELSEIF LASTKEY() = 1 && Home key.
KEYBOARD CHR( 31 )
ret_val = 2
ELSEIF LASTKEY() = 6 && End key.
KEYBOARD CHR( 30 )
ret_val = 2
ELSEIF UPPER( CHR( LASTKEY() ) );
$ 'ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890'
ret_val = 3 && Keystroke exception.
ENDIF
ENDCASE
RETURN( ret_val )
* EOP: Scroller.prg
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
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/