Program for adding two numbers:
Code: Select all
#Include "GUI.bas"
'Globale Variablen für Buttons und Textboxen:
Dim Shared As Button Button_Add, Button_Close
Dim Shared As TextBox Text_a, Text_b, Text_result
Dim As Single a, b, result
Sub OpenWindow_Main()
' Fenster
Dim As Label Label_a, Label_b, Label_result
OpenWindow (220, 200, "Add two numbers")
Label_a = Label_New (20, 20, 60, 20, "a:")
Label_b = Label_New (20, 50, 60, 20, "b:")
Button_Add = Button_New (100, 80, 80, 20, "Add")
Label_result = Label_New (20, 110, 60, 20, "a + b:")
Text_a = TextBox_New (100, 20, 80, 20, "0")
Text_b = TextBox_New (100, 50, 80, 20, "0")
Text_result = TextBox_New (100, 110, 80, 20, "0")
Button_Close = Button_New (150, 170, 60, 20, "Close")
End Sub
Sub Add(a As Single, b As Single)
'Werte a und b auslesen, addieren, Resultat anzeigen
Dim As Single result
a = Val(TextBox_GetText(Text_a))
b = Val(TextBox_GetText(Text_b))
result = a + b
TextBox_SetText(Text_result, Str(result))
End Sub
'Hauptprogramm:
OpenWindow_Main()
Do
If TextBox_Event(Text_a) Then TextBox_Edit(Text_a)
If TextBox_Event(Text_b) Then TextBox_Edit(Text_b)
If Button_Event(Button_Add) Then Add(a, b)
Loop Until Button_Event(Button_Close) Or Window_Event_Close
End
Code: Select all
'===============================================================================
' GUI.bas
' GUI für den FB-Grafikbildschirm, Farbtiefe 32 Bit, 8x16 Zeichensatz
' Erstellt am 09.01.2015
'===============================================================================
Type Label
x As Integer 'Position links oben
y As Integer
w As Integer 'Höhe
h As Integer 'Breite
text As String 'Beschriftung
End Type
Type TextBox
x As Integer 'Position links oben
y As Integer
w As Integer 'Höhe
h As Integer 'Breite
text As String 'Beschriftung
End Type
Type Button
x As Integer 'Position links oben
y As Integer
w As Integer 'Höhe
h As Integer 'Breite
text As String 'Beschriftung
End Type
Sub OpenWindow(w As Integer, h As Integer, title As String)
'Fenster weiss, Textfarbe schwarz, 8x16 Zeichensatz
Screenres(w, h, 32)
Windowtitle title
Width w \ 8, h \ 16
Color &h000000, &hFFFFFF
Cls 0
End Sub
Function Window_Event_Close() As Integer
'Prüft, ob das "Schließen" - Kreuz des Fensters geklickt wurde
If Inkey = Chr(255, 107) Then Return 1 Else Return 0
End Function
Function Label_New(x As Integer, y As Integer, w As Integer, h As Integer, _
text As String) As Label
'Neuen Label definieren und zeichnen
Dim As Label lbl
'Label zeichnen:
Draw String (x, y + 0.5 * (h - 16)), text
'Label definieren:
lbl.x = x
lbl.y = y
lbl.h = h
lbl.w = w
lbl.text = text
Return lbl
End Function
Function TextBox_New(x As Integer, y As Integer, w As Integer, h As Integer, _
text As String) As TextBox
'Neue TextBox definieren und zeichnen
Dim As TextBox tb
'Textbox zeichnen:
Line (x, y) - (x + w, y + h),, B
Draw String (x, y + 0.5 * (h - 16)), Left(text, w / 8 - 1)
'Textbox definieren:
tb.x = x
tb.y = y
tb.h = h
tb.w = w
tb.text = text
Return tb
End Function
Sub TextBox_SetText(ByRef tb As TextBox, text As String)
'alten Text löschen, neuen Text reinsetzen
Line (tb.x + 1, tb.y + 1) - (tb.x + tb.w - 2, tb.y + tb.h - 2), &hFFFFFF, BF
Draw String (tb.x, tb.y + 0.5 * (tb.h - 16)), Left(text, tb.w / 8 - 1)
tb.text = text
End Sub
Function TextBox_GetText(tb As Textbox) As String
'Text aus der Textbox auslesen
Return tb.text
End Function
Sub TextBox_Edit(ByRef tb As Textbox)
'Text in der Textbox editieren
Dim As String s, keystr
Dim As Integer key, ExitFlag = 0, mx, my, mb
s = TextBox_GetText(tb)
Do
ScreenLock
TextBox_SetText(tb, s + "_") 'Cursor am Ende
ScreenUnlock
keystr = inkey
If Len(keystr) = 1 Then key = Asc(keystr) Else key = 0
GetMouse mx, my,,mb
Select Case key
Case 13 'Enter
ExitFlag = 1
Case 8 'Backspace
s = RTrim(TextBox_GetText(tb), "_")
If Len(s) > 0 Then s = Left(s, Len(s) - 1)
Case 32 To 255
If Len(s) < tb.w / 8 - 2 Then
s = RTrim(TextBox_GetText(tb), "_")
s = s + Chr(key)
End If
End Select
Loop Until ExitFlag = 1 Or mb = 1
TextBox_SetText(tb, s)
End Sub
Sub Button_Draw(btn As Button, colour As UInteger)
'Button zeichnen - Hilfsprozedur
Dim As Integer TextW, TextH
'zeichnen:
Line (btn.x, btn.y) - (btn.x + btn.w, btn.y + btn.h), colour, B
TextW = 8 * Len(btn.text)
TextH = 16
Draw String (btn.x + 0.5 * (btn.w - TextW), btn.y + 0.5 * (btn.h - TextH)), _
btn.text, colour
Color &h000000
End Sub
Function Button_New(x As Integer, y As Integer, w As Integer, h As Integer, _
Text As String) As Button
'Neuen Button definieren und zeichnen
Dim As Button btn
'Button definieren:
btn.x = x
btn.y = y
btn.h = h
btn.w = w
btn.text = text
Button_Draw(btn, &h000000)
Return btn
End Function
Function TextBox_Event(tb As TextBox) As Integer
'Prüft, ob die Textbox mit der maus geklickt wurde
Dim As Integer mx, my, mbtn
Getmouse(mx, my,, mbtn)
If (mx >= tb.x) And (mx <= tb.x + tb.w) And (my >= tb.y) And (my <= tb.y + tb.h) _
And mbtn = 1 Then
Do
Getmouse(mx, my,, mbtn)
Loop Until mbtn = 0
Return 1
Else
Return 0
End if
End Function
Function Button_Event(btn As Button) As Integer
'Prüft, ob der Button geklickt wurde
Dim As Integer mx, my, mbtn
Getmouse(mx, my,, mbtn)
If (mx >= btn.x) And (mx <= btn.x + btn.w) And (my >= btn.y) And (my <= btn.y + btn.h) _
And mbtn = 1 Then
Button_Draw(btn, &hFF0000) 'aktiven Zustand des Button zeichnen (rot)
'Warten, bis Maustaste losgelassen wurde:
Do
Getmouse(mx, my,, mbtn)
Loop Until mbtn = 0
Button_Draw(btn, &h000000) 'inaktiven Zustand des Button zeichnen (schwarz)
Return 1
Else
Return 0
End if
End Function
Edit Jan 23, 2015: The project is now at http://www.freebasic-portal.de/download ... i-356.html
Latest Update: November 28, 2016