Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Dateibrowser mit Eventsystem
| Uploader: |  MOD |
| 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