Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Scrolling text area - Improved version
| Uploader: |  Sebastian |
| Datum/Zeit: | 20.01.2011 17:04:01 |
' Scrolling text area (2011/01/20)
' Works with FreeBASIC 0.21.1 (Win32)
' Source: http://www.freebasic-portal.de
' Get example text file here: http://www.gnu.org/licenses/gpl-3.0.txt
Declare Function Min (ByVal A As Integer, ByVal B As Integer) As Integer
Declare Function LimitLen (ByVal Text As String, ByVal Length As Integer) As String
Declare Sub DrawScrollbar (ByVal RowA As Integer, ByVal Height As Integer, ByVal RelPos As Single)
Const Rows = 20 'Height (rows) of the scrolling text area
Const YTextArea = 4 'Y coordinate (row) of the first scrolling line
'Remove or comment out this line to disable line number viewing:
#define ShowLineNo
Dim As String KeyPressed, Temp
Dim As Integer FirstLine = 1 'Current scroll position (row)
Dim As Integer RedrawTextfield = 1 'Redraw flag
Dim As Integer MaxLine 'Line buffer size
Dim As Integer i
If Open (ExePath & "\gpl-3.0.txt" For Input As #1) <> 0 Then
Print "Error! Text file not found."
Sleep: End 1
End If
'Count the lines of the text file:
Do Until Eof(1)
Line Input #1, Temp
MaxLine += 1
Loop
Close #1
'MaxLine now contains the number of lines
'Now we know how many lines we have to store. So we can create the line buffer:
Dim MyLines(1 To MaxLine) As String
'Read all the lines into the new array
i = 1
Open ExePath & "\gpl-3.0.txt" For Input As #1
Do Until Eof(1)
If i > MaxLine Then 'Prevent out-of-bound array access (if file just was changed)
Close #1
Print "Error! Too many lines."
Sleep: End 1
End If
Line Input #1, MyLines(i)
i += 1
Loop
Close #1
'Show static part of your console window
'Header
Print String(80,"*");
Print String(29,"*"); " License Agreement "; String(29,"*");
Print String(80,"*");
'Footer
Locate 24,1: Print String(80,"*");
Locate 25,1: Print " => You must agree to these terms to ... whatever ...";
'Main loop
Do
Sleep 1
KeyPressed = Inkey
If (KeyPressed = Chr(255, 80)) Then 'ARROW-DOWN?
If (FirstLine >= (MaxLine-Rows+1)) Then 'Reached bottom
Beep 'Can't scroll down
Else
RedrawTextfield = 1
FirstLine += 1
End If
ElseIf (KeyPressed = Chr(255, 72)) Then 'ARROW-UP?
If (FirstLine = 1) Then 'Reached top
Beep 'Can't scroll up
Else
RedrawTextfield = 1
FirstLine -= 1
End If
ElseIf (KeyPressed = Chr(255,81)) Then 'PG-DOWN?
If (FirstLine >= (MaxLine-Rows+1)) Then 'Reached bottom
Beep 'Can't scroll down
Else
RedrawTextfield = 1
FirstLine += Min(Rows,MaxLine-Rows-FirstLine+1)
End If
ElseIf (KeyPressed = Chr(255, 73)) Then 'PG-UP?
If (FirstLine = 1) Then 'Reached top
Beep 'Can't scroll up
Else
RedrawTextfield = 1
FirstLine -= Min(Rows,FirstLine-1)
End If
ElseIf ((KeyPressed = Chr(27)) OrElse (Lcase(KeyPressed) = "q")) Then 'ESC or q terminate the program
Exit Do
End If
'Do we have to redraw the text area? We only have to do so, if the user scrolled successfully.
If RedrawTextfield = 1 Then
For i = 0 To Rows-1
Locate YTextArea+i,1: Print String(79," ");
#ifdef ShowLineNo
Locate YTextArea+i,1: Print Using "### "; (FirstLine+i)
Locate YTextArea+i,5: Print LimitLen(MyLines(FirstLine+i),75);
#else
Locate YTextArea+i,1: Print LimitLen(MyLines(FirstLine+i),79);
#endif
Next i
DrawScrollbar YTextArea, Rows, Cast(Single,FirstLine)/Cast(Single,(MaxLine-Rows+1))
RedrawTextfield = 0 'Reset flag
End if
Loop
End 0
'Return the minor of two numbers
Function Min (ByVal A As Integer, ByVal B As Integer) As Integer
If (A < B) Then Return A Else Return B
End Function
'Function to limit line length (returns line or shortened line (if necessary))
Function LimitLen (ByVal Text As String, ByVal Length As Integer) As String
If (Len(Text) > Length) Then
Return Left(Text,Length) 'Return shortened line
Else
Return Text 'Return entire line
End If
End Function
Sub DrawScrollbar (ByVal RowA As Integer, ByVal Height As Integer, ByVal RelPos As Single)
If (Height < 4) Then Exit Sub
Dim As Integer ScrollbarLen, ScrollPos
ScrollbarLen = Height - 2 'Total height minus 2 rows (arrows)
ScrollPos = ScrollbarLen * RelPos 'Position (Y) of the scrollbar "scroll block"
If ScrollPos < 1 Then ScrollPos = 1 'If it's 0 (due to integer rounding), assign 1
Locate RowA, 80: Print Chr(30); 'Print: arrow up
Locate RowA+Height-1, 80: Print Chr(31); 'Print: arrow down
For i As Integer = 1 To ScrollbarLen
Locate RowA+i, 80
If i = ScrollPos Then
Print Chr(178);
Else
Print Chr(176);
End If
Next i
End Sub