fb:porticula NoPaste

Info / Hilfe Liste
Übersicht / Liste Neu
Datei hochladen Suche
Quellcode suchen
Dateidownload
TUI in Screen 0

Uploader:	Elektronix
Datum/Zeit:	05.11.2007 09:14:56
'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(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

Type Win

    WinStyle As String

    Frame As String

    Filling As String

    Title As String

    XPos As Integer

    YPos As Integer

    Length As Integer

    Hight 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







Dim Winptr As Win ptr



Dim MainWindow As Win

With MainWindow

    .WinStyle = "MainWindow"

    .XPos = 5

    .YPos = 4

    .Length = 61 - MainWindow.XPos 'Maximal 80

    .Hight = 15

    .Title = "Hauptfenster"

    .Text = "Dies ist das Hauptfenster"

    .Filling = Mid(Fillings, 1, 1)

    .Frame = Frame1

    .TextPosX = MainWindow.XPos + 5

    .TextPosY = MainWindow.YPos + 3

    .ForeColour = 11

    .BackColour = 9

End With

Winptr = @MainWindow





Dim Menuptr As MenuBar ptr



Dim MainMenu As MenuBar

With MainMenu

    .Menu = "Datei Bearbeiten Hilfe "

    .PopupNumbs = MainMenu.GetPopupNumbs()

    .MenuPosX = MainWindow.XPos+1

    .MenuPosY = MainWindow.YPos +1

    .MenuFrame = Frame2

    .MenuForeColour = 11

    .MenuBackColour = MainWindow.BackColour

End With



Menuptr = @MainMenu



Declare Sub DrawMenu (Menuptr As MenuBar Ptr, Length As Integer)

Declare Sub DrawWin (Winptr As Win ptr)

Declare Sub DrawFrame (Winptr As Win Ptr)



Declare Function GetTask(WinPosX As Integer, WinPosY As Integer, WinLength As Integer, WinHight As Integer) As String

Declare Function GetItem(X As Integer, Y As Integer,WinPosX As Integer, WinPosY As Integer, WinLength As Integer, WinHight As Integer) As String



Sub DrawMenu (Menuptr As MenuBar Ptr, Length As Integer)

    Dim Frame As String

    Color  Menuptr->MenuBackColour, Menuptr->MenuForeColour

    Frame = String(Length -2, Mid(Menuptr->MenuFrame, 2, 1))

    Locate Menuptr->MenuPosX, Menuptr->MenuPosY

    Print Menuptr->Menu + String(Length-2-Len(Menuptr->Menu), " ")

    Locate Menuptr->MenuPosX + 1, Menuptr->MenuPosY

    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 (Winptr As Win ptr)

    Color Winptr->ForeColour, Winptr->BackColour

    DrawFrame (Winptr)

    Locate Winptr->XPos , Winptr->YPos + (Winptr->Length - Len(Winptr->Title))/2-1

    Print Winptr->Title

    Locate Winptr->TextPosX, Winptr->TextPosY

    Print Winptr->Text



End Sub



Sub DrawFrame (Winptr As Win Ptr)



    Dim HeadLine As String

    Dim FootLine As String

    Dim MiddleLine As String

    Dim LineLength As Integer = Winptr->Length - 2

    Dim LineCounter As Integer 'Zählt die Anzahl der Zeile entspr. Höhe des Fensters



    HeadLine = Mid(Winptr->Frame, 1, 1)+ String(LineLength,(Mid(Winptr->Frame, 2, 1)))+ Mid(Winptr->Frame, 3, 1)

    FootLine = Mid(Winptr->Frame, 5, 1)+ String(LineLength,(Mid(Winptr->Frame, 2, 1)))+ Mid(Winptr->Frame, 6, 1)

   MiddleLine = Mid(Winptr->Frame, 4, 1)+ String(LineLength,Winptr->Filling)+ Mid(Winptr->Frame, 4, 1)



    Locate Winptr->XPos,Winptr->YPos

    Print HeadLine

    For LineCounter = Winptr->XPos + 1 To Winptr->Hight - 1

        Locate LineCounter,Winptr->YPos

        Print MiddleLine

    Next LineCounter

    Locate Winptr->Hight, Winptr->YPos

    Print FootLine

End Sub



Function GetTask(WinPosX As Integer, WinPosY As Integer, WinLength As Integer, WinHight As Integer) As String

    Dim Item As String = ""

    Dim X As Integer = WinPosX + 4

    Dim Y As Integer = WinPosY + 3

    Locate X ,Y , 1

    Dim Key As String

   Do

    Locate X, Y, 1

    DO

            Key = INKEY

        LOOP WHILE Key = ""

        SELECT CASE Key

        CASE CHR(255) + "K"

            IF Y > 1 THEN Y = Y - 1: 'nach links

        CASE CHR(255) + "M"

            IF Y < 80 THEN Y = Y + 1: 'nach rechts

        CASE CHR(255) + "H"

            IF X > 1 THEN X = X - 1: 'nach oben

        CASE CHR(255) + "P"

            IF X < 23 THEN X = X + 1: 'nach unten

            CASE CHR(13)                'Carriege Return

                If X > WinPosX AND Y > WinPosY And X <= WinPosX + WinHight - 1 AND Y <= WinPosY + WinLength - 2_

                     And Screen(X,Y)<> 0 And Chr(Screen(X,Y)) <> " " Then



                Item = GetItem(X, Y,WinPosX, WinPosY, WinLength, WinHight)

            Endif

        End Select

   Loop Until Key = Chr(27)           'Verlassen mit ESC



   Return  Item

End Function



Function GetItem (X As Integer, Y As Integer, WinPosX As Integer, WinPosY As Integer, WinLength As Integer, WinHight As Integer) As String

    Dim X1 As Integer = X

    Dim Y1 As Integer = Y

    Dim ForeColour As Integer

    Dim BackColour As Integer

    Dim Letter As String = ""

    Dim Item As String = ""

    Locate X, Y



    ForeColour = SCREEN(X, Y, 1) MOD 16

    BackColour = SCREEN(X, Y, 1) \ 16



    Do

        Letter = Chr(Screen(X,Y))'Ermitteln des Zeichens an der Position

        If Letter <> " " then

            Y = Y - 1

        Endif

    Loop Until Screen(X,Y)=0 Or Chr(Screen(X,Y))=" " Or Y <= WinPosY





    Y = Y + 1

    Y1 = Y                      'Wortanfang zwischenspeichern

    Do

        Letter = Chr(Screen(X,Y))'Buchstabe lesen

        If Letter <> " " Then

            Item = Item + Letter  'und an Wort anfügen: Ermitteln des Wortes

        Else

            Exit Do



        Endif

        Y = Y + 1                'nächster Buchstabe

    Loop Until Screen(X,Y)=0 Or Chr(Screen(X,Y))=" "



    Color Backcolour, Forecolour'Schrift blinken lassen.

    Locate X, Y1

    Print Item

    Sleep 100

    Color Forecolour, Backcolour

    Locate X, Y1

    Print Item                  'Blinken Ende



    Return Item

End Function

'##########################---Hauptprogramm---#############################################

Screen 0

DrawWin (Winptr)

DrawMenu(Menuptr, MainWindow.Length)

Print GetTask(MainWindow.XPos, MainWindow.YPos, MainWindow.Length, MainWindow.Hight)

sleep