Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Button-Beispiel mit externer Datei
| Uploader: |  Sebastian |
| Datum/Zeit: | 19.08.2012 16:05:40 |
' Code-Beispiel zum Lesen von Button-Definitionen aus einer externen
' Textdatei und Handling der Buttons im Programm
' FreeBASIC-Portal.de / 19.08.2012 / FreeBASIC 0.23.0 Stable Win32
' Lizenz: FBPSL
' WICHTIG:
' Bitte vorher die Datei buttons_def.txt von hier herunterladen:
' http://www.freebasic-portal.de/porticula/buttonsdef-txt-fuer-button-beispiel-1543.html
' Optimierungsmoeglichkeiten, die das Programm zwar komplizierter, aber
' besser machen wuerden:
' - Modularisierung durch Unterprogramme
' - Verkettete Liste fuer die Buttons (statt eines fixen Arrays)
' - Hover- und OnClick-Effekte
' - RGB-Splitting fuer Farbverlauf nur einmal am Anfang des Programms
' durchfuehren und nicht fuer jeden DrawButton-Aufruf -> Performance
Declare Sub DrawButton ( ByVal x As UShort, _
ByVal y As UShort, _
Breite As UShort, _
Hoehe As UShort, _
Text As String )
#define FARBVERLAUF_A &H00F4F4FFul
#define FARBVERLAUF_B &H009A9A9Aul
#define BUTTON_RAHMEN &H00777777ul
#define BUTTON_TEXT &H00222222ul
Const MAX_BUTTONS = 32
Type TButton
X As UShort
Y As UShort
Breite As UShort
Hoehe As UShort
ID As UShort
Aufschrift As ZString Ptr
End Type
Dim Buttons(1 To MAX_BUTTONS) As TButton
Dim Buttons_N As UShort
Dim BtnText As String
Dim f As Integer = FreeFile
Dim i As Integer = 1
'Button-Definitionen aus Datei einlesen
Print "Lese Button-Datei ..."
Open ExePath + "\buttons_def.txt" For Input As #f
Do Until Eof(f)
With Buttons(i)
Input #f, .ID, .X, .Y, .Breite, .Hoehe, BtnText
Print " "; .ID; " "; .X; " "; .Y; " "; .Breite; _
" "; .Hoehe; " "; chr(34); BtnText; chr(34)
.Aufschrift = CAllocate(Len(BtnText)+1)
*(.Aufschrift) = BtnText
End With
i += 1
If (i > MAX_BUTTONS) Then
Print "Warnung: In der Button-Datei wurden mehr Buttons definiert, als"
Print "im Programm vorgesehen sind (maximal " & MAX_BUTTONS & ")."
Print "Bitte MAX_BUTTONS-Konstante oder Datei anpassen."
Sleep
Exit Do
End If
Loop
Close #f
Buttons_N = i-1
Print "Datei gelesen";
If Buttons_N >= 1 Then
Print ". " & Buttons_N & " Eintraege gefunden."
Else
Print ", aber keine Eintraege gefunden."
Print "Das Programm wird beendet."
Sleep: End
End If
Print
'Grafikmodus
ScreenRes 800, 600, 32
'Buttons zeichnen
For i = LBound(Buttons) To Buttons_N
With Buttons(i)
DrawButton (.X, .Y, .Breite, .Hoehe, *(.Aufschrift))
End With
Next i
Dim As Integer mx, my, mt
Do Until Inkey <> "" 'Abbruch mit beliebiger Taste.
Sleep 1
GetMouse mx, my, , mt
If (mt AND 1) Then 'Linke Maustaste gedrueckt.
'Auf einem Button? wenn ja, auf welchem? Alle mal ueberpruefen!
For i = LBound(Buttons) To Buttons_N
With Buttons(i)
If ( (mx >= .X) AND (mx < (.X+.Breite)) AND _
(my >= .Y) AND (my < (.Y+.Hoehe)) ) Then
'Der Klick erfolgte innerhalb der Flaeche dieses Buttons!
Beep
Locate 1,1 'Textcursor oben links in die Ecke setzen
'Fallunterscheidung: Welcher Button war's denn?
Select Case .ID
Case 1000:
Print "OK, Sie wollen also Pizza bestellen! "
Case 2000:
Print "Aha, Nudeln sind auch eine gute Wahl! "
Case 3000:
Print "Die Bestellung konnte leider nicht registriert werden. "
Case 4000:
Print "Alle Speisen enthalten Poekelsalz und Spuren von Erdnuessen!"
End Select
Exit For
End If
End With
Next i
End If
Loop
End
Sub DrawButton ( ByVal x As UShort, ByVal y As UShort, _
Breite As UShort, Hoehe As UShort, Text As String)
'--- Vorbereitungen fuer Farbverlauf: ---
Dim As UByte RStart, GStart, BStart
Dim As UByte REnd, GEnd, BEnd
Dim As Double RStep, GStep, BStep
'R, G und B aus Startfarbe extrahieren
RStart = (FARBVERLAUF_A SHR 16) AND 255
GStart = (FARBVERLAUF_A SHR 8) AND 255
BStart = FARBVERLAUF_A AND 255
'R, G und B aus Endfarbe extrahieren
REnd = (FARBVERLAUF_B SHR 16) AND 255
GEnd = (FARBVERLAUF_B SHR 8) AND 255
BEnd = FARBVERLAUF_B AND 255
'Schrittweite für jeden Farbkanal
RStep = (CDbl(REnd)-RStart)/(Hoehe-2)
GStep = (CDbl(GEnd)-GStart)/(Hoehe-2)
BStep = (CDbl(BEnd)-BStart)/(Hoehe-2)
' --- Button zeichnen: ---
'Schatten fuer Button
Line (x+3, y+3)-(x+Breite+1, y+Hoehe+1),&H444444, BF
'Buttonflaeche
Dim As Double R=RStart, G=GStart, B=BStart
Dim As UInteger Zwischenfarbe
For i As Integer = y+1 To y+Hoehe-2
Zwischenfarbe = RGB( cint(R), cint(G), cint(B) )
Line (x+1, i)-(x+Breite-2,i), Zwischenfarbe
R += RStep
G += GStep
B += BStep
Next i
'Buttonrahmen
Line (x,y)-(x+Breite-1,y+Hoehe-1), BUTTON_RAHMEN, B
'Aufschrift
Dim tx As UShort = x + (Breite - (Len(Text)*8))/2
Dim ty As UShort = y + (Hoehe - 8)/2
Draw String (tx+1, ty+1), Text, (NOT BUTTON_TEXT), , PSET 'Textschatten
Draw String (tx, ty), Text, BUTTON_TEXT, , PSET
End Sub