Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Nochmal Aufgebohrt
| Uploader: |  MilkFreeze |
| Datum/Zeit: | 05.07.2011 19:21:08 |
#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
declare sub draw()
End Type
sub WizWindow.draw()
if active = 1 then
Line this.img, ( 0, 0+24)-(this.w ,this.h+ 0),&hFFFFFF,BF
Line this.img, ( 0, 0)-(this.w+ 0, 0+23),&hDDDDDD,BF
Line this.img, ( 0, 0)-(this.w+ 0,this.h+ 0),&h000000,B
'Put (this.x,this.y),this.img,TRANS
Else
Line this.img2, ( 0, 0+24)-(this.w+ 0,this.h+ 0),&hC0C0C0,BF
Line this.img2, ( 0, 0)-(this.w+ 0, 0+23),&hA0A0A0,BF
Line this.img2, ( 0, 0)-(this.w+ 0,this.h+ 0),&h000000,B
'Put (this.x,this.y),this.img2,Trans
End If
end sub
Type Label
As String title
As Integer win_id
As Integer x
As Integer y
As Integer realx,realy
declare sub draw_label()
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 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
Sub Label.draw_label()
Color &h000000
if Win(this.win_id).active = 1 then
Draw String Win(this.win_id).img, (this.x,this.y),this.title
End If
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_id =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
.active = 1
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_id = win(winZ(i)).id Then lab(move_lab).realx+=mx-mxa
If lab(winZ(i)).win_id = 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 win(winZ(i)).draw()
Next
For i2 As Integer=1 To anz_lab
lab(i2).Draw_Label
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 WindowToTop(id As Integer)
if id > anz_win then exit sub
win(winZ(anz_win)).active = 0
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
win(winZ(anz_win)).active = 1
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