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

TUI für Konsole oder Grafikfenster - Bugfix Version

Uploader:MitgliedLothar Schirm
Datum/Zeit:09.04.2015 18:18:02

'===============================================================================
' TUI.bas
' TUI für Konsole oder Grafik (8x16 Zeichensatz, 32 Bit Farbtiefe)
' mit Mausunterstützung
' Erstellt am 06.03.2015
' Letzte Bearbeitung am 07.04.15
'===============================================================================


'Wichtige Tastaturabfragecodes, die von Inkey zurueckgegeben werden:
Const SC_BKSP = Chr(8), SC_TAB = Chr(9), SC_SHIFT_TAB = Chr(255, 15), _
            SC_ENTER = Chr(13), SC_ESC = Chr(27), _
            SC_LEFT = Chr(255, 75), SC_RIGHT = Chr(255, 77), _
            SC_UP = Chr(255, 72), SC_DOWN = Chr(255, 80), _
            SC_INS = Chr(255, 82), SC_DEL = Chr(255, 83), _
            SC_END = Chr(255, 79), SC_HOME = Chr(255, 71), _
            SC_PGUP = Chr(255, 73), SC_PGDOWN = Chr(255, 81), _
      SC_F1 = Chr(255, 59), SC_F2 = Chr(255, 60), SC_F3 = Chr(255, 61), _
      SC_F4 = Chr(255, 62), SC_F5 = Chr(255, 63), SC_F6 = Chr(255, 64), _
      SC_F7 = Chr(255, 65), SC_F8 = Chr(255, 66), SC_F9 = Chr(255, 67), _
      SC_F10 = Chr(255, 68), _
      SC_X = Chr(255, 107)  'Button zum Schliessen des Fensters

'RGB-Farbkonstanten der Farbindizes 0 bis 15:
Const black = &H000000, blue = &H0000AA, green = &H00AA00, cyan = &H00AAAA, _
            red = &HAA0000, magenta = &HAA00AA, brown = &HAA5500, grey = &HAAAAAA, _
            darkgrey = &H555555, lightblue = &H5555FF, lightgreen = &H55FF55, _
            lightcyan = &H55FFFF, lightred = &HFF5555, lightmagenta = &HFF55FF, _
            yellow = &HFFFF55, white = &HFFFFFF

Dim Shared As Integer TUI_Mode, TUI_TextColor, TUI_BackColor
'Siehe Function Window_New

Type Button
  x As Integer                  'Linke Spalte
    y As Integer                    'Oberste Zeile
    w As Integer                    'Breite (Anzahl Spalten) (Höhe ist eine Zeile)
    TextColor As Integer    'Textfarbe
    BackColor As Integer    'Hintergrundfarbe
    Caption As String           'Beschriftung
End Type

Type CheckBox
  x As Integer
    y As Integer
    w As Integer
    TextColor As Integer
    BackColor As Integer
    Caption As String
    State As Integer    'Check-Status (1 oder 0)
End Type

Type RadioButton
  x As Integer
    y As Integer
    w As Integer
    TextColor As Integer
    BackColor As Integer
    Caption As String
    State As Integer    'Check-Status (1 oder 0)
End Type

Type Label
  x As Integer
    y As Integer
    w As Integer
    Text As String
End Type

Type TextBox
  x As Integer
    y As Integer
    w As Integer
    TextColor As Integer
    BackColor As Integer
    CursorColor As Integer
    Text As String
    CPos As Integer 'Cursorposition, siehe Sub TextBox_Edit
End Type

Type ListBox
  x As Integer
    y As Integer
    w As Integer
    h As Integer
    TextColor As Integer
    BackColor As Integer
    HighlightTextColor As Integer
    HighlightBackColor As Integer
    buffer(100) As String   'Buffer für Einträge
    imax As Integer             'Höchster Index der Einträge
    index As Integer            'Gewählter Index
End Type

