Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Kleines Gui beispiel2 ohne bug
| Uploader: |  XOR |
| Datum/Zeit: | 06.07.2011 03:12:52 |
'' Alles was man zur maus wissen muss ist im Mouse type
Type Mouse
Declare Sub Update ()
X As Integer
Y As Integer
W As Integer
B As Integer
Xa As Integer
Ya As Integer
Wa As Integer
Ba As Integer
End Type
''Updatet die Mouseposition
Sub Mouse.Update ()
This.Xa = This.X
This.Ya = This.Y
This.Wa = This.W
This.Ba = This.B
GetMouse This.X, This.Y, This.W, This.B
If This.X = -1 Or This.Y = -1 Then
This.X = This.Xa
This.Y = This.Ya
This.W = This.Wa
This.B = This.Ba
EndIf
End Sub
''Position und groesse kann man in dierer struct speichern
Type WinRect
X As Integer
Y As Integer
W As Integer
H As Integer
End Type
''Mein gadgettype, hier speichert man alles wass man von einem gadget wissen muss
Type Gadget
Parent As Gadget Ptr ''Parent
ChildFirst As Gadget Ptr ''Erstes element in der Childlist
ChildLast As Gadget Ptr ''Letztes element in der Childlist
NextGadget As Gadget Ptr ''Naechstes element in der list
PrevGadget As Gadget Ptr ''Das element bevor diesem element in der liste
NeedRect:1 As Integer ''Ob man ins parentrect zeichnen muss
IsChild:1 As Integer ''Ist das gadget ein child
OnState:2 As Integer ''Wie muss man es zichnen, on=1 off=0 sleep=2
State:4 As Integer ''Ist es angecklickt, mousover oder oder oder
HasFocus:1 As Integer ''Hat das element den Focus.
WinType:23 As Integer ''Not used
Reserviert(0 To 2) As Long ''Sachen fue die wins
Text As ZString Ptr ''Zeiger auf einen text
R As WinRect ''Position in abhaengigkeit zu parent wenn child
F As WinRect ''Frame
coloractiv As UInteger
colorinactiv As UInteger
colormouseover As UInteger
colorbackground As UInteger
colorfont As UInteger
DrawGadget As Sub ( ByVal As Gadget Ptr, ByVal As Integer, ByVal As Integer, ByVal As Any Ptr )
MouseOver As Function ( ByVal As Gadget Ptr, ByVal As Integer, ByVal As Integer, ByVal As Mouse Ptr ) As Integer
MouseFunc As Sub ( ByVal As Gadget Ptr, ByVal As Integer, ByVal As Integer, ByVal As Mouse Ptr )
KeyFunc As Sub ( ByVal As Gadget Ptr, ByVal As String )
CallBackFunc As Sub ( ByVal As Gadget Ptr )
CallBackMouseOver As Sub ( ByVal As Gadget Ptr )
End Type
''Addiert auf eine color eine zahl
Function GFXAddColor ( ByVal C As UInteger, ByVal W As Integer ) As UInteger
Dim As Integer R,G,B
R = LoByte(HiWord(C))
G = HiByte(LoWord(C))
B = LoByte(LoWord(C))
R += W
G += W
B += W
If R < 0 Then R = 0
If R > 255 Then R = 255
If G < 0 Then G = 0
If G > 255 Then G = 255
If B < 0 Then B = 0
If B > 255 Then B = 255
Return RGB(R,G,B)
End Function
''zeichnet eine box, Im=Image, C=Color, R=Rect, S=State
Sub DrawBox1 ( ByVal Im As Any Ptr, ByVal C As UInteger, ByVal R As WinRect, ByVal S As Integer )
If S=0 Then
For i As Integer = 0 To R.H
Line Im,(R.X,R.Y+i)-(R.X+R.W,R.Y+i),GFXAddColor(C,(-i/R.H+0.5)*60),bf
Next
Else
For i As Integer = 0 To R.H
Line Im,(R.X,R.Y+i)-(R.X+R.W,R.Y+i),GFXAddColor(C,(i/R.H-0.5)*60),bf
Next
EndIf
End Sub
''zeichnet eine box, Im=Image, C=Color, R=Rect, S=Posi fur weiss, D=Drehung
Sub DrawBox2 ( ByVal Im As Any Ptr, ByVal C As UInteger, ByVal R As WinRect, ByVal S As Single, ByVal D As Integer )
Dim m As Integer
For j As Integer = 0 To R.H
For i As Integer = 0 To R.W
If D = 0 Then
m = Sin((i-S*100)/100)*60
ElseIf D = 1 Then
m = Sin((i+S*100)/100)*60
ElseIf D = 2 Then
m = Sin((j-S*100)/100)*60
Else
m = Sin((j+S*100)/100)*60
EndIf
If m < 0 Then m=0
PSet Im,(R.X+i,R.Y+j),GFXAddColor(GFXAddColor(C,(-j/R.H+0.5)*60),m)
Next
Next
End Sub
''Mouseover konntrolle optimal, wenn rechteck
Function MouseOverOp ( ByVal G As Gadget Ptr, ByVal X As Integer, ByVal Y As Integer, ByVal M As Mouse Ptr ) As Integer
If X <= M->X And X+G->R.W+G->F.X+G->F.W >= M->X And Y <= M->Y And Y+G->R.H+G->F.Y+G->F.H >= M->Y Then
Return -1
EndIf
Return 0
End Function
''macht ein gadget zum top gadget
Sub GadgetToTop ( ByVal G As Gadget Ptr )
If G->Parent=0 Then Exit Sub ''Hat das gadget keinen parent exit
If G->Parent->ChildLast = G Then Exit Sub ''Wenn es schon am top ist exit
If G->NextGadget Then ''Aus der liste nehmen
G->NextGadget->PrevGadget = G->PrevGadget
EndIf
If G->PrevGadget Then
G->PrevGadget->NextGadget = G->NextGadget
Else
G->Parent->ChildFirst = G->NextGadget
EndIf ''Und wieder einfuegen
G->NextGadget = 0
G->Parent->ChildLast->NextGadget = G
G->PrevGadget = G->Parent->ChildLast
G->Parent->ChildLast = G
End Sub
''macht ein gadget zum Bottom gadget
Sub GadgetToBottom ( ByVal G As Gadget Ptr )
If G->Parent=0 Then Exit Sub 'Hat das gadget keinen parent exit
If G->Parent->ChildFirst = G Then Exit Sub''Wenn es schon am Bottom ist exit
If G->NextGadget Then ''Aus der liste nehmen
G->NextGadget->PrevGadget = G->PrevGadget
Else
G->Parent->ChildLast = G->PrevGadget
EndIf
If G->PrevGadget Then
G->PrevGadget->NextGadget = G->NextGadget
EndIf
G->PrevGadget = 0 ''Und wieder einfuegen
G->Parent->ChildFirst->PrevGadget = G
G->NextGadget = G->Parent->ChildFirst
G->Parent->ChildFirst = G
End Sub
''Zeichnet alle gadgets G=Gadget, X=X vom Parent, Y=Y vom Parent, Im=Image, D=Image vom desktop
Sub DrawGadgetGui ( ByVal G As Gadget Ptr, ByVal X As Integer, ByVal Y As Integer, ByVal Im As Any Ptr, ByVal D As Any Ptr )
If G=0 Then Exit Sub
Dim C As Gadget Ptr
Dim IsD As Integer
Dim ImN As Any Ptr
If G->OnState = 0 Then Exit Sub ''Wenn das gadget off ist exit
If G->IsChild Then ''Wenn es ein child ist
X += G->R.X ''X = X vom Parent+X vom Gadget
Y += G->R.Y ''Y = Y vom Parent+Y vom Gadget
Else ''Wenn nicht
X = G->R.X ''X = X vom Gadget
Y = G->R.Y ''Y = Y vom Gadget
EndIf
If G->NeedRect Then ''Wenn es im parent gezeichnet werden muss
If G->DrawGadget Then G->DrawGadget(G,G->R.X,G->R.Y,Im)
Else ''Ansonsten auf den desktop
If G->DrawGadget Then G->DrawGadget(G,X,Y,D)
EndIf
If G->R.W>0 And G->R.H>0 Then ''Wenn weite und hohe >0 sind
ImN = ImageCreate(G->R.W,G->R.H) ''Ein gadget image erstellen
If D = 0 Then ''Wenn es der desktop ist
D = ImN ''Ein desktop image erstellen
IsD = -1
EndIf
X += G->F.X ''X = X+Framesize
Y += G->F.Y ''Y = Y+Framesize
C = G->ChildFirst
Do Until C = 0 ''Geht die Childliste durch
If C->IsChild then DrawGadgetGui(C,X,Y,ImN,D)''Hat man ein child, wird es gezeichnet
C = C->NextGadget
Loop
C = G->ChildFirst
Do Until C = 0''Geht die Childliste ein zweites mal durch
If C->IsChild=0 Then DrawGadgetGui(C,X,Y,ImN,D)''Hat man kein child, wird es gezeichnet
C = C->NextGadget
Loop
If G->NeedRect Then ''Zeichnet letztendlich alle images
Put Im,(X,Y), ImN, Trans
Else
If IsD Then
Put (X,Y), ImN, Trans
Else
Put D,(X,Y), ImN, Trans
EndIf
EndIf
If ImN Then ImageDestroy(ImN)
EndIf
End Sub
''Zeichnet den desktop G
Sub DesktopDrawUpdate ( ByVal G As Gadget Ptr )
DrawGadgetGui(G,0,0,0,0)
End Sub
''Schaut in welchem gadget die maus ist G = Gadget, X = X Von Parent, Y = Y Von Parent, Totop = Wenn die maus drueber ist soll es dann zum topwin werden, m=Mouse
Function MouseUpdateGui ( ByVal G As Gadget Ptr, ByVal X As Integer, ByVal Y As Integer, ByVal Totop As Integer = -1, ByVal M As Mouse Ptr ) As Gadget Ptr
Dim C As Gadget Ptr ''Siehe DrawGadgetGui
Dim LastSelWin As Gadget Ptr
Dim Temp As Gadget Ptr
If M = 0 Then Return 0
If G->OnState <> 1 Then Return 0
If G->IsChild Then
X += G->R.X
Y += G->R.Y
Else
X = G->R.X
Y = G->R.Y
EndIf
If G->MouseOver = 0 Then Return 0
If G->MouseOver(G,X,Y,M) = 0 Then Return 0 ''Wenn die Mouse nicht drueber ist, 0 zurueckgeben
If ToTop Then GadgetToTop(G) ''Ansonsten ev. zum topgadget machen
X += G->F.X
Y += G->F.Y
C = G->ChildLast
Do Until C = 0 ''Liste aller childs durchgehen
LastSelWin = MouseUpdateGui(C,X,Y,ToTop,M)
If LastSelWin Then ''Wenn eich child gecklickt wurde den zeiger returnen
Return LastSelWin
EndIf
C = C->PrevGadget
Loop
Return G
End Function
''Updatet Mouse und keys
Function DesktopUpdate ( ByVal G As Gadget Ptr, ByVal M As Mouse Ptr, ByVal S As String ) As Integer
Dim C As Gadget Ptr
Dim LFG As Gadget Ptr = Cast(Gadget Ptr,G->Reserviert(0)) ''Letztes TopWindow
Function = 0
If M->B = 1 And M->Ba = 0 Then ''Wenn mouse down
C = G->ChildLast
G->Reserviert(0) = 0
Do Until C = 0 ''Liste aller gadgets durchgehen
G->Reserviert(0) = Cast(Long,MouseUpdateGui(C,0,0,-1,M))
If G->Reserviert(0) Then ''Wenn gadget gedrueckt schleife beenden
Function = G->Reserviert(0)
Exit Do
EndIf
C = C->PrevGadget
Loop
EndIf
If LFG <> G->Reserviert(0) Then ''Focusvar setzen
If LFG <> 0 Then LFG->HasFocus = 0 ''Vom letzten Focus den Focus nehmen
LFG = Cast(Gadget Ptr,G->Reserviert(0))
If LFG<>0 Then LFG->HasFocus = 1 ''Und ans neue setzen
EndIf
If M->B = 0 Then ''Wenn mouseButton=0
Dim As Gadget Ptr LastSelWin
C = G->ChildLast
LastSelWin = 0
Do Until C = 0 ''Schauen worueber sich die maus befindet
LastSelWin = MouseUpdateGui(C,0,0,0,M)
If LastSelWin Then
If LastSelWin->CallBackMouseOver Then LastSelWin->CallBackMouseOver(LastSelWin)
Exit Do
EndIf
C = C->PrevGadget
Loop
EndIf
If S = Chr(255)+"k" Then ''Beenden des windows kontrolieren
If G->CallBackFunc Then G->CallBackFunc(G)
EndIf
If G->Reserviert(0) Then ''Hat man ein focuswindow
Dim As Integer X,Y
Dim As Gadget Ptr P,LastSelWin
LastSelWin = Cast(Gadget Ptr,G->Reserviert(0))
If LastSelWin->MouseFunc Then
X = LastSelWin->R.X ''X und Y bekommen
Y = LastSelWin->R.Y
P = LastSelWin
Do Until P->IsChild = 0
P = P->Parent
If P = 0 Then Exit Do
X += P->R.X+P->F.X
Y += P->R.Y+P->F.Y
Loop
LastSelWin->MouseFunc(LastSelWin,X,Y,M) '' Und updaten
EndIf
If LastSelWin->KeyFunc <> 0 And S <> "" Then LastSelWin->KeyFunc(LastSelWin,S)
EndIf
End Function
''Erstellt ein gadget. P = Parent,
Function CreateGadget ( ByVal P As Gadget Ptr, ByVal IsChild As Integer, ByVal Text As String, ByVal X As Integer, ByVal Y As Integer, ByVal W As Integer, ByVal H As Integer,_
ByVal T As Integer, ByVal DrawGadget As Sub ( ByVal As Gadget Ptr, ByVal As Integer, ByVal As Integer, ByVal As Any Ptr ), ByVal MouseOver As Function ( ByVal As Gadget Ptr,_
ByVal As Integer, ByVal As Integer, ByVal As Mouse Ptr ) As Integer, ByVal MouseFunc As Sub ( ByVal As Gadget Ptr, ByVal As Integer, ByVal As Integer, ByVal As Mouse Ptr ),_
ByVal CallBackMouseOver As Sub ( ByVal As Gadget Ptr ), ByVal CallBackFunc As Sub ( ByVal As Gadget Ptr ), ByVal KeyFunc As Sub ( ByVal As Gadget Ptr, ByVal As String ) ,_
ByVal coloractiv As UInteger, ByVal colorinactiv As UInteger, ByVal colormouseover As UInteger, ByVal colorbackground As UInteger, ByVal colorfont As UInteger) As Gadget Ptr
Dim NewGadget As Gadget Ptr
NewGadget = Allocate(SizeOf(Gadget))
For i As Integer = 0 To SizeOf(Gadget)-1
Cast(UByte Ptr,NewGadget)[i] = 0
Next
NewGadget->Parent = P
If P Then
If P->ChildFirst = 0 Then
P->ChildFirst = NewGadget
P->ChildLast = NewGadget
Else
P->ChildLast->NextGadget = NewGadget
NewGadget->PrevGadget = P->ChildLast
P->ChildLast = NewGadget
EndIf
EndIf
NewGadget->NeedRect = IsChild
NewGadget->IsChild = IsChild
If Text = "" Then
NewGadget->Text = 0
Else
NewGadget->Text = Allocate(Len(Text)+1)
*NewGadget->Text = Text
EndIf
NewGadget->R.X = X
NewGadget->R.Y = Y
NewGadget->R.W = W
NewGadget->R.H = H
NewGadget->WinType = T
NewGadget->OnState = 1
NewGadget->DrawGadget = DrawGadget
NewGadget->MouseOver = IIf(MouseOver=0,@MouseOverOp,MouseOver)
NewGadget->MouseFunc = MouseFunc
NewGadget->CallBackMouseOver = CallBackMouseOver
NewGadget->CallBackFunc = CallBackFunc
NewGadget->KeyFunc = KeyFunc
NewGadget->coloractiv = coloractiv
NewGadget->colorinactiv = colorinactiv
NewGadget->colormouseover = colormouseover
NewGadget->colorbackground = colorbackground
NewGadget->colorfont = colorfont
Return NewGadget
End Function
''Zerstoert ein gadget und seine childs
Sub DestroyGadget ( ByVal G As Gadget Ptr )
If G->NextGadget Then
G->NextGadget->PrevGadget = G->PrevGadget
Else
If G->Parent Then
G->Parent->ChildLast = G->PrevGadget
EndIf
EndIf
If G->PrevGadget Then
G->PrevGadget->NextGadget = G->NextGadget
Else
If G->Parent Then
G->Parent->ChildFirst = G->NextGadget
EndIf
EndIf
Do Until G->ChildFirst = 0
DestroyGadget(G->ChildFirst)
Loop
If G->Text Then DeAllocate(G->Text)
DeAllocate(G)
End Sub
Sub GadgetOn ( ByVal G As Gadget Ptr )
G->OnState = 1
GadgetToTop(G)
End Sub
Sub GadgetOff ( ByVal G As Gadget Ptr )
G->OnState = 0
GadgetToBottom(G)
End Sub
Sub GadgetSleep ( ByVal G As Gadget Ptr )
G->OnState = 2
GadgetToTop(G)
End Sub
Sub SetGadgetText ( ByVal G As Gadget Ptr, ByVal Text As String )
If G->Text Then DeAllocate(G->Text)
If Text = "" Then
G->Text = 0
Else
G->Text = Allocate(Len(Text)+1)
*G->Text = Text
EndIf
End Sub
Function GetGadgetText ( ByVal G As Gadget Ptr ) As String
Return *G->Text
End Function
Sub SetGadgetPosi ( ByVal G As Gadget Ptr, ByVal Posi As WinRect )
G->R = Posi
End Sub
Function GetGadgetPosi ( ByVal G As Gadget Ptr ) As WinRect
Return G->R
End Function
Sub SetGadgetActiveColor ( ByVal G As Gadget Ptr, ByVal C As UInteger )
G->coloractiv = C
End Sub
Sub SetGadgetInActiveColor ( ByVal G As Gadget Ptr, ByVal C As UInteger )
G->colorinactiv = C
End Sub
Sub SetGadgetMouseOverColor ( ByVal G As Gadget Ptr, ByVal C As UInteger )
G->colormouseover = C
End Sub
Sub SetGadgetBackgroundColor ( ByVal G As Gadget Ptr, ByVal C As UInteger )
G->colorbackground = C
End Sub
Sub SetGadgetFontColor ( ByVal G As Gadget Ptr, ByVal C As UInteger )
G->colorfont = C
End Sub
Function GetGadgetActiveColor ( ByVal G As Gadget Ptr ) As UInteger
Return G->coloractiv
End Function
Function GetGadgetInActiveColor ( ByVal G As Gadget Ptr ) As UInteger
Return G->colorinactiv
End Function
Function GetGadgetMouseOverColor ( ByVal G As Gadget Ptr ) As UInteger
Return G->colormouseover
End Function
Function GetGadgetBackgroundColor ( ByVal G As Gadget Ptr ) As UInteger
Return G->colorbackground
End Function
Function GetGadgetFontColor ( ByVal G As Gadget Ptr ) As UInteger
Return G->colorfont
End Function
''Erstellt einen desktop F = Function die aufgerufen wird wenn XButten gedrueckt wird
Function CreateDesktop ( ByVal F As Sub ( ByVal As Gadget Ptr )) As Gadget Ptr
Dim As Integer W,H
ScreenInfo W,H
Return CreateGadget ( 0, 0, "", 0, 0, W, H, 0, 0, 0, 0, 0, F, 0, 0, 0, 0, 0 ,0 )
End Function
''Zeichnet einen Button G=Button, X=X, Y=Y, Im=Image
Sub DrawButton ( ByVal G As Gadget Ptr, ByVal X As Integer, ByVal Y As Integer, ByVal Im As Any Ptr )
Dim As String Text
Dim As WinRect R
R.X = X
R.Y = Y
R.W = G->R.W+G->F.X+G->F.W
R.H = G->R.H+G->F.Y+G->F.H
If G->State Then ''Wenn mouse drueber
If (G->State And 1) Then
DrawBox1(Im,G->coloractiv,R,1)''Button zeichnen
Else
DrawBox1(Im,G->colormouseover,R,0)''Button zeichnen
EndIf
Else
DrawBox1(Im,G->colorinactiv,R,0)''Ansonsten inaktiv
EndIf
Line Im,(X-1,Y-1)-(X+R.W+1,Y+R.H+1),RGB(0,0,0),b ''Frame
Text = *G->Text ''Button Text
If R.W >= 8*4 Or Len(Text)*8 <= R.W Then
If Len(Text)*8 > R.W Then
Text = Left(Text,Len(Text)-1)
Do Until (Len(Text)+3)*8 < R.W
Text = Left(Text,Len(Text)-1)
Loop
Text += "..."
EndIf
Draw String Im,(X+R.W/2-Len(Text)*4,Y+R.H/2-8),Text,G->colorfont
EndIf
G->State = G->State And Not(2)
End Sub
Sub MouseFuncButton ( ByVal G As Gadget Ptr, ByVal X As Integer, ByVal Y As Integer, ByVal M As Mouse Ptr )
If M->B = 1 And M->Ba = 0 Then
G->State = G->State Or 1
EndIf
If MouseOverOp(G,X,Y,M) = 0 Then G->State = G->State And Not(1)
If M->B = 0 And (G->State and 1) Then
G->State = 0
If G->CallBackFunc Then G->CallBackFunc(G)
EndIf
End Sub
Sub MouseOverButton ( ByVal G As Gadget Ptr )
G->State = G->State Or 2
End Sub
Function CreateButton ( ByVal P As Gadget Ptr, ByVal Text As String, ByVal X As Integer, ByVal Y As Integer, ByVal W As Integer, ByVal H As Integer, ByVal F As Sub ( ByVal As Gadget Ptr ) ) As Gadget Ptr
Return CreateGadget ( P, 1, Text, X, Y, W, H, 3, @DrawButton, 0, @MouseFuncButton, @MouseOverButton, F, 0, RGB(100,200,100), RGB(200,200,200), RGB(100,200,100), 0, 0 )
End Function
Sub HideParentWindow ( ByVal G As Gadget Ptr )
GadgetOff ( G->Parent )
End Sub
Sub DrawWindow ( ByVal G As Gadget Ptr, ByVal X As Integer, ByVal Y As Integer, ByVal Im As Any Ptr )
Dim As Integer W,H,IsAk,WM
Dim As String Text
Dim As WinRect R
R.X = X
R.Y = Y
W = G->R.W+G->F.X+G->F.W
H = G->R.H+G->F.Y+G->F.H
R.W = W
R.H = G->F.Y
IsAk = 0
If G->Parent Then
If G->Parent->ChildLast = G Then
IsAk = -1
Else
Dim C As Gadget Ptr
C = G->Parent->ChildLast
Do Until C->IsChild=0
C = C->PrevGadget
Loop
If C = G Then
IsAk = -1
EndIf
EndIf
EndIf
Line Im,(X,Y+R.H)-(X+W,Y+H),G->colorbackground,bf
For i As Integer = 0 To G->F.X
Line Im,(X+i,Y)-(X+i,Y+H),RGB(0,0,0)
Next
For i As Integer = 0 To G->F.W
Line Im,(X+W-G->F.X+i,Y)-(X+W-G->F.X+i,Y+H),RGB(0,0,0)
Next
For i As Integer = 0 To G->F.H
Line Im,(X,Y+H-G->F.X+i)-(X+W,Y+H-G->F.X+i),RGB(0,0,0)
Next
If IsAk Then
DrawBox2(Im,G->coloractiv,R,Timer,0)
If G->Reserviert(0) Then Cast(Gadget Ptr,G->Reserviert(0))->colorinactiv = G->coloractiv
Else
DrawBox1(Im,G->colorinactiv,R,0)
If G->Reserviert(0) Then Cast(Gadget Ptr,G->Reserviert(0))->colorinactiv = G->colorinactiv
EndIf
Line Im,(X,Y)-(X+W,Y+H),RGB(0,0,0),b
Text = *G->Text
If G->Reserviert(0) Then
WM = Cast(Gadget Ptr,G->Reserviert(0))->F.X+Cast(Gadget Ptr,G->Reserviert(0))->F.W+Cast(Gadget Ptr,G->Reserviert(0))->R.W+2
EndIf
If W-WM >= 8*4 Or Len(Text)*8 <= R.W Then
If Len(Text)*8 > W-WM Then
Text = Left(Text,Len(Text)-1)
Do Until (Len(Text)+3)*8 < W-WM
Text = Left(Text,Len(Text)-1)
Loop
Text += "..."
EndIf
Draw String Im,(X+W/2-Len(Text)*4-WM/2,Y+R.H/2-8),Text,G->colorfont
EndIf
End Sub
Sub MouseFuncWindow ( ByVal G As Gadget Ptr, ByVal X As Integer, ByVal Y As Integer, ByVal M As Mouse Ptr )
Dim XB As Gadget Ptr
Dim S As Integer
XB = Cast(Gadget Ptr,G->Reserviert(0))
S = 0
If XB Then
S = XB->F.X+XB->F.W+XB->R.W+2
EndIf
If M Then
If M->B = 1 And G->State = 1 And G->Reserviert(2) Then
G->R.X += M->X-M->Xa
G->R.Y += M->Y-M->Ya
EndIf
If M->B = 1 And G->State = 2 And G->Reserviert(1) Then
G->R.X += M->X-M->Xa
G->R.W -= M->X-M->Xa
If G->R.W < S Then
G->R.X += G->R.W-S
G->R.W = S
EndIf
EndIf
If M->B = 1 And G->State = 3 And G->Reserviert(1) Then
G->R.W += M->X-M->Xa
If G->R.W < S Then G->R.W = S
EndIf
If M->B = 1 And G->State = 4 And G->Reserviert(1) Then
G->R.H += M->Y-M->Ya
If G->R.H < 0 Then G->R.H = 0
EndIf
If M->B = 1 And M->Ba = 0 Then
If M->Y <= Y+G->F.Y Then
G->State = 1
ElseIf M->X <= X+G->F.X Then
G->State = 2
ElseIf M->X >= X+G->F.X+G->R.W Then
G->State = 3
ElseIf M->Y >= Y+G->F.Y+G->R.H Then
G->State = 4
EndIf
EndIf
If M->B = 0 Then
G->State = 0
EndIf
EndIf
If XB Then
XB->R.X = G->R.W+G->F.X-XB->F.X-XB->F.W-XB->R.W-G->F.W-1
XB->R.Y = -21
EndIf
End Sub
Function CreateWindow ( ByVal P As Gadget Ptr, ByVal Text As String, ByVal X As Integer, ByVal Y As Integer, ByVal W As Integer, ByVal H As Integer, ByVal XB As Integer=0, ByVal RS As Integer=0, ByVal Ve As Integer=-1 ) As Gadget Ptr
Dim Win As Gadget Ptr
Win = CreateGadget ( P, 0, Text, X, Y, W, H, 1, @DrawWindow, 0, @MouseFuncWindow, 0, 0, 0, RGB(200,200,100), RGB(100,100,100), 0, RGB(220,220,220), 0 )
Win->F.Y = 24
If XB Then
Win->Reserviert(0) = Cast(Long,CreateButton(Win,"X",0,0,19,19,@HideParentWindow))
Cast(Gadget Ptr,Win->Reserviert(0))->NeedRect = 0
Cast(Gadget Ptr,Win->Reserviert(0))->colorinactiv = RGB(100,100,100)
Cast(Gadget Ptr,Win->Reserviert(0))->coloractiv = RGB(255,100,100)
Cast(Gadget Ptr,Win->Reserviert(0))->colormouseover = RGB(200,100,100)
EndIf
Win->Reserviert(1) = RS
Win->Reserviert(2) = Ve
If RS Then
Win->F.X = 2
Win->F.W = 2
Win->F.H = 2
EndIf
MouseFuncWindow(Win,0,0,0)
Return Win
End Function
Sub DrawLabel ( ByVal G As Gadget Ptr, ByVal X As Integer, ByVal Y As Integer, ByVal Im As Any Ptr )
Draw String Im,(X,Y),*G->Text,G->colorfont
End Sub
Function CreateLabel ( ByVal P As Gadget Ptr, ByVal Text As String, ByVal X As Integer, ByVal Y As Integer ) As Gadget Ptr
Return CreateGadget ( P, 1, Text, X, Y, 0, 0, 2, @DrawLabel, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 )
End Function
Sub DrawInputBox ( ByVal G As Gadget Ptr, ByVal X As Integer, ByVal Y As Integer, ByVal Im As Any Ptr )
Dim As WinRect R
R.X = X
R.Y = Y
R.W = G->R.W+G->F.X+G->F.W
R.H = G->R.H+G->F.Y+G->F.H
Line Im, (R.X,R.Y)-(R.X+R.W,R.Y+R.H),G->colorbackground,bf
If G->HasFocus Then
R.X = X+(G->Reserviert(1)-G->Reserviert(0))*8+1
R.W = 8
DrawBox1(Im,G->coloractiv,R,0)
Else
G->Reserviert(0) = 0
EndIf
R.X = X
R.W = G->R.W+G->F.X+G->F.W
Line Im, (R.X,R.Y)-(R.X+R.W,R.Y+R.H),RGB(0,0,0),b
Draw String Im,(X+2,Y+1),Mid(*G->Text,G->Reserviert(0)+1,Int(G->R.W/8-0.5)),G->colorfont
End Sub
Sub MouseFuncInputBox ( ByVal G As Gadget Ptr, ByVal X As Integer, ByVal Y As Integer, ByVal M As Mouse Ptr )
If M->B = 1 And M->Ba = 0 Then
G->Reserviert(1) = Int((M->X-X-1)/8)
If G->Reserviert(1)<0 Then G->Reserviert(1) = 0
If G->Reserviert(1)>Len(*G->Text) Then G->Reserviert(1)=Len(*G->Text)
EndIf
End Sub
Sub KeyFuncInputBox ( ByVal G As Gadget Ptr, ByVal S As String )
Dim Text As String
Dim OT As Integer
Dim HZ As Integer = Int(G->R.W/8-0.5)-1
Text = *G->Text
If Asc(S) >= 32 And Asc(S) <= 32+128 Then
Text = Mid(Text,1,G->Reserviert(1))+S+Mid(Text,G->Reserviert(1)+1)
G->Reserviert(1) += Len(S)
OT = -1
EndIf
If Asc(S) = 8 Then
If G->Reserviert(1) > 0 Then
Text = Mid(Text,1,G->Reserviert(1)-1)+Mid(Text,G->Reserviert(1)+1)
G->Reserviert(1) -= 1
EndIf
OT = -1
EndIf
If S = Chr(255)+"M" Then
G->Reserviert(1) += 1
If G->Reserviert(1) > Len(Text) Then G->Reserviert(1) = Len(Text)
EndIf
If S = Chr(255)+"K" Then
G->Reserviert(1) -= 1
If G->Reserviert(1)<0 Then G->Reserviert(1) = 0
EndIf
If S = Chr(255,83) Then
Text = Mid(Text,1,G->Reserviert(1))+Mid(Text,G->Reserviert(1)+2)
OT = -1
EndIf
If OT Then
DeAllocate(G->Text)
If Text = "" Then
G->Text = 0
Else
G->Text = Allocate(Len(Text)+1)
*G->Text = Text
EndIf
If G->CallBackFunc Then G->CallBackFunc(G)
EndIf
If G->Reserviert(1)-G->Reserviert(0) > HZ Then G->Reserviert(0) += 1
If G->Reserviert(1)-G->Reserviert(0) < 1 Then G->Reserviert(0) -= 1
If G->Reserviert(0)<0 Then G->Reserviert(0)=0
End Sub
Function CreateInputBox ( ByVal P As Gadget Ptr, ByVal Text As String, ByVal X As Integer, ByVal Y As Integer, ByVal W As Integer, ByVal F As Sub( ByVal As Gadget Ptr )) As Gadget Ptr
Return CreateGadget ( P, 1, Text, X, Y, W, 18, 4, @DrawInputBox, 0, @MouseFuncInputBox, 0, F, @KeyFuncInputBox, RGB(200,100,100), 0, 0, RGB(255,255,255), 0 )
End Function
Sub DrawProgressBar ( ByVal G As Gadget Ptr, ByVal X As Integer, ByVal Y As Integer, ByVal Im As Any Ptr )
Dim As WinRect R
R.X = X
R.Y = Y
R.W = G->R.W+G->F.X+G->F.W
R.H = G->R.H+G->F.Y+G->F.H
Line Im, (R.X,R.Y)-(R.X+R.W,R.Y+R.H),G->colorbackground,bf
If G->Reserviert(0)=0 Then
R.W *= G->Reserviert(1)/10000
ElseIf G->Reserviert(0)=1 Then
R.X += R.W-R.W*G->Reserviert(1)/10000
R.W *= G->Reserviert(1)/10000
ElseIf G->Reserviert(0)=2 Then
R.H *= G->Reserviert(1)/10000
Else
R.Y += R.H-R.H*G->Reserviert(1)/10000
R.H *= G->Reserviert(1)/10000
EndIf
DrawBox2(Im,G->coloractiv,R,Timer,G->Reserviert(0))
R.X = X
R.Y = Y
R.W = G->R.W+G->F.X+G->F.W
R.H = G->R.H+G->F.Y+G->F.H
Line Im, (R.X,R.Y)-(R.X+R.W,R.Y+R.H),RGB(0,0,0),b
End Sub
Sub SetProgress ( ByVal G As Gadget Ptr, ByVal Progress As Single )
G->Reserviert(1) = Progress*100
If G->Reserviert(1)>10000 Then G->Reserviert(1)=10000
If G->Reserviert(1)<0 Then G->Reserviert(1)=0
End Sub
Function GetProgress ( ByVal G As Gadget Ptr ) As Single
Return G->Reserviert(1)/100
End Function
Function CreateProgressBar ( ByVal P As Gadget Ptr, ByVal X As Integer, ByVal Y As Integer, ByVal W As Integer, ByVal H As Integer, ByVal Pr As Integer, ByVal T As Integer ) As Gadget Ptr
Dim Win As Gadget Ptr
Win = CreateGadget ( P, 1, "", X, Y, W, H, 5, @DrawProgressBar, 0, 0, 0, 0, 0, RGB(100,200,100), 0, 0, RGB(255,255,255), 0 )
Win->Reserviert(0) = T
Win->Reserviert(1) = Pr
Return Win
End Function
Sub DrawSlider ( ByVal G As Gadget Ptr, ByVal X As Integer, ByVal Y As Integer, ByVal Im As Any Ptr )
Dim As WinRect R
R.X = X
R.Y = Y
R.W = G->R.W+G->F.X+G->F.W
R.H = G->R.H+G->F.Y+G->F.H
If G->Reserviert(0) Then
Line Im,(R.X+R.W/2+2,R.Y+4)-(R.X+R.W/2-2,R.Y+R.H-4),RGB(0,0,0),b
R.Y += (R.H-8)*G->Reserviert(1)/10000
R.H = 8
Else
Line Im,(R.X+4,R.Y+R.H/2+2)-(R.X+R.W-4,R.Y+R.H/2-2),RGB(0,0,0),b
R.X += (R.W-8)*G->Reserviert(1)/10000
R.W = 8
EndIf
DrawBox1(Im,G->coloractiv,R,0)
End Sub
Sub MouseFuncSlider ( ByVal G As Gadget Ptr, ByVal X As Integer, ByVal Y As Integer, ByVal M As Mouse Ptr )
Dim As WinRect R
R.X = X
R.Y = Y
R.W = G->R.W+G->F.X+G->F.W
R.H = G->R.H+G->F.Y+G->F.H
If M->B=1 And G->State = 1 Then
Dim Pr As Single
If G->Reserviert(0) Then
Pr = M->Y-M->Ya
Pr /= (R.H-8)/100
Else
Pr = M->X-M->Xa
Pr /= (R.W-8)/100
EndIf
G->Reserviert(1) += Pr*100
If G->Reserviert(1)>10000 Then G->Reserviert(1) = 10000
If G->Reserviert(1)<0 Then G->Reserviert(1) = 0
If Pr Then
If G->CallBackFunc Then G->CallBackFunc(G)
EndIf
EndIf
If M->B = 1 And M->Ba = 0 Then
If G->Reserviert(0) Then
R.Y += (R.H-8)*G->Reserviert(1)/10000
R.H = 8
Else
R.X += (R.W-8)*G->Reserviert(1)/10000
R.W = 8
EndIf
If M->X >= R.X And M->X <= R.X+R.W And M->Y >= R.Y And M->Y <= R.Y+R.H Then
G->State = 1
EndIf
EndIf
If M->B = 0 Then
G->State = 0
EndIf
End Sub
Function CreateSlider ( ByVal P As Gadget Ptr, ByVal X As Integer, ByVal Y As Integer, ByVal W As Integer, ByVal H As Integer, ByVal Pr As Integer, ByVal T As Integer = 0, ByVal F As Sub( ByVal As Gadget Ptr ) ) As Gadget Ptr
Dim Win As Gadget Ptr
Win = CreateGadget ( P, 1, "", X, Y, W, H, 6, @DrawSlider, 0, @MouseFuncSlider, 0, F, 0, RGB(100,100,200), 0, 0, 0, 0 )
Win->Reserviert(0) = T
Win->Reserviert(1) = Pr
Return Win
End Function
Sub DrawScrollBar ( ByVal G As Gadget Ptr, ByVal X As Integer, ByVal Y As Integer, ByVal Im As Any Ptr )
Dim As WinRect R
Dim As Integer PW
R.X = X
R.Y = Y
R.W = G->R.W+G->F.X+G->F.W
R.H = G->R.H+G->F.Y+G->F.H
PW = G->Reserviert(2)
DrawBox1(Im,G->colorbackground,R,1)
If G->Reserviert(1)>G->Reserviert(2)*100 Then G->Reserviert(1)=G->Reserviert(2)*100
If G->Reserviert(2)<>0 Then
If G->Reserviert(0) Then
PW = R.H/(PW+1)
If PW < 8 Then PW = 8
R.Y += (R.H-PW)/G->Reserviert(2)*G->Reserviert(1)/100
R.H = PW
Else
PW = R.W/(PW+1)
If PW < 8 Then PW = 8
R.X += (R.W-PW)/G->Reserviert(2)*G->Reserviert(1)/100
R.W = PW
EndIf
EndIf
DrawBox1(Im,G->coloractiv,R,0)
R.X = X
R.Y = Y
R.W = G->R.W+G->F.X+G->F.W
R.H = G->R.H+G->F.Y+G->F.H
Line Im,(R.X,R.Y)-(R.X+R.W,R.Y+R.H),RGB(0,0,0),b
End Sub
Sub SetScrollBarProgress ( ByVal G As Gadget Ptr, ByVal Progress As Single )
G->Reserviert(1) = Progress*100
If G->Reserviert(1)>G->Reserviert(2)*100 Then G->Reserviert(1)=G->Reserviert(2)*100
If G->Reserviert(1)<0 Then G->Reserviert(1)=0
End Sub
Sub MouseFuncScrollBar ( ByVal G As Gadget Ptr, ByVal X As Integer, ByVal Y As Integer, ByVal M As Mouse Ptr )
Dim As WinRect R
Dim As Integer PW
R.X = X
R.Y = Y
R.W = G->R.W+G->F.X+G->F.W
R.H = G->R.H+G->F.Y+G->F.H
If M->B=1 And G->State = 1 Then
Dim Pr As Single
PW = G->Reserviert(2)
If G->Reserviert(0) Then
PW = R.H/(PW+1)
Pr = M->Y-M->YA
Pr *= G->Reserviert(2)/(R.H-PW)
Else
PW = R.W/(PW+1)
Pr = M->X-M->XA
Pr *= G->Reserviert(2)/(R.W-PW)
EndIf
G->Reserviert(1) += Pr*100
If G->Reserviert(1)>G->Reserviert(2)*100 Then G->Reserviert(1) = G->Reserviert(2)*100
If G->Reserviert(1)<0 Then G->Reserviert(1) = 0
If Pr Then
If G->CallBackFunc Then G->CallBackFunc(G)
EndIf
EndIf
If M->B = 1 And M->Ba = 0 Then
PW = G->Reserviert(2)
If G->Reserviert(0) Then
PW = R.H/(PW+1)
If PW < 8 Then PW = 8
R.Y += (R.H-PW)/G->Reserviert(2)*G->Reserviert(1)/100
R.H = PW
Else
PW = R.W/(PW+1)
If PW < 8 Then PW = 8
R.X += (R.W-PW)/G->Reserviert(2)*G->Reserviert(1)/100
R.W = PW
EndIf
If M->X >= R.X And M->X <= R.X+R.W And M->Y >= R.Y And M->Y <= R.Y+R.H Then
G->State = 1
EndIf
EndIf
If M->B = 0 And G->State=1 Then
G->Reserviert(1) = Int(G->Reserviert(1)/100+0.5)*100
G->State = 0
EndIf
End Sub
Function CreateScrollBar ( ByVal P As Gadget Ptr, ByVal X As Integer, ByVal Y As Integer, ByVal W As Integer, ByVal H As Integer, ByVal Pr As Integer, ByVal Hi As Integer, ByVal T As Integer = 0, ByVal F As Sub( ByVal As Gadget Ptr ) ) As Gadget Ptr
Dim Win As Gadget Ptr
Win = CreateGadget ( P, 1, "", X, Y, W, H, 7, @DrawScrollBar, 0, @MouseFuncScrollBar, 0, F, 0, RGB(100,100,100), 0, 0, RGB(200,200,200), 0 )
Win->Reserviert(0) = T
Win->Reserviert(1) = Pr
Win->Reserviert(2) = Hi
Return Win
End Function
Sub DrawCheckBox ( ByVal G As Gadget Ptr, ByVal X As Integer, ByVal Y As Integer, ByVal Im As Any Ptr )
Dim As WinRect R
Dim As String Text
R.X = X
R.Y = Y
R.W = G->R.W+G->F.X+G->F.W
R.H = G->R.H+G->F.Y+G->F.H
Line Im,(R.X,R.Y)-(R.X+R.H,R.Y+R.H),RGB(0,0,0),bf
Line Im,(R.X+2,R.Y+2)-(R.X+R.H-2,R.Y+R.H-2),G->colorbackground,bf
If G->Reserviert(0) Then
Line Im,(R.X+3,R.Y+R.H/2)-(R.X+R.H/2.25,R.Y+R.H-4),G->coloractiv
Line Im,(R.X+3,R.Y+R.H/2+1)-(R.X+R.H/2.25,R.Y+R.H-3),G->coloractiv
Line Im,(R.X+3,R.Y+R.H/2-1)-(R.X+R.H/2.25,R.Y+R.H-5),G->coloractiv
Line Im,(R.X+3,R.Y+R.H/2-1)-(R.X+R.H/2.25,R.Y+R.H-6),G->coloractiv
Line Im,(R.X+R.H/2.25,R.Y+R.H-3)-(R.X+R.H-3,R.Y+6),G->coloractiv
Line Im,(R.X+R.H/2.25,R.Y+R.H-4)-(R.X+R.H-3,R.Y+5),G->coloractiv
Line Im,(R.X+R.H/2.25,R.Y+R.H-5)-(R.X+R.H-3,R.Y+4),G->coloractiv
Line Im,(R.X+R.H/2.25,R.Y+R.H-6)-(R.X+R.H-3,R.Y+3),G->coloractiv
EndIf
Text = *G->Text ''CheckBox Text
If R.W >= 8*4 Then
If Len(Text)*8 > R.W-R.H Then
Text = Left(Text,Len(Text)-1)
Do Until (Len(Text)+3)*8 < R.W-R.H
Text = Left(Text,Len(Text)-1)
Loop
Text += "..."
EndIf
Draw String Im,(X+R.H+2,Y+R.H/2-8),Text,G->colorfont
EndIf
End Sub
Sub MouseFuncCheckBox ( ByVal G As Gadget Ptr, ByVal X As Integer, ByVal Y As Integer, ByVal M As Mouse Ptr )
If M->B = 1 And M->Ba=0 Then
G->Reserviert(0) Xor=-1
EndIf
End Sub
Function GetCheckBoxState ( ByVal G As Gadget Ptr ) As Integer
Return G->Reserviert(0)
End Function
Sub SetCheckBoxState ( ByVal G As Gadget Ptr, ByVal Ch As Integer )
G->Reserviert(0) = Ch
End Sub
Function CreateCheckBox ( ByVal P As Gadget Ptr, ByVal Text As String, ByVal X As Integer, ByVal Y As Integer, ByVal W As Integer, ByVal H As Integer, ByVal ch As Integer, ByVal F As Sub( ByVal As Gadget Ptr ) ) As Gadget Ptr
Dim Win As Gadget Ptr
Win = CreateGadget ( P, 1, Text, X, Y, W, H, 8, @DrawCheckBox, 0, @MouseFuncCheckBox, 0, F, 0, 0, 0, 0, RGB(200,200,200), 0 )
Win->Reserviert(0) = ch
Return Win
End Function
Sub DrawRadioButton ( ByVal G As Gadget Ptr, ByVal X As Integer, ByVal Y As Integer, ByVal Im As Any Ptr )
Dim As WinRect R
Dim As String Text
R.X = X
R.Y = Y
R.W = G->R.W+G->F.X+G->F.W
R.H = G->R.H+G->F.Y+G->F.H
Circle Im,(R.X+R.H/2,R.Y+R.H/2),R.H/2-1,RGB(0,0,0),,,,f
Circle Im,(R.X+R.H/2,R.Y+R.H/2),R.H/2-3,G->colorbackground,,,,f
If G->Reserviert(0) Then
Circle Im,(R.X+R.H/2,R.Y+R.H/2),R.H/2-5,G->coloractiv,,,,f
EndIf
Text = *G->Text ''CheckBox Text
If R.W >= 8*4 Then
If Len(Text)*8 > R.W-R.H Then
Text = Left(Text,Len(Text)-1)
Do Until (Len(Text)+3)*8 < R.W-R.H
Text = Left(Text,Len(Text)-1)
Loop
Text += "..."
EndIf
Draw String Im,(X+R.H+2,Y+R.H/2-8),Text,G->colorfont
EndIf
End Sub
Sub SetCheckBoxStateto0 ( ByVal G As Gadget Ptr, ByVal rich As Integer )
If G = 0 Then Exit Sub
If G->Reserviert(0) Then
G->Reserviert(0) = 0
If G->CallBackFunc Then G->CallBackFunc(G)
EndIf
If rich Then
SetCheckBoxStateto0(Cast(Gadget Ptr,G->Reserviert(1)),-1)
Else
SetCheckBoxStateto0(Cast(Gadget Ptr,G->Reserviert(2)),0)
EndIf
End Sub
Sub SetRadioButtonState ( ByVal G As Gadget Ptr, ByVal Ch As Integer )
If Ch And G->Reserviert(0)=0 Then
G->Reserviert(0)=-1
SetCheckBoxStateto0(Cast(Gadget Ptr,G->Reserviert(1)),-1)
SetCheckBoxStateto0(Cast(Gadget Ptr,G->Reserviert(2)),0)
Else
G->Reserviert(0) = 0
EndIf
End Sub
Sub MouseFuncRadioButton ( ByVal G As Gadget Ptr, ByVal X As Integer, ByVal Y As Integer, ByVal M As Mouse Ptr )
If M->B = 1 And M->Ba=0 And G->Reserviert(0)=0 Then
SetRadioButtonState(G,-1)
If G->CallBackFunc Then G->CallBackFunc(G)
EndIf
End Sub
Function GetRadioButtonState ( ByVal G As Gadget Ptr ) As Integer
Return G->Reserviert(0)
End Function
Function CreateRadioButton ( ByVal P As Gadget Ptr, ByVal Other As Gadget Ptr, ByVal Text As String, ByVal X As Integer, ByVal Y As Integer, ByVal W As Integer, ByVal H As Integer, ByVal Ch As Integer, ByVal F As Sub( ByVal As Gadget Ptr ) ) As Gadget Ptr
Dim Win As Gadget Ptr
Dim C As Gadget Ptr
Win = CreateGadget ( P, 1, Text, X, Y, W, H, 9, @DrawRadioButton, 0, @MouseFuncRadioButton, 0, F, 0, 0, 0, 0, RGB(200,200,200), 0 )
If Other Then
C = Other
Do Until C->Reserviert(2) = 0
C = Cast(Gadget Ptr,C->Reserviert(2))
Loop
Win->Reserviert(1) = Cast(Long,C)
Win->Reserviert(2) = C->Reserviert(2)
C->Reserviert(2) = Cast(Long,Win)
EndIf
Win->Reserviert(0) = ch
Return Win
End Function
Sub DrawToggleButton ( ByVal G As Gadget Ptr, ByVal X As Integer, ByVal Y As Integer, ByVal Im As Any Ptr )
Dim As String Text
Dim As WinRect R
R.X = X
R.Y = Y
R.W = G->R.W+G->F.X+G->F.W
R.H = G->R.H+G->F.Y+G->F.H
If (G->State And Not(1)) Then ''Wenn mouse drueber
DrawBox1(Im,G->colormouseover,R,G->State And Not(2))''Button zeichnen
Else
If (G->State And Not(2)) Then
DrawBox1(Im,G->coloractiv,R,1)''Ansonsten inaktiv
Else
DrawBox1(Im,G->colorinactiv,R,0)''Ansonsten inaktiv
EndIf
EndIf
Line Im,(X-1,Y-1)-(X+R.W+1,Y+R.H+1),RGB(0,0,0),b ''Frame
Text = *G->Text ''Button Text
If R.W >= 8*4 Or Len(Text)*8 <= R.W Then
If Len(Text)*8 > R.W Then
Text = Left(Text,Len(Text)-1)
Do Until (Len(Text)+3)*8 < R.W
Text = Left(Text,Len(Text)-1)
Loop
Text += "..."
EndIf
Draw String Im,(X+R.W/2-Len(Text)*4,Y+R.H/2-8),Text,G->colorfont
EndIf
G->State = G->State And Not(2)
End Sub
Sub MouseFuncToggleButton ( ByVal G As Gadget Ptr, ByVal X As Integer, ByVal Y As Integer, ByVal M As Mouse Ptr )
If M->B = 1 And M->Ba = 0 Then
If (G->State And 1) Then
G->State = G->State And Not(1)
Else
G->State = G->State Or 1
EndIf
If G->CallBackFunc Then G->CallBackFunc(G)
EndIf
End Sub
Sub MouseOverToggleButton ( ByVal G As Gadget Ptr )
G->State = G->State Or 2
End Sub
Function GetToggleButtonState ( ByVal G As Gadget Ptr ) As Integer
Return (G->State And 1)=1
End Function
Sub SetToggleButtonState ( ByVal G As Gadget Ptr, ByVal T As Integer )
If T Then
G->State = G->State Or 1
Else
G->State = G->State And Not(1)
EndIf
End Sub
Function CreateToggleButton ( ByVal P As Gadget Ptr, ByVal Text As String, ByVal X As Integer, ByVal Y As Integer, ByVal W As Integer, ByVal H As Integer, ByVal S As Integer, ByVal F As Sub ( ByVal As Gadget Ptr ) ) As Gadget Ptr
Dim Win As Gadget Ptr
Win = CreateGadget ( P, 1, Text, X, Y, W, H, 3, @DrawToggleButton, 0, @MouseFuncToggleButton, @MouseOverToggleButton, F, 0, RGB(100,200,100), RGB(200,200,200), RGB(100,200,100), 0, 0 )
If S Then
Win->State = 1
EndIf
Return Win
End Function
Dim Shared D As Gadget Ptr
Dim Shared W(0 To 2) As Gadget Ptr
Dim Shared B(0 To 4) As Gadget Ptr
Dim Shared Pr(0 To 3) As Gadget Ptr
Dim Shared Sl(0 To 2) As Gadget Ptr
Sub EndGui(ByVal G As Gadget Ptr )
DestroyGadget(D)
End
End Sub
Sub WinHide(ByVal G As Gadget Ptr )
GadgetOff(W(0))
End Sub
Sub WinShow(ByVal G As Gadget Ptr )
GadgetOn(W(0))
End Sub
Sub Input1(ByVal G As Gadget Ptr )
SetGadgetText(B(4),GetGadgetText(G))
End Sub
Sub Slider1(ByVal G As Gadget Ptr )
SetProgress(Pr(0),GetProgress(G))
SetProgress(Pr(1),GetProgress(G))
SetProgress(Pr(2),GetProgress(G))
SetProgress(Pr(3),GetProgress(G))
End Sub
ScreenRes 640,480,32
Width 640/8,480/16
Dim L(0 To 3) As Gadget Ptr
Dim In(0 To 0) As Gadget Ptr
Dim CB(0 To 3) As Gadget Ptr
Dim A As Single
Dim M As Mouse
D = CreateDesktop(@EndGui)
W(0) = CreateWindow(D,"Window1",10,10,300,200,-1,-1)
W(1) = CreateWindow(D,"MousePosi",150,150,100,70)
SetGadgetBackgroundColor(W(1),RGB(80,80,180))
SetGadgetActiveColor(W(1),RGB(120,120,220))
W(2) = CreateWindow(D,"Window2",200,20,500,360,0,-1)
L(0) = CreateLabel(W(2),"Label1",10,10)
L(1) = CreateLabel(W(0),"Label2",20,20)
L(2) = CreateLabel(W(1),"MX:0",10,10)
L(3) = CreateLabel(W(1),"MY:0",10,30)
SetGadgetFontColor(L(2),RGB(255,255,255))
SetGadgetFontColor(L(3),RGB(255,255,255))
B(0) = CreateButton(W(0),"End",30,40,100,20,@EndGui)
B(1) = CreateButton(W(2),"Hide Window1",30,40,100,20,@WinHide)
B(2) = CreateButton(W(2),"Show Window1",30,70,100,20,@WinShow)
B(3) = CreateButton(D,"End",1,1,100,17,@EndGui)
B(4) = CreateToggleButton(W(2),"Input1",100,120,100,17,0,0)
In(0) = CreateInputBox(W(2),"Input1",100,100,100,@Input1)
Pr(0) = CreateProgressBar(W(2),100,220,200,20,0,0)
Pr(1) = CreateProgressBar(W(2),100,240,200,20,0,1)
Pr(2) = CreateProgressBar(W(2),300,20,20,200,0,2)
Pr(3) = CreateProgressBar(W(2),320,20,20,200,0,3)
Sl(0) = CreateSlider(W(2),100,290,100,20,0,0,@Slider1)
Sl(1) = CreateScrollBar(W(2),100,320,300,20,0,6,0,0)
Sl(2) = CreateScrollBar(W(2),400,20,20,300,0,6,1,0)
CB(0) = CreateCheckBox(W(0),"Checkbox1",100,100,100,16,0,0)
CB(1) = CreateRadioButton(W(0),0,"RadioButton1",100,120,120,16,0,0)
CB(2) = CreateRadioButton(W(0),CB(1),"RadioButton2",100,140,120,16,0,0)
CB(3) = CreateRadioButton(W(0),CB(1),"RadioButton3",100,160,120,16,1,0)
Do
M.Update()
SetGadgetText(L(2),"MX:"+Str(M.X))
SetGadgetText(L(3),"MY:"+Str(M.Y))
DesktopUpdate(D,@M,InKey)
ScreenLock
For i As Integer = 0 To 480
Line(0,i)-(640,i),GFXAddColor(RGB(0,128,255),(i/480-0.5)*50),bf
Next
DesktopDrawUpdate(D)
ScreenUnLock
Sleep 1,1
Loop Until MultiKey(1)
DestroyGadget(D)