Buchempfehlung
Visual Basic 6 Kochbuch
Visual Basic 6 Kochbuch
Viele praktische Tipps zum Programmieren mit Visual Basic 6, die sich oft auch auf FB übertragen lassen. [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

Westbeams WindowManager etwas aufgebohrt

Uploader:MitgliedMilkFreeze
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