Type TrackBar
  x As Integer
    y As Integer
    w As Integer
    BackColor As Integer
    SliderColor As Integer
    minvalue As Integer     'Minimaler und maximaler Wert
    maxvalue As Integer
    value As Integer            'Aktueller Wert
End Type

Type ProgressBar
  x As Integer
    y As Integer
    w As Integer
    BackColor As Integer
    BarColor As Integer
    minvalue As Integer
    maxvalue As Integer
    value As Integer
End Type


Sub OpenWindow(w As Integer, h As Integer, title As String, Mode As Integer = 0)
    'TUI initialisieren (zeichnen und definieren).
    'Textfarbe weiß, Hintergrundfarbe grau.
    'Mode = 0: Screen 0 (Konsole)
    'Mode = 1: Grafik

    TUI_Mode = Mode

    Select Case TUI_Mode
        Case 0
            Screen 0
            TUI_TextColor = 0
            TUI_BackColor = 7
            Shell "Title" + Space(1) + title
            Width w, h
            Color TUI_TextColor, TUI_BackColor
            Cls
        Case 1
            ScreenRes w * 8, h * 16, 32, 2
            TUI_TextColor = black
            TUI_BackColor = grey
            WindowTitle title
            Width w, h
            Color TUI_TextColor, TUI_BackColor
            Cls
    End Select

    Locate,,0   'Cursor für die Konsole aus

End Sub


Function Window_Event_Close() As Integer
    'Gibt 1 zurück, wenn der "Close" button ("x") des Fensters gedrückt wurde

    If Inkey = SC_X Then Return 1 Else Return 0

End Function


Function MouseInRect(mx As Integer, my As Integer, x As Integer, y As Integer, _
                                            w As Integer) As Integer
    'Gib 1 zurück, wenn sich der Mauszeiger mit den Koordinaten mx und my innerhalb
    'des betreffenden Rechtecks befindet, sonst 0.
    'Hilfsprozedur

      Select Case TUI_Mode
        Case 0
            'Konsole: mx und my fangen mit 0 an zu zählen
            If (mx + 1) >= x And (mx + 1) <= (x + w) And my + 1 =  y Then Return 1 Else Return 0
        Case 1
            'Grafik:
            If mx > 8 * (x - 1) And mx < 8* (x - 1 + w) And my > 16 * (y - 1) And my < 16 * y _
                Then Return 1 Else Return 0
    End Select

End Function


Function Button_New(x As Integer, y As Integer, w As Integer, Text As String) As Button
    'Neuen Button definieren und zeichnen (Textfabe weiß, Hintergrundfarbe dunkelgrau):

    Dim As Button btn

    btn.x = x
  btn.y = y
  btn.w = w
  If TUI_Mode = 0 Then
        btn.TextColor = 15
        btn.BackColor = 8
    Else
        btn.TextColor = white
        btn.BackColor = darkgrey
    End If
  btn.Caption = Text

    Color btn.TextColor, btn.BackColor
    Locate y, x
    Print Space(w)
    Locate y, x + (w - Len(btn.Caption)) \ 2    'zentriert
    Print btn.Caption

  Return btn

End Function


Function Button_Event(btn As Button) As Integer
    'Gibt 1 zurück, wenn der Button gedrückt wurde, sonst 0

    Dim As Integer mx, my, mb

  Getmouse(mx, my,, mb)
  Sleep 1

  If MouseInRect(mx, my, btn.x, btn.y, btn.w) And mb = 1 Then
        'Warten, bis Maustaste losgelassen wird - so lange wird die Beschriftung schwarz
        'gezeichnet:
        If TUI_Mode = 0 Then Color 0, btn.BackColor Else Color black, btn.BackColor
        Locate btn.y, btn.x + (btn.w - Len(btn.Caption)) \ 2, 0 'Konsole Cursor aus
        Print btn.Caption
        Do
            Getmouse(mx, my,, mb)
            Sleep 1
        Loop Until mb = 0
        Color btn.TextColor, btn.BackColor
        Locate btn.y, btn.x + (btn.w - Len(btn.Caption)) \ 2
        Print btn.Caption
        Return 1
    Else
        Return 0
    End If

