Home

Add

Edit

With Linenumbers

Code in Textfield

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 8, 1 To T_TastenMax) As String     '8 gruppen 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
Dim TGruppe As Integer                              'Array-Gruppen Variable (TV, Radio, DVD, usw.) Maximal 8 mögliche gruppen
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
    TGruppe = Cint(Ucase(Left(T, 1)) - 64)          'A-Z in Zahlen von 1-... umwandeln
    If TGruppe > 8 Then                             'Wenn Gruppennummer größer als 8 ist, dann weiter
        Continue Do
    End If
    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(TGruppe, Cint(T1)) = Mid(T, TPos + 1)   'Ansonsten den rechten Rest vom Text in das Array an die Position und die gruppe 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
Dim TAktuelleGruppe As Uinteger = 1                 'Variable welche die AKtuelle Gruppe Speichert

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(TAktuelleGruppe, TNum) <> "" Then                'Wenn Daten hinterlegt wurden
                        Print #1, "Daten:" & T_TastenArray_Daten(TAktuelleGruppe, 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