Список в консоли

Хороший пример, показывающий чтение символов из консоли. В примере генерятся случайные числа и выводятся на экран. Далее с помощью незатейливого алгоритма, все это дело легко читается при нажатии кнопкой мыши по нужному пункту.
Платформы: Windows, Linux
Автор: Antoni Gual, создано в 2008 году.

список

'Returns string clicked by user from screen
'Displays a cursor at the present mouse position
'by Antoni Gual 7/08
Const minleft=1
Const mintop=1
Const maxbot=25
Const maxright=80


Function recolor(r As Integer,c As Integer) As Integer
   'it reversers the attributes of the char at r, c and returns its ascii code
   Dim As Integer x=Screen(r,c),y=Screen(r,c,1)
   'reverse attributes
   Color ((y Shr 4)And &hf), y And &hf
   Locate r,c
   Print Chr(x);
   Return x
End Function

Function getscreen(r As Integer ,c As Integer) As String
 'reads a space-delimited string from screen starting at any character
 'reverses the screen attributes of the string
 Dim As Integer c1,c2
 Dim As String s
  c1=c
  Do Until Screen(r,c1)<=32 
    c1-=1
    If c1<minleft Then Exit Do 
  Loop   
  c1+=1 
  c2=c
  Do Until Screen(r,c2)<=32  
    c2+=1 
    If c2>maxright Then Exit Do
  Loop 
  c2-=1
  If c1>c2 Then
    Function=""
  Else
   s=Space(c2-c1+1)
   Dim As Integer j=0 
   For i As Integer=c1 To c2
     s[j]=recolor(r,i)
     j+=1
   Next
   Function=s
  End If
End Function

Function ReadMouse (minr As Integer =mintop,minc As Integer =minleft,maxr As _
 Integer=maxbot,maxc As Integer=maxright) As String
  'added a cursor, it reverses the fore- and background attributes 
  'returns a string from the place on screen where the user left-clicked
  'string is delimited by spaces or charecters below 32
  'the optional arguments allow to limit the reading range to a rectangle
  'if the user clicks outside the rectangle, a beep is emited
  'function can be escaped by pressing a key or the right mouse button
  'if escaped the function returns an empty string
     
  Dim As Integer c,r,b,lr=0,lc=0,ok=Color
  Dim As String a
  Do
    Getmouse c,r,,b
    r+=1:c+=1
    If r>=minr And r<=maxr And c>=minc And c<=maxc Then
     If r<>lr Or c<>lc Then 
      If lc*lr<>0 Then a=getscreen(lr,lc)
      a=getscreen(r,c)
      lr=r:lc=c   
     End If
     If b=1 Then If Len(a) Then Exit Do
    Else
      If b=1 Then  Beep
    End If 
    Sleep 100
   Loop Until Len(Inkey) Or b=2
   Dim As String dummy=Getscreen(r,c)  'to remove the cursor before returning
   Color Loword(ok),Hiword(ok)
   Function=a
End Function

'--------------test---------------------

Color 0,15:Cls
Locate ,,0
Print "Use mouse to select a string in this crazy colored table"
Print
Dim As Integer f,b
For i As Integer =1 To 100
  'uncomment to add random colors
  'f=Rnd*16
  'Do:b=Rnd*16:Loop Until b<>f
  'Color f,b  
  Print Using "\      \";right(Str(Int(Rnd *99999999)),Rnd*8);
Next
Color 0,15

Dim As String s
Do
  s=ReadMouse(3,minleft,12,maxright)
  Locate 23,1:
  If Len(s) Then
    ? Using "The string you selected is  \                 \ ";s;
  Else
    ? "You escaped the selection                 "
  End If     
Loop Until Len(s)=0
Print:Print "ended. Press a key";
Sleep