End Function


Function CheckBox_New(x As Integer, y As Integer, w As Integer, Text As String) As CheckBox
    'Neue Checkbox definieren und zeichnen (Textfabe weiß, Hintergrundfarbe dunkelgrau):

    Dim As CheckBox cb

    cb.x = x
  cb.y = y
  cb.w = w
  If TUI_Mode = 0 Then
        cb.TextColor = 15
        cb.BackColor = 8
    Else
        cb.TextColor = 15
        cb.BackColor = darkgrey
    End If
  cb.Caption = Text
  cb.State = 0

    Color cb.TextColor, cb.BackColor
    Locate y, x
    Print Space(w)
    Locate y, x 'zentriert
    Print "[ ] " + cb.Caption

  Return cb

End Function


Sub CheckBox_SetCheck(ByRef cb As CheckBox, State As Integer)
    'Check-Status einer Checkbox setzen (0 oder 1)

    cb.State = State

    Color cb.TextColor, cb.BackColor
    Locate cb.y, cb.x + 1
    Select Case cb.State
        Case 0
            Print Space(1)
        Case 1
            Print "X"
    End Select

End Sub


Function CheckBox_Event(ByRef cb As CheckBox) As Integer
    'Gibt 1 zurück, wenn die Checkbox gedrückt wurde und schaltet den Check-Status um

    Dim As Integer mx, my, mb, State

  Getmouse(mx, my,, mb)
  Sleep 1

  If MouseInRect(mx, my, cb.x, cb.y, cb.w) And mb = 1 Then
        State = cb.State XOR 1
        CheckBox_SetCheck(cb, State)
        'Warten, bis Maustaste losgelassen wird:
        Do
            Getmouse(mx, my,, mb)
            Sleep 1
        Loop Until mb = 0
        Return 1
    Else
        Return 0
    End If

End Function


Function CheckBox_GetCheck(cb As CheckBox) As Integer
    'Gibt den Check-Status einer Checkbox zurück

    Return cb.State

End Function


Function RadioButton_New(x As Integer, y As Integer, w As Integer, Text As String) As RadioButton
    'Neuen Radiobutton definieren und zeichnen (Textfabe weiß, Hintergrundfarbe dunkelgrau):

    Dim As RadioButton rb

    rb.x = x
  rb.y = y
  rb.w = w
  If TUI_Mode = 0 Then
        rb.TextColor = 15
        rb.BackColor = 8
    Else
        rb.TextColor = white
        rb.BackColor = darkgrey
    End If
  rb.Caption = Text
  rb.State = 0

    Color rb.TextColor, rb.BackColor
    Locate y, x
    Print Space(w)
    Locate y, x 'zentriert
    Print "( ) " + rb.Caption

  Return rb

End Function


Sub RadioButton_SetCheck(ByRef rb As RadioButton, State As Integer)
    'Check-Status eines Radiobuttons setzen (0 oder 1). Innerhalb eines Arrays von
    'Radiobuttons (siehe Function RadioButton_Event) darf maximal einer auf 1 gesetzt
    'sein!

    rb.State = State

    Color rb.TextColor, rb.BackColor
    Locate rb.y, rb.x + 1
    Select Case rb.State
        Case 0
            Print Space(1)
        Case 1
            Print Chr(254)
    End Select

End Sub


