Список в консоли
Хороший пример, показывающий чтение символов из консоли. В примере генерятся
случайные числа и выводятся на экран. Далее с помощью незатейливого алгоритма,
все это дело легко читается при нажатии кнопкой мыши по нужному пункту.
Платформы: 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