Sourcecode of: '-noname-'

Home

Add

'##################################################################################################################################
#Include Once "fbgfx.bi"							'Grafik-Bibliothek laden

'##################################################################################################################################
Open Cons for Output as #1							'Text-Konsole zur Ausgabe von Text öffnen

'##################################################################################################################################
'Funktion ist nur Zum Laden von BMP Bilder.
Function BMPLoad(V_FilePathName As String, ByRef R_Width as Integer = 0, ByRef R_Height as Integer = 0) As Any Ptr
Dim TFN as Integer = FreeFile
If Open(V_FilePathName For Binary Access Read As #TFN) <> 0 Then Return 0
Get #TFN, 19, R_Width
Get #TFN, 23, R_Height
Close #TFN
Dim TImg As Any Ptr = ImageCreate(R_Width, Abs(R_Height), , 32)
If TImg = 0 Then Return 0
If BLoad(V_FilePathName, TImg) <> 0 Then ImageDestroy(TImg): Return 0
Return TImg
End Function

'##################################################################################################################################
Sub Main()
Dim T_FBType as String = Command()					'Über die kommandozeile einen Fernbedinungsnamen einlesen
If Dir("fernbedienungen/" & T_FBType & ".txt") = "" Then					'Prüfen, ob eine entsprechende Config-Datei vorhanden ist
	Print "Fernbedienung nicht gefunden!"			'wenn nicht, dann fehler ausgeben und
	End -1											'fehlerhaft beenden.
End If
ScreenRes 1, 1, 32, , FB.GFX_Null					'ansonsten einen unsichtbaren screen zum laden der Fernbedinungsbilder erzeugen. (Sonst flimmerts kurz)
Dim T_Img_Width as Integer							'Variable für die Bildbreite
Dim T_Img_Height as Integer							'Variable für die Bildhöhe
Dim T_Img_Bild as Any Ptr = BMPLoad("fernbedienungen/" & T_FBType & "_bild.bmp", T_Img_Width, T_Img_Height)		'Fernbedinungsbild laden, zusätzlich Größer ermitteln
If T_Img_Bild = 0 Then								'Wenn das Bild nicht geladen werden konnte, fehler ausgeben und ende
	Print "Konnte Fernbedinungs-Bild nicht laden!"
	End -1
End If
Dim T_Img_Mask as Any Ptr = BMPLoad("fernbedienungen/" & T_FBType & "_mask.bmp")								'Fernbedinungsmaske laden
If T_Img_Bild = 0 Then								'Wenn das Bild nicht geladen werden konnte, fehler ausgeben und ende
	Print "Konnte Fernbedinungs-Maske nicht laden!"
	End -1
End If
If (T_Img_Width <= 0) or (T_Img_Height <= 0) Then	'Wenn das Bild zu klein ist, dann fehler ausgeben und ende
	Print "Bild-Dimensionen ungültig!"
	End -1
End If

Dim T_TastenMax as UInteger							'Variable für Maximale Anzahl an Tasten (für das array)
For Y as Integer = 0 to T_Img_Height - 1			'Jede Zeile des Bildes durchgehen
	For X as Integer = 0 to T_Img_Width - 1			'Jede Spalte des Bildes durchgehen
		If (Point(X, Y, T_Img_Mask) and &H0000FFFF) > T_TastenMax Then			'Wenn die Tastennummer Größer als aktuell ist,
			T_TastenMax = (Point(X, Y, T_Img_Mask) and &H0000FFFF)				'Dann neues Maximum setzen
		End If
	Next
Next
Dim T_TastenArray_Daten(1 to T_TastenMax) as String	'Array mit der Größe an Tasten definieren

Dim TFN as Integer = FreeFile()						'Freie Dateinummer erfragen
If Open("fernbedienungen/" & T_FBType & ".txt" for Input as #TFN) <> 0 Then		'Konfigurationsdatei öffnen. Wenn ungleich 0, dann fehler ausgeben
	Print "Konnte Konfigurationsdatei nicht öffnen!"
	End -1
End If
Dim T as String										'emporäre String Variable
Dim T1 as String									'emporäre String Variable
Dim TPos as Integer									'Variable für InString-Suche
Do Until EOF(TFN)									'Alle Zeilen der Datei durchlaufen, bis ende erreicht (EOF = End Of File)
	Line Input #TFN, T								'Nächste Zeile aus der Datei einesen
	TPos = InStr(1, T, "=")							'Suche das erste = in der eingelesenen Zeile
	If TPos = 0 Then								'Wenn keines gefunden wurde,
		Continue Do									'dann zurück zum anfang der Do, und nächste zeile einlesen
	End If
	T1 = Left(T, TPos - 1)							'Text vom Anfang bis zur gefundenen Position ausschneiden und zwischenspeichern
	If (CInt(T1) <= 0) or (CInt(T1) > T_TastenMax) Then							'Wenn die Hinterlegte Tastennummer zu klein, oder zu groß ist,
		Continue Do									'dann weiter zur nächsten Zeile
	End If
	T_TastenArray_Daten(CInt(T1)) = Mid(T, TPos + 1)	'Ansonsten den rechten Rest vom Text in das Array an die Position der Tastennummer speichern.
Loop
Close #TFN

ScreenRes T_Img_Width, T_Img_Height, 32				'Da jetzt die Bilddimensionen bekannt sind, einen screen entsprechend der größer erzeugen.
Put (0, 0), T_Img_Bild, PSet						'Und anschliessend das Normale Fernbedienungsbild auf das Fenster Zeichnen.

Dim TMR as Integer									'Variable für Maus-Abfrage status
Dim TMX as Integer									'Variable für Maus-X
Dim TMY as Integer									'Variable für Maus-Y
Dim TMB as Integer									'Variable für Maus-Tasten
Dim TMBL as Integer									'Variable für Maus-Tasten (zuletzt gerückt)
Dim TNum as UInteger								'Variable für die abgefragte Fernbedinungstasten-Nummer

Do													'Hauptschleife
	If InKey() = Chr(27) Then Exit Do				'Wenn ESC gedrückt wurde, dann schleife verlassen
	TMBL = TMB										'Letzter Maustastenwert speichern
	TMR = GetMouse(TMX, TMY, , TMB)					'Aktuelle Mausdaten erfassen
	If TMR = 0 Then									'Wenn Mausabfrage erfolgreich
		If TMB <> TMBL Then							'Dann prüfen, ob Tasten gedrückt oder losgelassen wurden.
			If TMB = 1 Then							'Wenn Linke-Mausaste gedrückt wurde
				TNum = (Point(TMX, TMY, T_Img_Mask) and &H0000FFFF)							'Die Tastennummer aus der Bildmaske auslesen
				If TNum > 0 Then					'Wenn Tastennummer gröser als 0 ist, dann wurde eine Taste unter dem Mauszeiger erkannt.
					Print #1, "Taste:" & TNum		'Dann diese Tastennummer auf der Konsole Ausgeben
					If T_TastenArray_Daten(TNum) <> "" Then									'Wenn Daten hinterlegt wurden
						Print #1, "Daten:" & T_TastenArray_Daten(TNum)						'dann die Dazugehörigen Daten ausgeben
						'Hier kann jetzt die WAVE datei mit den Steuerdaten erzeugt werden.
					Else
						Print #1, "Zu dieser Taste wurden keine Steuerdaten hinterlegt!"	'Ansonsten einen fehlertext ausgeben
					End If
				End If
			End If
		End If
	End If
	Sleep 10, 1										'Ein bischen warten, um die CPU zu schonen
Loop
End Sub

'##################################################################################################################################
Main()												'Hauptroutine aufrufen
End 0												'Programm sauber, und fehlerfrei beenden

DeltaLab's WebFBC