Function RadioButton_Event(rb() As RadioButton, Byref k As Integer) As Integer
    'Gibt 1 zurück, wenn ein Radiobutton innerhalb eines Arrays von Radiobuttons
    'angeklickt wurde, sonst 0. k ist der Index desjenigen Radiobuttons, dessen
    'Zustand auf "checked" gesetzt ist, nachdem ein Radiobutton angeklickt wurde.

    Dim As Integer n = UBound(rb), i, mx, my, mb, State, result

  k = -1
  Getmouse(mx, my,, mb)
  Sleep 1

  For i = 0 To n
        If MouseInRect(mx, my, rb(i).x, rb(i).y, rb(i).w) And mb = 1 Then
            'Zustand des gedrückten Radiobuttons auf 1 schalten:
            If rb(i).State = 0 Then RadioButton_SetCheck(rb(i), 1)
            'Warten, bis Maustaste losgelassen wird:
            Do
                Getmouse(mx, my,, mb)
                Sleep 1
            Loop Until mb = 0
            k = i
            result = 1
            Exit For
        End If
    Next

    'Zustand aller anderen Radiobuttons auf 0 schalten:
    If k >= 0 Then
        For i = 0 To n
            If i <> k And rb(i).State = 1 Then RadioButton_SetCheck(rb(i), 0)
        Next
    End If

    Return result

End Function


Function Label_New(x As Integer, y As Integer, w As Integer, text As String) As Label
    'Neuen Label definieren und zeichnen

    Dim As Label lbl

    lbl.x = x
  lbl.y = y
  lbl.w = w
  lbl.Text = text

  Color TUI_TextColor, TUI_BackColor
  Locate y, x
  Print Space(lbl.w)
  Locate y, x
  Print lbl.Text

  Return lbl

End Function


Function TextBox_New(x As Integer, y As Integer, w As Integer, text As String = "") _
                                            As TextBox
    'Neue Textbox definieren und zeichnen (Textfarbe schwarz, Hintergrund weiß,
    'Cusorfarbe für Grafik rot):

    Dim As TextBox tb

    tb.x = x
  tb.y = y
  tb.w = w
  If TUI_Mode = 0 Then
        tb.TextColor = 0
        tb.BackColor = 15
    Else
        tb.TextColor = black
        tb.BackColor = white
        tb.CursorColor = cyan
    End If
  tb.Text = text

  Color tb.TextColor, tb.BackColor
  Locate y, x
  Print Space(w)
  Locate y, x
  Print Left(tb.Text, Len(tb.Text))

  Return tb

End Function


Sub TextBox_SetText(ByRef tb As TextBox, text As String)
    'Text einer Textbox neu setzen

    tb.Text = text
    Color tb.TextColor, tb.BackColor
    Locate tb.y, tb.x
    Print Space(tb.w)
    Locate tb.y, tb.x
    Print Left(tb.Text, tb.w)

End Sub


Function TextBox_GetText(tb As Textbox) As String
    'Text von der

    Return tb.text

End Function


