GibTextFormatiertAus("{r}Dieser Text ist rot.{/r} ")

Graphics 800, 600, 16, 2
Satz$=Input("Geben sie bitte einen Satz ein: ")
intAnzForm=1
intChange=1
For i = 1 To Len(satz)
   Select Mid(Satz$, i, 3)
      Case "{r}"
         intChange=intChange+1
      Case "{g}"
         intChange=intChange+1
      Case "{b}"
         intChange=intChange+1
      Case "{w}"
         intChange=intChange+1
      Case "{s}"
         intChange=intChange+1
   End Select
Next

Dim Form$(intChange, 2)

For i = 1 To Len(satz$)
   If Mid(Satz, i, 1)="{" Then
      i=i+1
      Select Mid(Satz, i, 2)
         Case "r}"
            i=i+2
            intAnzForm=intAnzForm+1

            Form(intAnzForm, 2)=1
         Case "g}"
            i=i+2
            intAnzForm=intAnzForm+1

            Form(intAnzForm, 2)=2           
         Case "b}"
            i=i+2
            intAnzForm=intAnzForm+1

            Form(intAnzForm, 2)=3           
         Case "w}"
            i=i+2
            intAnzForm=intAnzForm+1

            Form(intAnzForm, 2)=0
         Case "s}"
            i=i+2
            intAnzForm=intAnzForm+1

            Form(intAnzForm, 2)=4   
      End Select

   EndIf
   Form(intAnzForm, 1)=Form(intAnzForm, 1)+Mid(Satz, i, 1)
Next
Print ""
For i = 1 To intAnzForm
   Select Form(i, 2)
      Case 0
         Color 255, 255, 255
      Case 1
         Color 255, 0, 0
      Case 2
         Color 0, 255, 0
      Case 3
         Color 0, 0, 255
      Case 4
         Color 0, 0, 0
   End Select
   Write Form(i, 1)
Next

AppTitle "Nr. 6 - Strings parsen (c)Rallimen"
Type ColStack Field RGB,Tag$ End Type
Type TextStack Field RGB,TextString$,Farbe$ End Type
Graphics 1000 ,500,16,2
Font = LoadFont ("Ariel",22,0,0,0)
SetFont font
Dat = ReadFile ("CodeTagsTextDatei.txt")
If Dat = False Then Dat = CreateDat ()

While Not Eof (Dat)
    A$ = ReadLine (Dat)
    Ausgabe a$
Wend

CloseFile Dat
Print ""
Print ""
Ausgabe (" {rgb 255 255 0}KeyHit {rgb 100 200 0}={/rgb} End{/rgb }")
WaitKey ()
End

Function CreateDat ()
    Dat = WriteFile ("CodeTagsTextDatei.txt")
    WriteLine Dat,"{rgb 255 255 0}TestDatei kann ediert werden {g} >>CodeTagsTextDatei.txt<<{/g}{/rgb}"
    WriteLine Dat,"{rgb 255 125 0} Diese { r } >>CodeTagsTextDatei.txt<<{/r} befindet sich im gleichen Verzeichnis {/rgb} "
    WriteLine Dat,"Hier kommt jetzt ein fehlerhafter CodeTag >>{/r} {b} Na, gesehen {/b}"
    WriteLine Dat," "
    WriteLine Dat,"{rgb 255 255 0} Gelb {b} Blau {r} Rot{g} Grün {/g} Rot {/r} Blau {/b}{/rgb} Weiss{b} Blau {r} Rot{g} Grün {/g} Rot {/r} Blau {/b}"
    CloseFile Dat
    Dat = ReadFile ("CodeTagsTextDatei.txt")
    Return Dat
End Function

