Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Problem mit Labels in selbstgeschriebener GUI
| Uploader: |  Westbeam |
| Datum/Zeit: | 04.07.2011 00:28:06 |
#DEFINE Quit Inkey=Chr(255,107)
Dim Shared As Integer mx,my,mb,mxa,mya,mba,move_win,move_lab
Dim Shared As Integer anz_win,anz_lab
Type WizWindow
As Integer id
As Integer typ
As String title
As Integer active
As Integer x
As Integer y
As Integer w
As Integer h
As Byte move
End Type
Type Label
As String title
As Integer win
As Integer x
As Integer y
As Integer realx,realy
End Type
Dim Shared As WizWindow win(5000)
Dim Shared As UInteger winZ(5000)
Dim Shared As Label lab(5000)
Dim Shared As UInteger labZ(5000)
Declare Sub InitGUI()
Declare Sub DrawGadgets()
Declare Sub DrawWindow(id As Integer)
Declare Sub WinAdd()
Declare Sub WindowToTop(id As Integer)
Declare Sub DrawLabel(id As Integer)
Declare Sub LabADD()
Declare Sub LabelToTop(id As Integer)
Screenres 640,480,32
InitGUI()
Dim Shared anz_alloc As UInteger
Sub WinAdd()
anz_win+=1
If anz_win > anz_alloc Then
anz_alloc += 25
'ReDim Preserve win(anz_alloc) As WizWindow
'ReDim Preserve winZ(anz_alloc) As UInteger
End If
With win(anz_win)
.id=1
.title="Testwindow-" & Str(anz_win)
.x=anz_win * 25
.y=anz_win * 25
.w=300
.h=200
End With
winZ(anz_win) = anz_win
End Sub
With win(1)
.id=1
.typ=1
.title="Testwindow"
.x=100
.y=50
.w=400
.h=300
End With
WinADD()
With lab(1)
.title="Ahoi :D"
.win=1
.x=100
.y=100
End With
LabADD()
With win(2)
.id=2
.typ=1
.title="Testwindow 2"
.x=120
.y=100
.w=400
.h=300
End With
WinADD()
Do
mxa = mx
mya = my
mba = mb
Getmouse mx,my,,mb
If mb = 0 Then'wenn die maus losgelassen wird ist wird kein fenster verschoben
move_win = 0
move_lab=0
End If
If mb = 1 And mba = 0 Then'wenn maus down dann schauen welches fenster angecklickt wurde
For i As Integer= anz_win To 1 Step -1
If (mx>win(winZ(i)).x And mx<win(winZ(i)).w+win(winZ(i)).x) And (my>win(winZ(i)).y And my<win(winZ(i)).h+win(winZ(i)).y) Then
If i < anz_win Then 'ist ganz sinvoll, um nicht jedes mal die liste zu durchlaufen, wenn das fenster sowieso schon am ende is.
WindowToTop (i)
End If
'einfach noch eine prüfung hinzu fügen (kann man natürlich optimieren)
'welche prüft, ob man auf das ""bar klickt.
If my<24+win(winZ(anz_win)).y Then
'wen dem so ist, dann:
'move
move_win = winZ(anz_win)
move_lab=labZ(anz_lab)
End If
Exit For 'exit danach
End If
Next
End If
'wenn move gesetzt, dann move es
If move_win <> 0 Then
'move variante ist SEHR unschön!!!
win(move_win).x += mx - mxa
win(move_win).y += my - mya
End If
If move_lab <> 0 Then
For i As Integer=1 To anz_lab
If lab(winZ(i)).win=win(winZ(i)).id Then lab(move_lab).realx+=mx-mxa
If lab(winZ(i)).win=win(winZ(i)).id Then lab(move_lab).realy+=my-mya
Next
End If
Sleep 10,1
ScreenLock
Cls
Line (0,0)-(640,480),&h376ea5,BF
DrawGadgets()
ScreenUnLock
Loop Until Quit
End
Sub InitGUI()
End Sub
Sub DrawGadgets()
For i As Integer=1 To anz_win
If win(winZ(i)).typ=1 Then DrawWindow(winZ(i))
Next
For i2 As Integer=1 To anz_lab
DrawLabel(i2)
Next
End Sub
Sub DrawWindow(id As Integer)
If id=winZ(anz_win) Then
Line (win(id).x,win(id).y+24)-(win(id).w+win(id).x,win(id).h+win(id).y),&hFFFFFF,BF
Line (win(id).x,win(id).y)-(win(id).w+win(id).x,win(id).y+23),&hDDDDDD,BF
Line (win(id).x,win(id).y)-(win(id).w+win(id).x,win(id).h+win(id).y),&h000000,B
Else
Line (win(id).x,win(id).y+24)-(win(id).w+win(id).x,win(id).h+win(id).y),&hC0C0C0,BF
Line (win(id).x,win(id).y)-(win(id).w+win(id).x,win(id).y+23),&hA0A0A0,BF
Line (win(id).x,win(id).y)-(win(id).w+win(id).x,win(id).h+win(id).y),&h000000,B
End If
End Sub
Sub WindowToTop(id As Integer)
if id > anz_win then exit sub
Dim TWinID As Uinteger = winZ(id)
For X As Uinteger = id To anz_win -1
winZ(x) = winZ(x + 1)
Next
winZ(anz_win) = TWinID
End Sub
Sub DrawLabel(id As Integer)
If id=labZ(anz_lab) Then
Color &h000000
Draw String(lab(id).realx,lab(id).realy),lab(id).title
End If
End Sub
Sub LabADD()
anz_lab+=1
labZ(anz_lab) = anz_lab
With lab(anz_lab)
.realx=win(winZ(lab(anz_lab).win)).x+lab(anz_lab).x
.realy=win(winZ(lab(anz_lab).win)).y+lab(anz_lab).y
End With
End Sub
Sub LabelToTop(id As Integer)
If id > anz_lab Then Exit Sub
Dim TLabID As Uinteger = labZ(id)
For X As Uinteger = id To anz_lab -1
labZ(x) = labZ(x + 1)
Next
labZ(anz_lab) = TLabID
End Sub