Sub TextBox_Edit(ByRef tb As TextBox, ReadOnly As Integer = 0)
    'Text der Textbox editieren. ReadOnly = 1: Text kann nicht editiert werden,
    'nur gescrollt

    Dim As String strKey
    Dim As Integer ascKey, Offset, mx, my, mb

    Color Tb.TextColor, tb.BackColor

  Do

    'Text mit Cursor anzeigen:
    If TUI_Mode = 1 Then ScreenLock
    Locate tb.y, tb.x, 1    'Konsole Cursor ein
    Print Space(tb.w);
    Locate tb.y, tb.x
    Print Mid(tb.text, Offset + 1, tb.w);
    Locate tb.y, tb.x + tb.CPos - Offset
    If TUI_Mode = 1 Then
            Draw String (8 * (tb.x - 1 + tb.CPos - Offset), 16 * (tb.y - 1)), _
                                                                            "_", tb.CursorColor
            ScreenUnlock
    End If

    'Maus abfragen und Cursorposition setzen:
    GetMouse mx,my,,mb
    'Längere Wartezeit setzt das Flimmern im Konsolenmode herab:
        If TUI_Mode = 0 Then Sleep 100 Else Sleep 1
        If MouseInRect(mx, my, tb.x, tb.y, tb.w) And mb = 1 Then
            If TUI_Mode = 0 Then tb.CPos = mx + 1 - tb.x + Offset _
                Else tb.CPos = (mx - 8 * (tb.x - 1)) \ 8 + Offset
            If tb.CPos > Len(tb.Text) Then tb.CPos = Len(tb.Text)
        End If

    'Tasten abfragen:
    strKey = Inkey

        Select Case strKey
            Case SC_LEFT
                'Cursor nach links:
                If tb.CPos > 0 Then
                    tb.CPos = tb.CPos - 1
                    If tb.CPos < Offset Then Offset = Offset - 1
                End If
            Case SC_RIGHT
                'Cursor nach rechts:
                If tb.CPos < Len(tb.Text) Then
                    tb.CPos = tb.CPos + 1
                    If tb.CPos > tb.w - 1 + Offset Then Offset = Offset + 1
                End If
            Case SC_HOME
                'Cursor an den Anfang:
                tb.CPos = 0
                Offset = 0
            Case SC_END
                'Cursor ans Ende:
                tb.CPos = Len(tb.Text)
                If Len(tb.Text) > tb.w Then Offset = Len(tb.Text) - tb.w
            Case SC_DEL
                'Entf
                If ReadOnly = 0 Then
                    If (Len(tb.Text) > 0) And (tb.CPos < Len(tb.Text)) Then _
                        tb.Text = Left(tb.Text, tb.CPos) + Right(tb.Text, Len(tb.Text) - tb.CPos - 1)
                End If
            Case SC_BKSP
                'Backspace:
                If ReadOnly = 0 Then
                    If (Len(tb.Text) > 0) And (tb.CPos > 0) Then
                        tb.Text = Left(tb.Text, tb.CPos - 1) + Right(tb.Text, (Len(tb.Text) - tb.CPos))
                        tb.CPos = tb.CPos - 1
                        If Offset > 0 Then Offset = Offset - 1
                    End If
                End If
            Case Else
                If ReadOnly = 0 And Len(strKey) = 1 And Asc(strKey) > 30 Then
                    'Druckbare Zeichen:
                    tb.Text = Left(tb.Text, tb.CPos) + strKey + Right(tb.Text, Len(tb.Text) - tb.CPos)
                    tb.CPos = tb.CPos + 1
                    If tb.CPos > tb.w - 1 + Offset Then Offset = Offset + 1
                End If

        End Select

    Loop Until strKey = SC_ENTER Or (mb = 1 And MouseInRect(mx, my, tb.x, tb.y, tb.w) = 0)

    'Ende:
    Locate tb.y, tb.x
    Print Space(tb.w);
    Locate tb.y, tb.x, 0    'Cursor wieder aus
    Print Left(tb.Text, tb.w);

End Sub


Function TextBox_Event(ByRef tb As TextBox) As Integer
    'Gibt 1 zurück, wenn die Textbox angeklickt wurde und speichert die durch den
    'Mausklick definierte Cursorposition

    Dim As Integer mx, my, mbtn

  Getmouse(mx, my,, mbtn)
  Sleep 1

  If MouseInRect(mx, my, tb.x, tb.y, tb.w) And mbtn = 1 Then
        If TUI_Mode = 0 Then tb.CPos = mx + 1 - tb.x Else tb.CPos = (mx - 8 * tb.x) \ 8
        If tb.Cpos > Len(tb.text) Then tb.CPos = Len(tb.text)
        Return 1
    Else
        Return 0
    End If

End Function


Function ListBox_New(x As Integer, y As Integer, w As Integer, h As Integer) As ListBox
    'Neue Listbox definieren und zeichnen (Textfarbe schwarz, Hintergrundfarbe weiß)

    Dim As ListBox lb
    Dim As Integer i

    lb.x = x
    lb.y = y
    lb.w = w
    lb.h = h

    Select Case TUI_Mode
        Case 0
            lb.TextColor = 0
            lb.BackColor = 15
            lb.HighlightTextColor = 15
            lb.HighlightBackColor = 3
        Case 1
            lb.TextColor = black
            lb.BackColor = white
            lb.HighlightTextColor = white
            lb.HighlightBackColor = cyan
    End Select

    For i = 0 To 100
        lb.buffer(i) = ""
    Next

    lb.imax = - 1
    lb.index = - 1

    Color lb.TextColor, lb.BackColor
    For i = 0 To h - 1
        Locate y + i, x
        Print Space(w)
    Next

    Return lb

