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!

Tutorial

Eventsystem

von RedakteurMODSeite 5 von 5

Das war es ja eigentlich schon, fehlt nur noch der vollständige Code:

'EventSystem by MOD

Type ButtonType
    As Integer btnsx, btnsy, btnex, btney
    As Sub onClick
End Type

Type EventType
    Declare Function windowCreate(x As Integer, y As Integer, wndClick As Sub) As Integer
    Declare Function buttonCreate(startx As Integer, starty As Integer, endx As Integer, endy As Integer, onButtonClick As Sub) As Integer

    Declare Static Sub eventSub(temp As Any Ptr)

    As Sub windowClick

    As Integer wndx, wndy
    As Integer buttonZaehler
    As Integer terminate

    As ButtonType Ptr newButtonArray

    As Any Ptr mutex
    As Any Ptr eventSubThread
End Type

Dim As EventType APP

#Define WindowScreen APP.windowCreate
#Define Button APP.buttonCreate

#Macro StartAPP()
    Dim As String keyInput
    APP.mutex = MutexCreate
    Do
        MutexLock(APP.mutex)
        keyInput = InKey
        MutexUnLock(APP.mutex)
        Sleep 15
    Loop While keyInput <> Chr(255, 107)
    APP.terminate = 1
    ThreadWait(APP.eventSubThread)
    MutexDestroy(APP.mutex)
    DeAllocate(APP.newButtonArray)
#EndMacro

Function EventType.windowCreate(x As Integer, y As Integer, wndClick As Sub) As Integer
    If wndClick = 0 Then
        Return 0
    EndIf
    If windowClick <> 0 Then
        Return 0
    EndIf
    wndx = x
    wndy = y
    windowClick = wndClick

    ScreenRes wndx, wndy, 32
    eventSubThread = ThreadCreate(Cast(Any Ptr, @eventSub), @This)
    Return 1
End Function

Function EventType.buttonCreate(startx As Integer, starty As Integer, endx As Integer, endy As Integer, onButtonClick As Sub) As Integer
    If startx <= 0 Or starty <= 0 Or endx > wndx Or endy > wndy Then
        Print "Werte außerhalb des Bereichs"
        Return 0
    EndIf
    If onButtonClick = 0 Then
        Print "Kein Eventhandler definiert"
        Return 0
    EndIf

    Line (startx, starty)-(endx, endy), &hFFFFFF, BF
    Draw String (startx + (endx - startx)/2 - 4, starty + (endy - starty)/2 - 4), Str(buttonZaehler + 1), &h000000

    newButtonArray = ReAllocate(newButtonArray, (buttonZaehler + 1) * SizeOf(ButtonType))

    newButtonArray[buttonZaehler].btnsx = startx
    newButtonArray[buttonZaehler].btnsy = starty
    newButtonArray[buttonZaehler].btnex = endx
    newButtonArray[buttonZaehler].btney = endy
    newButtonArray[buttonZaehler].onClick = onButtonClick

    buttonZaehler += 1
End Function

Sub EventType.eventSub(temp As Any Ptr)
    Dim As EventType Ptr uebergabe = temp
    Dim As Integer evt
    Dim As Integer mx, my, mb, mouse
    Dim As Integer i

    Do
        Do
            MutexLock(uebergabe->mutex)
            mouse = GetMouse(mx, my,, mb)
            If mouse = 0 And mb = 1 Then
                MutexUnLock(uebergabe->mutex)
                Exit Do
            EndIf
            MutexUnLock(uebergabe->mutex)
            If uebergabe->terminate = 1 Then Exit Sub
            Sleep 15
        Loop

        For i = 0 To uebergabe->buttonZaehler
            If uebergabe->terminate = 1 Then Exit Sub
            If uebergabe->newButtonArray[i].btnsx <= mx And mx <= uebergabe->newButtonArray[i].btnex And uebergabe->newButtonArray[i].btnsy <= my And my <= uebergabe->newButtonArray[i].btney Then
                evt = 2
                Exit For
            EndIf
        Next
        If evt <> 2 Then evt = 1

        Select Case evt
            Case 1
                uebergabe->windowClick()
            Case 2
                uebergabe->newButtonArray[i].onClick()
        End Select
        evt = 0
        Sleep 15
    Loop
End Sub

'###############################################################################################################

Declare Sub windowClick
Declare Sub btn1Click
Declare Sub btn2Click


WindowScreen(500, 500, @windowClick)
Button(20, 20, 120, 120, @btn1Click)
Button(140, 20, 240, 120, @btn2Click)

StartAPP()


Sub windowClick
    Locate 1,1: Print "Fenster wurde angeklickt"
    Sleep 250
End Sub
Sub btn1Click
    Locate 1,1: Print "Button 1 wurde geklickt "
    Sleep 250
End Sub
Sub btn2Click
    Locate 1,1: Print "Button 2 wurde geklickt "
    Sleep 250
End Sub

 

Gehe zu Seite Gehe zu Seite  1  2  3  4  5  
Zusätzliche Informationen und Funktionen
  • Das Tutorial wurde am 19.03.2010 von RedakteurMOD angelegt.
  • Die aktuellste Version wurde am 25.04.2010 von RedakteurMOD gespeichert.
  Bearbeiten Bearbeiten  

  Versionen Versionen