Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Kleines Gui beispiel2
| Uploader: |  XOR |
| Datum/Zeit: | 05.07.2011 21:23:39 |
'' 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
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
''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 )
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 = ImageCreate(G->R.W,G->R.H)''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)
If IsD Then
Put(X,Y), D, Trans
If D Then ImageDestroy(D)
EndIf
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 ) ) 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
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
''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 )
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
DrawBox1(Im,RGB(100,200,100),R,G->State And Not(2))''Button zeichnen
Else
DrawBox1(Im,RGB(200,200,200),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 Len(Text)*8 > R.W Then ''Zur richtigen lenge kuerzen wenn es zu lang sein sollte.
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,RGB(0,0,0)
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 Or= 1
EndIf
If MouseOverOp(G,X,Y,M) = 0 Then 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 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 )
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),RGB(220,220,220),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
DrawBox1(Im,RGB(200,200,100),R,0)
Else
DrawBox1(Im,RGB(100,100,100),R,0)
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 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,RGB(0,0,0)
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 )
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
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,RGB(0,0,0)
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 )
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),RGB(255,255,255),bf
If G->HasFocus Then
R.X = X+(G->Reserviert(1)-G->Reserviert(0))*8+1
R.W = 8
DrawBox1(Im,RGB(200,100,100),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)),RGB(0,0,0)
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)+"S" Then
Text = Mid(Text,1,G->Reserviert(1))+Mid(Text,G->Reserviert(1)+2)
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 )
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
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
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 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)
W(2) = CreateWindow(D,"Window2",200,20,500,300,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)
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) = CreateButton(W(2),"Input1",100,120,100,17,0)
In(0) = CreateInputBox(W(2),"Input1",100,100,100,@Input1)
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)