End Function


Sub ListBox_Add(ByRef lb As ListBox, item As String)
    'Einen Eintrag hizufügen - maximal sind lb.h Einträge möglich (Index 0 bis h - 1)

    Color lb.TextColor, lb.BackColor
    If lb.imax < lb.h - 1 Then
        lb.imax = lb.imax + 1
        lb.buffer(lb.imax) = item
        Locate lb.y + lb.imax, lb.x
        Print Left(item, lb.w);
    End If

End Sub


Sub ListBox_Clear(ByRef lb As ListBox)
    'Alle Einträge in der Listbox löschen

    Dim As Integer i

    For i = 0 To lb.imax
        lb.buffer(i) = ""
    Next
    lb.index = -1
    lb.imax = -1
    Color lb.TextColor, lb.BackColor
    For i = 0 To lb.h
        Locate lb.y + i, lb.x
        Print Space(lb.w);
    Next

End Sub


Function ListBox_Event(ByRef lb As ListBox) As Integer
    'Gibt 1 zurück, wenn ein Eintrag angeklickt wurde und speichert den zugehörigen
    'Index als lb.index

    Dim As Integer i, index, mx, my, mb, result

    Getmouse(mx, my,, mb)
  Sleep 1

  For i = 0 To lb.imax
        If MouseInRect(mx, my, lb.x, lb.y + i, lb.w) And mb = 1 Then
            'Vorher markierten Index zurücksetzen:
            If lb.index >= 0 Then
                Color lb.TextColor, lb.BackColor
                Locate lb.y + lb.index, lb.x
                Print Space(lb.w)
                Locate lb.y + lb.index, lb.x
                Print Left(lb.buffer(lb.index), lb.w)
            End If
            'Neuen Index speichern, Eintrag hervorheben:
            lb.index = i
            Color lb.HighlightTextColor, lb.HighlightBackColor
            Locate lb.y + i, lb.x
            Print Space(lb.w)
            Locate lb.y + i, lb.x
            Print Left(lb.buffer(i), lb.w)
            result = 1
            Exit For
        Else
            result = 0
        End If
    Next

    Return result

End Function


Function ListBox_GetIndex(lb As ListBox) As Integer
    'Gibt den gewählten Index zurück

    Return lb.index

End Function


Sub ListBox_SetIndex(ByRef lb As ListBox, index As Integer)
    'Index der Listbox setzen

    If index <= lb.imax And index >= 0 Then
        'Vorher markierten Index zurücksetzen:
        If lb.index >= 0 Then
            Color lb.TextColor, lb.BackColor
            Locate lb.y + lb.index, lb.x
            Print Space(lb.w)
            Locate lb.y + lb.index + 1, lb.x
            Print Left(lb.buffer(lb.index), lb.w)
        End If
        'Neuen Index speichern, Eintrag hervorheben:
        lb.index = index
        Color lb.HighlightTextColor, lb.HighlightBackColor
        Locate lb.y + index, lb.x
        Print Space(lb.w)
        Locate lb.y + index, lb.x
        Print Left(lb.buffer(index), lb.w)
    End If

End Sub


Function ListBox_GetItem(lb As ListBox, index As Integer) As String
    'Gibt den zum Index zugehörigen Text zurück

    If index >= 0 Then Return lb.buffer(index) Else Return ""

End Function


