Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
für Westbeam: modifizierte GUI.bi
| Uploader: |  Muttonhead |
| Datum/Zeit: | 08.06.2012 23:40:32 |
Const True=1
Const False=0
#Define Quit Inkey=CHR(255,107)
Dim Shared As Byte LoadStandardColor=True
Dim Shared As Integer clr_back,clr_window,clr_box,clr_boxghost,clr_button,clr_buttonpressed,clr_buttonghost,clr_menu,clr_menuentry,clr_menuentryghost,clr_menuentryselected,clr_windowtext,clr_windowtextghost,clr_text,clr_textghost
Dim Shared As Integer tim,mx,my,mz,mb,mxa,mya,mba,move_win
Dim Shared As Integer anz_win,anz_lab,anz_but,anz_chk,anz_tbox,anz_men,anz_mene,anz_slid
Dim Shared As Any Ptr wino,winc,winog
dim shared anz_alloc as uinteger
#Include "TYPES.bi"
Dim Shared As Any Ptr slidptr,slidptr1,slidptr2
Dim Shared As WizWindow win(5000)
Dim Shared As UInteger winZ(5000)
Dim Shared As Label lab(5000)
Dim Shared As Button but(5000)
Dim Shared As CheckBox chk(5000)
Dim Shared As TextBox tbox(5000)
Dim Shared As Menu men(5000)
Dim Shared As MenuEntry mene(5000)
Dim Shared As Slider slid(5000)
#Include "WINDOW.bi"
#Include "SILLYGADGETS.bi"
#Include "BUTTON.bi"
#Include "CHECKBOX.bi"
#Include "TEXTBOX.bi"
#Include "MENU.bi"
#Include "LIST.bi"
#Include "SLIDER.bi"
Declare Sub InitGUI()
Declare Sub LoadColor(file As String)
Declare Sub DrawGadgets()
Declare Sub mouse()
Declare Sub SuperCLS()
Declare Sub Check()
Declare Function set_fbfont (ByVal x As Integer) As Integer
Sub LoadColor(file As String)
Dim As Integer colorcfg=Freefile
Open file For Input As colorcfg
Input #colorcfg,clr_back
Input #colorcfg,clr_window
Input #colorcfg,clr_box
Input #colorcfg,clr_boxghost
Input #colorcfg,clr_button
Input #colorcfg,clr_buttonpressed
Input #colorcfg,clr_buttonghost
Input #colorcfg,clr_menu
Input #colorcfg,clr_menuentry
Input #colorcfg,clr_menuentryghost
Input #colorcfg,clr_menuentryselected
Input #colorcfg,clr_windowtext
Input #colorcfg,clr_windowtextghost
Input #colorcfg,clr_text
Input #colorcfg,clr_textghost
Close #colorcfg
End Sub
Sub InitGUI()
If LoadStandardColor=True Then
LoadColor("StdColor.cfg")
End If
set_fbfont(16)
wino=Imagecreate(2,18)
Bload "GUI/gfx/win.bmp",wino
winog=Imagecreate(2,18)
Bload "GUI/gfx/wing.bmp",winog
winc=Imagecreate(17,18)
Bload "GUI/gfx/cross.bmp",winc
slidptr=Imagecreate(4,18)
Bload "GUI/gfx/slider.bmp",slidptr
slidptr1=Imagecreate(20,20)
Bload "GUI/gfx/slider1.bmp",slidptr1
slidptr2=Imagecreate(20,20)
Bload "GUI/gfx/slider2.bmp",slidptr2
'for x as uinteger = 1 to anz_win
' with win(winZ(x))
' end with
'next
End Sub
Sub DrawGadgets()
For i As Integer=1 To anz_win
'****************************
'****************************
'****************************
select case win(winZ(i)).typ
' case 0'nur mal um zu wissen, wo die Fenster bleiben, case 0 muß wieder entfernt werden
' Draw String(10,450),win(winZ(i)).title
case 1
DrawWindow(i)
case 2
Put(40,410),win(winZ(i)).iconimg,Trans
Color &h000000
Draw String(10,450),win(winZ(i)).title
end select
'****************************
'****************************
'****************************
/'
If win(winZ(i)).typ=1 Then
DrawWindow(i)
Elseif win(winZ(i)).typ=2 Then
Put(40,410),win(winZ(i)).iconimg,Trans
Color &h000000
Draw String(10,450),win(winZ(i)).title
End If
'/
Next
For i2 As Integer=1 To anz_lab
Lab(i2).title=Lab(i2).title
DrawLabel(i2)
Next
For i3 As Integer=1 To anz_but
DrawButton(i3)
Next
For i4 As Integer=1 To anz_chk
DrawCheckBox(i4)
Next
For i5 As Integer=1 To anz_tbox
DrawTextBox(i5)
Next
For i6 As Integer=1 To anz_men
DrawMenuBar(men(i6).win)
DrawMenu(i6)
For i7 As Integer=1 To anz_mene
DrawMenuEntry(i7,i6)
Next
Next
For i8 As Integer=1 To anz_slid
DrawSlider(i8)
Next
For i25 As Integer=1 To anz_win
If win(winZ(i25)).typ=1 Then DrawWindowForGadgets(i25)
Next
End Sub
Sub mouse()
Getmouse mx,my,mz,mb
End Sub
Function set_fbfont (ByVal x As Integer) As Integer
Dim As Integer breit, hoch
ScreenInfo breit, hoch
Select Case x
Case 8, 14, 16 'nur 8, 14 oder 16 funktioniert richtig
Width breit\8, hoch\x ' hier wird auto. Cls ausgeführt
Case Else
Return 0 'etwas lief schief
End Select
Return 1 'Font erfolgreich gesetzt
End Function
Sub SuperCLS()
If mb=1 Then
Line(0,0)-(800,600),&h000000,BF
End If
End Sub
Sub Check()
tim+=1
mxa = mx
mya = my
mba = mb
Mouse()
If mb = 0 Then'wenn die maus losgelassen wird ist wird kein fenster verschoben
move_win = 0
End If
For i As Integer=1 To anz_tbox
tbox(i).textboxkey=Asc(Inkey)
Next
For i2 As Integer=1 To anz_but
If (mx>but((i2)).realx And mx<but((i2)).w+but((i2)).realx) And (my>but((i2)).realy And my<but((i2)).realy+22) And mb=1 And move_win=0 Then
but((i2)).pressed=1
Else
but((i2)).pressed=0
End If
Next
For i3 As Integer=1 To anz_chk
If (mx>chk((i3)).realx And mx<chk((i3)).realx+13) And (my>chk((i3)).realy And my<chk((i3)).realy+11) And chk((i3)).checked=0 And mb=1 And move_win=0 Then
chk((i3)).checked=1
Sleep 200
Elseif (mx>chk((i3)).realx And mx<chk((i3)).realx+13) And (my>chk((i3)).realy And my<chk((i3)).realy+11) And chk((i3)).checked=1 And mb=1 And move_win=0 Then
chk((i3)).checked=0
Sleep 200
End if
Next
For i5 As Integer=1 To anz_men
If (mx>men(i5).realx And mx<men(i5).realw) And (my>men(i5).realy And my<men(i5).realy+20) And men(i5).selected=0 And mb=1 And move_win=0 Then
For i As Integer=1 To anz_men
men(i).selected=0
Next
men(i5).selected=1
Sleep 200
Elseif (mx>men(i5).realx And mx<men(i5).realw) And (my>men(i5).realy And my<men(i5).realy+20) And men(i5).selected=1 And mb=1 And move_win=0 Then
men(i5).selected=0
Sleep 200
'ElseIf (mx<men(i5).realx Or mx>men(i5).realx+120 Or my<men(i5).realy Or my>men(i5).realy+20) And men(i5).selected=1 And mb=1 And move_win=0 Then
' men(i5).selected=0
End If
If move_win=1 Then
men(i5).selected=0
End If
Next
For i As Integer=1 To anz_win
If (mx>win(winZ(i)).x And mx<win(winZ(i)).x+20) And (my>win(winZ(i)).y And my<+win(winZ(i)).y+20) And mb=1 And move_win=0 Then
'****************************
'****************************
'****************************
win(winZ(i)).typ=0'nicht nur auf 0(unsichtbar?)setzen...
WindowToBottom (i)'sondern auf nach hinten im Z-Buffer gelegt(zu finden in der WINDOW.bi)
'****************************
'****************************
'****************************
End If
Next
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 and win(winZ(i)).typ<>0 Then WindowToTop (i)'wenn nicht eh schon TopWindow darf es auch nicht vom Typ 0 sein
'****************************
'****************************
'****************************
'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
'wenn dem so ist, dann:
'move
move_win = winZ(anz_win)
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
For i As Integer=1 To anz_but
but(i).realx=win(but(i).win).x+but(i).x
but(i).realy=win(but(i).win).y+but(i).y
Next
For i As Integer=1 To anz_chk
chk(i).realx=win(chk(i).win).x+chk(i).x
chk(i).realy=win(chk(i).win).y+chk(i).y
Next
For i As Integer=1 To anz_men
men(i).realx=win(men(i).win).x+men(i).menx
men(i).realy=win(men(i).win).y+26
men(i).realw=win(men(i).win).x+men(i).menx+men(i).w
Next
For i As Integer=1 To anz_mene
mene(i).realx=win(mene(i).win).x+men(mene(i).menu).menx-4
mene(i).realy=win(mene(i).win).y+24+(mene(i).number)*18
Next
For i As Integer=1 To anz_slid
slid(i).realx=win(slid(i).win).x+slid(i).x
slid(i).realy=win(slid(i).win).y+slid(i).y
Next
End If
For i As Integer=1 To anz_mene
mene(i).selected=0
Next
Sleep 10,1
End Sub