Buchempfehlung
MySQL kurz & gut
MySQL kurz & gut
Das preiswerte Taschen- buch stellt MySQL-rele- vante Inhalte systematisch und knapp dar, sodass es sich optimal zum Nach- schlagen beim Pro- grammieren eignet. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe Liste
Übersicht / Liste Neu
Datei hochladen Suche
Quellcode suchen Download
Dateidownload

Scrolling text area

Uploader:AdministratorSebastian
Datum/Zeit:20.01.2011 15:54:44

' Scrolling text field (2011/01/20)
' Works with FreeBASIC 0.21.1 (Win32)
' Get example text file:  http://www.gnu.org/licenses/gpl-3.0.txt

Declare Function LimitLen (ByVal Text As String, ByVal Length As Integer) As String

Const MaxLine = 100
#define ShowLineNo

Dim As String MyLines(1 To MaxLine), KeyPressed
Dim As Integer FirstLine = 1, Rows = 20, RedrawTextfield = 1
Dim As Integer i

Open "gpl-3.0.txt" For Input As #1
For i = 1 to MaxLine
    If Eof(1) Then Exit For
    Line Input #1, MyLines(i)
Next i
Close #1

Print "Static line No 1"
Print "Static line No 2"
Print "Static line No 3"

Locate 24,1: Print "Static footer line"

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(27)) OrElse (Lcase(KeyPressed) = "q")) Then 'ESC or q terminate the program
        End
    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 4+i,1: Print String(80," ");
            #ifdef ShowLineNo
                Locate 4+i,1: Print Using "### "; (FirstLine+i)
                Locate 4+i,5: Print LimitLen(MyLines(FirstLine+i),76);
            #else
                Locate 4+i,1: Print LimitLen(MyLines(FirstLine+i),80);
            #endif
        Next i
        RedrawTextfield = 0  'Reset flag
    End if
Loop


'Function to limit line length
Function LimitLen (ByVal Text As String, ByVal Length As Integer) As String
    If Len(Text) > Length Then
        Return Left(Text,Length)
    Else
        Return Text
    End If
End Function