Function Ausgabe (A$)
    Asicherung$ = a$
   
    While Len (a$)
        DummyST = Instr (A$,"{")
        ;DummyEN = Instr (A$,"}")
       
        Select DummyST
         Case 0 ; kein tag gefunden
            T.TextStack = New TextStack
            T\TextString$ = A$
            T\RGB = $ffffff
            a$ = "";
         Case 1 ; code tag direckt am anfang gefunden
            STtag$ = Upper (Left (a$,Instr (A$,"}") ) )
            If Instr (STtag$,"/") = 0 Then; neue Farbe
                C.ColStack = New ColStack
                If Instr (STtag$,"RGB") Then
                    ;Nummern rausziehen ; keine optimierte Fehlerkontrolle
                    If Instr (STtag$," ") = 0 Then Fehler = True : Goto Fehlermarke
                    STtag$ = Mid (STtag$,Instr (STtag$," ") + 1)
                    If Instr (STtag$," ") = 0 Then Fehler = True : Goto Fehlermarke
                    RGB_R = Left (STtag$,Instr (STtag$," ") - 1)
                    STtag$ = Mid (STtag$,Instr (STtag$," ") + 1)
                    If Instr (STtag$," ") = 0 Then Fehler = True : Goto Fehlermarke
                    RGB_G = Left (STtag$,Instr (STtag$," ") - 1)
                    RGB_B = Mid (STtag$,Instr (STtag$," ") + 1)
                    c\rgb = (RGB_R Shl 16) + (RGB_G Shl 8) + RGB_B
                    C\Tag$ = "RGB"
                 Else If Instr (STtag$,"R")
                    C\RGB = $FF0000 ;= rot
                    C\Tag$ = "R"
                 Else If Instr (STtag$,"G")
                    C\RGB = $FF00 ;= grün
                    C\Tag$ = "G"
                 Else If Instr (STtag$,"B")
                    C\RGB = $FF ;= blau
                    C\Tag$ = "B"
                 Else;Farbe zurücksetzten
                    Fehler = True : Goto Fehlermarke
                End If
                A$ = Mid (A$,Instr (A$,"}") + 1 )
             Else ; wenn / farbe Stack kurzen
                If C.ColStack = Null Then
                    Fehler = True : Goto Fehlermarke
                End If
                If Instr (STtag$,"RGB") Then
                    If C\Tag$ = "RGB" Then
                        Delete c
                        C.ColStack = Last ColStack
                     Else
                        Fehler = True : Goto Fehlermarke
                    End If
                 Else
                    If Instr (STtag$,C\Tag$) Then
                        Delete c
                        C.ColStack = Last ColStack
                     Else
                        Fehler = True : Goto Fehlermarke
                    End If
                End If
                A$ = Mid (A$,Instr (A$,"}") + 1)
            End If
         Default
            T.TextStack = New TextStack
            If T.TextStack = Null Then T.TextStack = New TextStack
            If C.ColStack = Null Then
                T\RGB = $FFFFFF
                T\TextString$ = Left (a$,Instr (A$,"{") - 1) ;Text einfügen
             Else
                ;letzte Farbe nehmen
                T\RGB = C\RGB
                T\TextString$ = Left (a$,Instr (A$,"{") - 1)
            End If
            A$ = Mid (A$,Instr (A$,"{") )
        End Select
       
    Wend
   
    ; fehlerausgabe und Druck
    C.ColStack = Last ColStack
    If C.ColStack <> Null Then
        Fehler = True : Goto Fehlermarke
    End If
   
    For T.TextStack = Each TextStack
        Color 0 ,0,T\RGB
        Write T\TextString$
    Next
   
    Print ""
   
    .Fehlermarke
   
    Delete Each TextStack
    Delete Each ColStack
    If Fehler Then ; fehlerzeile ausgeben und 1.Fehler Markieren
        Color 0 ,0, $ffffff
        Print ""
        Print "Fehler in Zeile entdeckt"
        gs = Len (Asicherung)
        rs = Len (A)
        Asicherung = Left (Asicherung$,Len (Asicherung) - Len (A) )
        Write "Zeile: " + Asicherung$
        Color 0 ,0, $ff0000
        Write Left (a,Instr (a,"}") )
        If Instr (a,"}") <> Len (a) Then
            Color 0 ,0, $ffffff
            Print Mid (a,Instr (a,"}") + 1)
         Else
            Print ""
        EndIf
    End If
End Function