Function InputBox(x As Integer, y As Integer, w As Integer, Prompt As String, _
                                    ByRef Text As String = "") As String
    'Zweizeilige Inputbox gelb, gibt einen eingegebenen Text zurück.
    'Prompt = Frage o.ä, Text = vorbelegter Text

    Dim As TextBox tb
    Dim  As Button btn
    Dim As Integer i

    'Bildschirm speichern und Box zeichnen:
    PCopy 0, 1
    If TUI_Mode = 0 Then Color 0, 14 Else Color black, yellow
    For i = 0 To 2
        Locate y + i, x
        Print Space(w)
    Next
    Locate y, x + 1
    Print Left(Prompt, w - 2)
    tb = TextBox_New(x + 1, y + 1, w - 8, text)
    btn = Button_New(x + w - 6, y + 1, 4, "Ok")

    'Event-Loop:
    Do
        If TextBox_Event(tb) Then TextBox_Edit(tb)
    Loop Until Button_Event(btn)

    'Bildschirm restaurieren und Ende
    PCopy 1, 0
    Return TextBox_GetText(tb)

End Function


Function MsgBox(x As Integer, y As Integer, w As Integer, Text As String, _
                                ButtonText0 As String = "Ok", ButtonText1 As String = "", _
                                ButtonText2 As String = "") As Integer
    'Dreizeilige Messagebox gelb mit bis zu drei Buttons Nr. 0 bis 2 (von links nach
    'rechts angeordnet). Rückgabewert ist die Nummer des gedrückten Buttons

    Dim As Button btn0, btn1, btn2
    Dim As Integer i, w0, w1, w2, result

    'Bildschirm speichern und Box zeichnen:
    PCopy 0, 1
    If TUI_Mode = 0 Then Color 0, 14 Else Color black, yellow
    For i = 0 To 2
        Locate y + i, x
        Print Space(w)
    Next
    Locate y, x + 1
    Print Left(Text, w - 2)

    'Buttons rechtsbündig plazieren:
    If Len(ButtonText2) > 0 And Len(ButtonText1) > 0 And Len(ButtonText0) > 0 Then
        'Alle drei Buttons:
        w2 = Len(ButtonText2) + 2
        w1 = Len(ButtonText1) + 2
        w0 = Len(ButtonText0) + 2
        btn2 = Button_New(x + w - (w2 + 1), y + 1, w2, ButtonText2)
        btn1 = Button_New(btn2.x - (w1 + 1), y + 1, w1, ButtonText1)
        btn0 = Button_New(btn1.x - (w0 + 1), y + 1, w0, ButtonText0)
    ElseIF Len(ButtonText2) = 0  And Len(ButtonText1) > 0 And Len(ButtonText0) > 0 Then
        'Button Nr. 0 und 1:
        w1 = Len(ButtonText1) + 2
        w0 = Len(ButtonText0) + 2
        btn1 = Button_New(x + w - (w1 + 1), y + 1, w1, ButtonText1)
        btn0 = Button_New(btn1.x - (w0 + 1), y + 1, w0, ButtonText0)
    Else
        w0 = Len(ButtonText0) + 2
        btn0 = Button_New(x + w - (w0 + 1), y + 1, w0, ButtonText0)
    End If

    'Event-Loop:
    result = -1
    Do
        If Button_Event(btn0) Then result = 0
        If Button_Event(btn1) Then result = 1
        If Button_Event(btn2) Then result = 2
    Loop Until result >= 0

    'Bildschirm restaurieren und Ende
    PCopy 1, 0
    Return result

End Function


Sub DrawSlider(tb As TrackBar, value As Integer)
    'Zeichnet die Markierung (Slider) in einem Trackbar an die dem Wert "value"
    'entsprechenden Position (Hilfsprozedur).
    'Minimale Slider-Position = tb.x
    'Maximale Slider-Position: tb.x + tb.w - 1

    Dim As Integer xpos

    xpos = tb.x + (tb.value - tb.minvalue) * (tb.w - 1) / (tb.maxvalue - tb.minvalue)
    Color tb.SliderColor, tb.BackColor
    Locate tb.y, tb.x
    Print Space(tb.w)
    Locate tb.y, xpos
    Print Chr(219)

End Sub


