Buchempfehlung
Windows System Programming
Windows System Programming
Das Kompendium liefert viele interessante Informationen zur Windows-Programmierung auf Englisch. [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

Dateibrowser mit Eventsystem

Uploader:RedakteurMOD
Datum/Zeit:22.05.2010 15:48:16

Dim Shared As String inhalt()

Type ButtonType
    As Integer btnsx, btnsy, btnex, btney
    onClick As Sub(ID As Integer = 0)
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(ID As Integer = 0)) 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 Shared 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(ID As Integer = 0)) 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
    Dim As String text = inhalt(buttonZaehler)
    Draw String (startx + (endx - startx)/2 - Len(text)/2*8, starty + (endy - starty)/2 - 4), text, &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(i)
        End Select
        evt = 0
        Sleep 15
    Loop
End Sub

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

Declare Sub listFiles(datei As String)
Declare Sub Click(ID As Integer = 0)
Declare Sub leerClick


Dim Shared As Integer counter, ordner, dateien
Dim Shared As String pfad

WindowScreen(500, 500, @leerClick)
Input "Gib einen Laufwerksbuchstaben ein: ", pfad
Cls

pfad &= ":/"
listFiles(pfad & "*")

StartAPP()


Sub Click(ID As Integer = 0)
    If ID < ordner Then
        If inhalt(ID) = ".." Then
            pfad = Left(pfad, InStrRev(Left(pfad, Len(pfad) - 1), "/"))
        ElseIf inhalt(ID) = "." Then
            'nix
        Else
            pfad &= inhalt(ID) & "/"
        EndIf
        APP.buttonZaehler = 0
        Delete(APP.newButtonArray)
        APP.newButtonArray = 0
        Sleep 400
        listFiles(pfad & "*")
    Else
        Shell Chr(34) & pfad & inhalt(ID) & Chr(34)
        Sleep 400
    EndIf
End Sub
Sub leerClick

End Sub

Sub listFiles(pfad As String)
    Cls

    Dim As String datei
    datei = Dir(pfad, &H01 + &H02 + &H04 + &H10)
    counter = 0
    Do
        counter += 1
        datei = Dir("", &H01 + &H02 + &H04 + &H10)
    Loop While Len(datei)
    ordner = counter

    datei = Dir(pfad, &H10 + &H37)
    Do
        counter += 1
        datei = Dir("", &H10 + &H37)
    Loop While Len(datei)
    dateien = counter

    ReDim inhalt(counter)
    counter = 0
    datei = Dir(pfad, &H01 + &H02 + &H04 + &H10)
    Do
        counter += 1
        inhalt(counter - 1) = datei
        Button(20, (counter - 1) * (500/ordner) + 1, 249, ((counter - 1) + 1) * (500/ordner) - 1, @Click)
        datei = Dir("", &H01 + &H02 + &H04 + &H10)
    Loop While Len(datei)

    datei = Dir(pfad, &H10 + &H37)
    Do
        counter += 1
        inhalt(counter - 1) = datei
        Button(251, (counter - ordner - 1) * (500/(dateien - ordner)) + 1, 480, ((counter - ordner - 1) + 1) * (500/(dateien - ordner)) - 1, @Click)
        datei = Dir("", &H10 + &H37)
    Loop While Len(datei)
End Sub

Sleep