fb:porticula NoPaste
Westbeams WindowManager etwas aufgebohrt
Uploader: | MilkFreeze |
Datum/Zeit: | 05.07.2011 18:18:15 |
#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 Any Ptr img,img2
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,,&h04
InitGUI()
Dim Shared anz_alloc As UInteger
Sub WinAdd()
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
anz_win+=1
winZ(anz_win) = anz_win
win(winZ(anz_win)).img=Imagecreate(win(winZ(anz_win)).w+4,win(winZ(anz_win)).h+4)
win(winZ(anz_win)).img2=Imagecreate(win(winZ(anz_win)).w+4,win(winZ(anz_win)).h+4)
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(i)
Next
For i2 As Integer=1 To anz_lab
DrawLabel(i2)
Next
for i as integer = 1 to anz_win -1
Put (win(winZ(i)).x,win(winZ(i)).y),win(winZ(i)).img2,TRANS
next
Put (win(winZ(anz_win)).x,win(winZ(anz_win)).y),win(winZ(anz_win)).img,TRANS
End Sub
Sub DrawWindow(id As Integer)
If id = anz_win Then
Line win(winZ(id)).img, ( 0, 0+24)-(win(id).w ,win(id).h+ 0),&hFFFFFF,BF
Line win(winZ(id)).img, ( 0, 0)-(win(id).w+ 0, 0+23),&hDDDDDD,BF
Line win(winZ(id)).img, ( 0, 0)-(win(id).w+ 0,win(id).h+ 0),&h000000,B
Put (win(winZ(id)).x,win(winZ(id)).y),win(winZ(id)).img,TRANS
Else
Line win(winZ(id)).img2, ( 0, 0+24)-(win(id).w+ 0,win(id).h+ 0),&hC0C0C0,BF
Line win(winZ(id)).img2, ( 0, 0)-(win(id).w+ 0, 0+23),&hA0A0A0,BF
Line win(winZ(id)).img2, ( 0, 0)-(win(id).w+ 0,win(id).h+ 0),&h000000,B
Put (win(winZ(id)).x,win(winZ(id)).y),win(winZ(id)).img2,Trans
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)
dim win_id as integer
for i as integer = 1 to anz_win
if win(i).id = Lab(id).win then
win_id = i
end if
next
If id=labZ(anz_lab) Then
Color &h000000
Draw String Win(win_id).img, (lab(id).x,lab(id).y),lab(id).title
Draw String Win(win_id).img2, (lab(id).x,lab(id).y),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