Function TrackBar_New(x As Integer, y As Integer, w As Integer) As Trackbar
    'Neuen horizontalen Trackbar definieren und zeichnen.

    Dim As TrackBar tb

    tb.x = x
    tb.y = y
    tb.w = w

    Select Case TUI_Mode
    Case 0
        tb.SliderColor = 8
        tb.BackColor = 15
    Case 1
        tb.SliderColor = darkgrey
        tb.BackColor = white
    End Select

    tb.minvalue = 0
    tb.maxvalue = 100
    tb.value = tb.minvalue

    DrawSlider(tb, tb.value)

    Return tb

End Function


Sub TrackBar_SetRange(ByRef tb As TrackBar, minvalue As Integer, maxvalue As Integer)
    'Wertebereich eines Trackbar setzen

    tb.minvalue = minvalue
    tb.maxvalue = maxvalue

End Sub


Sub TrackBar_SetValue(ByRef tb As TrackBar, value As Integer)
    'Den Wert eines Trackbars setzen und den Slider entsprechend zeichnen

    tb.value = value
    DrawSlider(tb, value)

End Sub


Function TrackBar_Event(ByRef tb As TrackBar) As Integer
    'Gibt 1 zurück, wenn der Trackbar angeklickt wurde, setzt den Slider an die
    'betreffende Position und aktualisiert den Wert des Trackbar.

    Dim As Integer mx, my, mb, value

  Getmouse(mx, my,, mb)
  Sleep 1

  If MouseInRect(mx, my, tb.x, tb.y, tb.w) And mb = 1 Then
        Select Case TUI_Mode
            Case 0
                value = tb.minvalue + (mx + 1 - tb.x) * (tb.maxvalue - tb.minvalue) / (tb.w - 1)
                TrackBar_SetValue(tb, value)
            Case 1
                Screenlock
                value = tb.minvalue + (mx \ 8 - tb.x + 1) * (tb.maxvalue - tb.minvalue) / (tb.w - 1)
                TrackBar_SetValue(tb, value)
                Screenunlock
        End Select
        Return 1
    Else
        Return 0
    End if

End Function


Function TrackBar_GetValue(tb As Trackbar) As Integer
    'Gibt den aktuellen Wert eines Trackbar zurück

    Return tb.value

End Function


Sub DrawBar(pb As ProgressBar, value As Integer)
    'Zeichnet den Balken in einem Progressbar entsprechend dem Wert. Hilfsprozedur.
    'Minimaler Wert: pb.x
    'maximalert Wert: pb.x - 1

    Dim As Integer xpos

    xpos = pb.x + (pb.value - pb.minvalue) * (pb.w - 1) / (pb.maxvalue - pb.minvalue)
    Color pb.BarColor, pb.BackColor
    Locate pb.y, pb.x
    Print Space(pb.w)
    Locate pb.y, pb.x
    Print String(xpos - 1, Chr(219));

End Sub


Function ProgressBar_New(x As Integer, y As Integer, w As Integer) As ProgressBar
    'Neuen horizontalen Progressbar definieren und zeichnen.

    Dim As ProgressBar pb

  pb.x = x
    pb.y = y
    pb.w = w

    Select Case TUI_Mode
        Case 0
            pb.BarColor = 8
            pb.BackColor = 15
        Case 1
            pb.BarColor = darkgrey
            pb.BackColor = white
    End Select
    pb.minvalue = 0
    pb.maxvalue = 100
    pb.value = pb.minvalue

    DrawBar(pb, 0)

    Return pb

End Function


Sub ProgressBar_SetRange(ByRef pb As ProgressBar, minvalue As Integer, maxvalue As Integer)
    'Wertebereich eines Progressbar setzen

    pb.minvalue = minvalue
    pb.maxvalue = maxvalue

End Sub


Sub ProgressBar_SetValue(ByRef pb As ProgressBar, value As Integer)
    'Wert eines Progressbar setzen und den Balken zeichnen

    If value >= pb.minvalue And value <= pb.maxvalue Then
        pb.value = value
        DrawBar(pb, value)
    End If

End Sub