Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Buggy TUI, unverständliche Fehler
| Uploader: |  Elektronix |
| Datum/Zeit: | 13.11.2007 15:03:08 |
'Rahmenformen
' Li oben waagr.Rand Re.oben senkr.Rand Li.unten Re.unten Kreuz Anb.Oben Anb.Links Anb.unten Anb.rechts
Const Frame1 As String = CHR(201) + CHR(205) + CHR(187) + CHR(186) + CHR(200) + CHR(188) + CHR(206) + Chr(203) + CHR(204) + Chr(202) + Chr(185)'Doppelter Rahmen
Const Frame2 As String = CHR(218) + CHR(196) + CHR(191) + CHR(179) + CHR(192) + CHR(217) + CHR(197) + CHR(194) + CHR(195) + Chr(193) + Chr(180)'Einfacher Rahmen
Const Frame3 As String = CHR(194) + CHR(196) + CHR(194) + CHR(179) + CHR(192) + Chr(217)'Einfacher Rahmen mit Anbindung an Menüzeile
' >>>>>> vvvvvv <<<<< ^^^^^^
Const Frame4 As String = Chr(62) + Chr(62) + Chr (118) + Chr (118) + Chr(60) + Chr(94)
Const Frame5 As String = Chr(16) + Chr(31) + Chr(17) + Chr(30)'Gleich wie Frame4, nur gefüllte Pfeile
Const Frame6 As String = Chr(250) + Chr(250) + Chr(250) + Chr(250) + Chr(250) + Chr(250)'Gepunkteter Rahmen
Const Frame7 As String = Chr(219) + Chr(219) + Chr(219) + Chr(219) + Chr(219) + Chr(219)'Rahmen aus vollen Matrixfeldern
DIM Fillings As String = Chr(000) + Chr(219) + Chr(176) + Chr(177) + Chr(178) 'Verschieden dichte Füllraster
'Fenster
'"Fillings" läßt sich nicht mit const deklarieren, obwohl die anderen Strings als Const festgelegt sind.
Type Win
WinStyle As String
Frame As String
Filling As String
Title As String
PosX As Integer
PosY As Integer
YLength As Integer
XLength As Integer
TextPosX As Integer
TextPosY As Integer
Text As String
ForeColour As Integer
BackColour As Integer
End Type
Type MenuBar
Declare Function GetPopUpNumbs () As Integer
Menu As String
PopupNumbs As Integer
MenuPosX As Integer
MenuPosY As Integer
MenuFrame As String
MenuForeColour As Integer
MenuBackColour As Integer
End Type
Type MenuPopup
MenuPopUpText As String
'PopUpItems() As String
ItemNumbs As Integer
MenuPosX As Integer
MenuPosY As Integer
MenuLength As Integer
MenuHight As Integer
MenuFrame As String
MenuForeColour As Integer
MenuBackColour As Integer
End Type
Dim Winptr As Win ptr
Dim MainWindow As Win
With MainWindow
.WinStyle = "MainWindow"
.PosX = 5
.PosY = 2
.XLength = 75 'Breite
.YLength = 18 'Maximal 80 Höhe
.Title = "Hauptfenster"
.Text = "Dies ist das Hauptfenster"
.Filling = Mid(Fillings, 1, 1)
.Frame = Frame1
.TextPosX = MainWindow.PosX + 5
.TextPosY = MainWindow.PosY + 3
.ForeColour = 11
.BackColour = 9
End With
Dim MainMenu As MenuBar
With MainMenu
.Menu = " Datei Bearbeiten Ansicht Hilfe"
.PopupNumbs = MainMenu.GetPopupNumbs()
.MenuPosX = MainWindow.PosX + 1
.MenuPosY = MainWindow.PosY + 1
.MenuFrame = Frame2
.MenuForeColour = 11
.MenuBackColour = MainWindow.BackColour
End With
Declare Sub DrawStandardWin(WindowFrame As Win)
Declare Sub DrawMainWin (WindowFrame As Win, Menu As MenuBar)
Declare Sub DrawMenu (Menu As MenuBar, XLength As Integer)
Declare Sub DrawWin (Windowframe As Win)
Declare Sub DrawFrame (WindowFrame As Win)
Declare Function InitMenu (FirstLetterX As Integer, FirstLetterY As Integer, ByRef MenuWin As Win) As Integer
Declare Function CursorMouseControl(ByRef CursorPosX As Integer, ByRef CursorPosY As Integer, WinPosX As Integer, WinPosY As Integer) As String
Declare Function GetTask(WinPosX As Integer, WinPosY As Integer, WinLengthX As Integer, WinLengthY As Integer) As String
Declare Function GetItem(CurPosX As Integer, CurPosY As Integer, ByRef FirstLetter As Integer, ByRef FirstLetterY As Integer, WinPosX As Integer, WinPosY As Integer, WinHigth As Integer, WinLength As Integer) As String
Function InitMenu(FirstLetterX As Integer, FirstLetterY As Integer, ByRef MenuWin As Win) As Integer
Dim I As Integer
Dim MaxItemLength As Integer
Dim ItemCounter As Integer = 1
For I = 0 To Len(MenuWin.Text)
If Mid(MenuWin.Text, I, 1) = " " Then 'Zählen der Menüpunkte
ItemCounter = ItemCounter + 1
EndIf
Next I
Dim Items(ItemCounter)As String
Dim Letter As String
MenuWin.YLength = ItemCounter + 1 'MenüHÖHE
'*************************************************************
ItemCounter = 0
I = 0
For I = 1 To Len(MenuWin.Text)
Letter = Mid(MenuWin.Text, I, 1)
If Letter = " " Then
ItemCounter = ItemCounter + 1
Elseif Mid(MenuWin.Text, I, 1) <> " " then
Items(ItemCounter) = Items(ItemCounter) + Letter 'Aufteilen des PoPups in verschiedene Items
EndIf
Next I
'*************************************************************
Dim J As Integer 'Wiedergabe der Menüpunkte
Dim LongestItem As String = ""
Dim ItemCounter1 As Integer
For ItemCounter1 = 0 To ItemCounter
If Len(Items(ItemCounter1)) >Len(LongestItem) Then 'Feststellen des längsten Menüpunktes
LongestItem = Items(ItemCounter1) 'Zuweisen an die Menübreite
EndIf
Next ItemCounter1
MenuWin.XLength = Len(LongestItem)+ 2 'MenuBREITE
'*************************************************************
MenuWin.PosX = FirstLetterX - 1
MenuWin.PosY = FirstLetterY + 1
Color MenuWin.ForeColour, MenuWin.BackColour
DrawFrame(MenuWin)'/
For J = 0 To ItemCounter
Locate FirstLetterY + 2 + J, FirstLetterX
Print Items(J) ' Anzeigen des Menüs
Next
Return ItemCounter
End Function
Function GetTask(WinPosY As Integer, WinPosX As Integer, WinLengthX As Integer, WinLengthY As Integer) As String
Dim Task As String = ""
Dim CurPosX As Integer = WinPosX + 4
Dim CurPosY As Integer = WinPosY + 3
Dim FirstLetterX As Integer, FirstLetterY As Integer = 0 'Wortanfang
Dim CursorPos As Integer
Dim Key As String
Dim ItemNumbs As Integer
Do
Key = CursorMouseControl (CurPosX, CurPosY, WinPosX, WinPosY)'Verlassen mit ESC
Loop Until (Key = Chr(27) Or Key = Chr(13))
If Key = Chr(13)_
And CurPosX > WinPosX AND CurPosY > WinPosY And CurPosX < WinPosX + WinLengthX AND CurPosY < WinPosY + WinLengthY - 1 _
And Screen(CurPosY, CurPosX)<> 0 And Chr(Screen(CurPosY, CurPosX)) <> " " Then
Task = GetItem(CurPosY, CurPosX, FirstLetterX, FirstLetterY, WinPosX, WinPosY, WinLengthX, WinLengthY)
EndIf
Dim MenuText As String
Select Case Task
Case "Datei"
MenuText = "Neu Oeffnen Speichern Speichern-als Schliessen"
Case "Bearbeiten"
MenuText = "Ausschneiden Kopieren Einfuegen"
Case "Ansicht"
MenuText = "Farben Groesse"
Case "Hilfe"
MenuText = "Info-1 Info-2"
End Select
If CurPosY = WinPosY + 1 then
Dim MenuWin As Win
With MenuWin
.WinStyle = "Menu"
.Text = MenuText
.TextPosX = 0
.TextPosY = 0
.Title = ""
.PosX = 0
.PosY = 0
.XLength = 0
.YLength = 0
.Filling = Chr(000)
.Frame = CHR(194) + CHR(196) + CHR(194) + CHR(179) + CHR(192) + Chr(217) 'entspr. Frame3
.ForeColour = 4
.BackColour = 11
End With
ItemNumbs = InitMenu (FirstLetterX, FirstLetterY, MenuWin)
EndIf
' Task = Task + GetItem(CurPosY, CurPosX, FirstLetterX, FirstLetterY, MenuWin.PosX, MenuWin.PosY, MenuWin.XLength, MenuWin.YLength)
'Hier behauptet der Compiler, WinMenu wäre implicit allociiert, obwohl sie vorher geDIMt wurde.
Return Task
End Function
Function CursorMouseControl(ByRef CursorPosX As Integer, ByRef CursorPosY As Integer, WinPosX As Integer, WinPosY As Integer) As String
Dim Key As String
Dim As Integer MouseX, MouseY, MouseButton
CursorPosX = WinPosX + 1
CursorPosY = WinPosY + 1
Locate CursorPosX ,CursorPosY , 1
Do
Locate CursorPosY, CursorPosX, 1
GetMouse (MouseX, MouseY, , MouseButton)
Key = InKey
If MouseButton And 1 Then
CursorPosY = MouseY + 1
CursorPosX = MouseX + 1
Key = Chr(13) 'Carriege Return
Elseif MouseButton And 2 Then
Key = CHR(27) 'ESC
EndIf '/
SELECT CASE Key
CASE CHR(255) + "K"
IF CursorPosX > 1 THEN CursorPosX = CursorPosX - 1: 'nach links
CASE CHR(255) + "M"
IF CursorPosX < 80 THEN CursorPosX = CursorPosX + 1: 'nach rechts
CASE CHR(255) + "H"
IF CursorPosY > 1 THEN CursorPosY = CursorPosY - 1: 'nach oben
CASE CHR(255) + "P"
IF CursorPosY < 23 THEN CursorPosY = CursorPosY + 1: 'nach unten
CASE CHR(13)
'Carriege Return
End Select
Loop Until (Key = Chr(27)Or Key = Chr(13))'Verlassen mit ESC oder Carriege Return
Return Key 'oder Key
End Function
Function GetItem (CurPosY As Integer, CurPosX As Integer, ByRef FirstLetterX As Integer, ByRef FirstLetterY As Integer, WinPosX As Integer, WinPosY As Integer, WinLengthX As Integer, WinLengthY As Integer) As String
Dim X1 As Integer = CurPosX
Dim ForeColour As Integer
Dim BackColour As Integer
Dim Letter As String = ""
Dim Item As String = ""
Locate CurPosY, CurPosX
ForeColour = SCREEN(CurPosY, CurPosX, 1) MOD 16
BackColour = SCREEN(CurPosY, CurPosX, 1) \ 16
Do
Letter = Chr(Screen(CurPosY, CurPosX))'Ermitteln des Zeichens an der Position
If Letter <> " " then
CurPosX = CurPosX - 1
Endif
Loop Until Screen(CurPosY, CurPosX)=0 Or Chr(Screen(CurPosY, CurPosX))=" " Or CurPosY <= WinPosY
FirstLetterY = CurPosY
CurPosX = CurPosX + 1
FirstLetterX = CurPosX 'Wortanfang zwischenspeichern
Do
Letter = Chr(Screen(CurPosY, CurPosX))'Buchstabe lesen
If Letter <> " " Then
Item = Item + Letter 'und an Wort anfügen: Ermitteln des Wortes
Else
Exit Do
Endif
CurPosX = CurPosX + 1 'nächster Buchstabe
Loop Until Screen(CurPosY, CurPosX)=0 Or Chr(Screen(CurPosY, CurPosX))=" " Or CurPosX = WinPosX + WinLengthX - 1
Color Backcolour, Forecolour'Schrift blinken lassen.
Locate FirstLetterY, FirstLetterX
Print Item
Sleep 100
Color Forecolour, Backcolour
Locate FirstLetterY, FirstLetterX
Print Item 'Blinken Ende
Return Item
End Function
Sub DrawStandardWin (WindowFrame As Win)
DrawWin (WindowFrame)
End Sub
Sub DrawMainWin (WindowFrame As Win, Menu As MenuBar)
DrawWin (WindowFrame)
DrawMenu(Menu, WindowFrame.XLength)
End Sub
Sub DrawMenu (Menu As MenuBar, XLength As Integer)
Dim Frame As String
Color Menu.MenuBackColour, Menu.MenuForeColour
Frame = String(XLength -2, Mid(Menu.MenuFrame, 2, 1))
Locate Menu.MenuPosY, Menu.MenuPosX
Print Menu.Menu + String(XLength-2-Len(Menu.Menu), " ")
Color Menu.MenuForeColour, Menu.MenuBackColour
Locate Menu.MenuPosY + 1, Menu.MenuPosX
Print Frame
End Sub
Function MenuBar.GetPopupNumbs () As Integer
Dim I As Integer
Dim PopupCounter As Integer = 0
For I = 1 To Len(This.Menu)
If Mid(Menu, I, 1) = " " Then
PopupCounter = PopupCounter
EndIf
Next I
Return PopupCounter
End Function
Sub DrawWin (WindowFrame As Win)
If WindowFrame.PosX + WindowFrame.XLength >80 Then
WindowFrame.XLength = WindowFrame.XLength-(WindowFrame.PosX +WindowFrame.XLength - 81)
EndIf
If WindowFrame.PosY + WindowFrame.YLength >23 Then
WindowFrame.YLength = WindowFrame.YLength-(WindowFrame.PosY + WindowFrame.YLength - 23)
EndIf'/
Color WindowFrame.ForeColour, WindowFrame.BackColour
DrawFrame (WindowFrame)
Locate WindowFrame.PosY , WindowFrame.PosX + (WindowFrame.XLength - Len(WindowFrame.Title))/2-1
Print WindowFrame.Title
Locate WindowFrame.TextPosY, WindowFrame.TextPosX
Print WindowFrame.Text
End Sub
Sub DrawFrame (WindowFrame As Win)
Dim HeadLine As String
Dim FootLine As String
Dim MiddleLine As String
Dim LineLength As Integer = WindowFrame.XLength - 2
Dim LineCounter As Integer 'Zählt die Anzahl der Zeile entspr. Höhe des Fensters
HeadLine = Mid(WindowFrame.Frame, 1, 1)+ String(LineLength,(Mid(WindowFrame.Frame, 2, 1)))+ Mid(WindowFrame.Frame, 3, 1)
FootLine = Mid(WindowFrame.Frame, 5, 1)+ String(LineLength,(Mid(WindowFrame.Frame, 2, 1)))+ Mid(WindowFrame.Frame, 6, 1)
MiddleLine = Mid(WindowFrame.Frame, 4, 1)+ String(LineLength,WindowFrame.Filling)+ Mid(WindowFrame.Frame, 4, 1)
Locate WindowFrame.PosY, WindowFrame.PosX, 1
Print HeadLine
For LineCounter = 1 To WindowFrame.YLength
Locate WindowFrame.PosY + LineCounter, WindowFrame.PosX
Print MiddleLine
Next LineCounter
Locate WindowFrame.PosY + WindowFrame.YLength, WindowFrame.PosX
Print FootLine
End Sub
'##########################---Hauptprogramm---#############################################
Screen 0
DrawMainWin(MainWindow, MainMenu)
'DrawStandardWin (MainWindow) 'Zur flexibleren Gestaltung
'DrawMenu(MainMenu, MainWindow.YLength) 'Zur flexibleren Gestaltung
Print GetTask(MainWindow.PosY, MainWindow.PosX, MainWindow.XLength, MainWindow.YLength)
sleep