Home
Add
Edit
Without Linenumbers
Code as Text
Download
'################################################################################################################################## #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
Linux - 0.20.0 (08-10-2008) - [using Linux-Debian-Compiler]
Linux - 0.18.5 (04-17-2008) - [using Linux-Debian-Compiler]
Windows - 0.23.0 (08-14-2011) - [using wine Windows-Compiler]
Windows - 0.22.0 (05-06-2011) - [using wine Windows-Compiler]
Windows - 0.21.1 (08-11-2010) - [using wine Windows-Compiler]
Windows - 0.20.0 (08-10-2008) - [using wine Windows-Compiler]
Windows - daily git build (2012-05-23) - [using wine Windows-Compiler]
DeltaLab's WebFBC