Damit Andesdafs Beispiel korrekt funktioniert, muß der Unicode-Modus deaktiviert werden:stevie1401 hat geschrieben:Das hast du doch schon selbst mit dem betreffenden Bild dokumentiert...
Menüleiste => Compiler => Compiler-Optionen
und dann das Häkchen vor "Unicode-Executable erstellen" entfernen.
Allerdings haben alle bisher vorgestellten Lösungen ihre Nachteile:
- Andesdafs Lösung müßte noch für den Unicode-Modus angepaßt werden und schreibt immer den kompletten Inhalt ins EditorGadget. Bei Chat-Fenstern wird dies immer problematischer, je größer der zu schreibende Text wird...
- ts-softs Lösung wird direkt ins CanvasGadget gezeichnet und wird dann schwieriger zu handhaben, wenn ein Scrolling gewünscht wird...
Meine Lösung sieht zwar zunächst kompliziert aus, hat aber folgende Vorteile:
- sie ist sehr leicht ausbaufähig (Text-Attribute lassen sich leicht in der DataSection hinzufügen oder entfernen, umbenennen usw. ohne dass eine Code-Änderung nötig ist)
- sie funktioniert im ASCII- und Unicode-Modus
- sie erlaubt es, in einer Zeile nur einzelne Wörter mit Attributen zu versehen; deshalb ist ein Attribut zunächst einzuschalten (z.B. fett mit [f] zu Beginn des gewünschten Wortes) und am Ende des gewünschten Abschnitts wieder auszuschalten (wieder mit [f], um das Textattribut Fett wieder zu deaktivieren)
- sie erlaubt das gleichzeitige Aktivieren von Attributen (z.B. fett und kursiv und unterstrichen)
- sie überschreibt nicht den Inhalt des EditorGadgets, sondern hängt den neuen Text an den vorhandenen an ohne ihn zu überschreiben und ist dadurch sehr performant
- sie läuft so nur unter Windows, ist aber mit einigen kleinen Änderungen Plattform-unabhängig zu gestalten, sodass sie auch unter MacOS X läuft (für Linux wird es etwas komplizierter, wenn Interesse besteht, kann ich auch eine total Plattform-unabhängige Lösung zeigen...)
Code: Alles auswählen
EnableExplicit
Structure TagEntry
Name.S
RTFName.S
Open.I
EndStructure
Procedure AddTextWithAttributes(EditorGadgetID.I, AttributeText.S)
Static NewList Tag.TagEntry()
Protected ASCIIAttributeText.S
Protected Offset.I
Protected RTFTag.S
Protected TagList.S
Protected TagName.S
Protected TagOffset.I
; ----- Tag-Namen and ihre RTF-Äquivalente einlesen
If ListSize(Tag()) = 0
Repeat
Read.S TagName
If TagName = ""
Break
Else
AddElement(Tag())
Tag()\Name = TagName
Read.S Tag()\RTFName
EndIf
ForEver
EndIf
; ----- Alle Tags finden und durch RTF-Tags ersetzen
Repeat
Offset = FindString(AttributeText, "[")
If Offset = 0
Break
Else
TagList = ""
TagOffset = Offset + 1
RTFTag = "{"
Repeat
TagName = Mid(AttributeText, TagOffset, 1)
If TagName = "]"
ForEach Tag()
If FindString(TagList, Tag()\Name) > 0
If Tag()\Open = #True
Tag()\Open = #False
RTFTag = "}"
Else
Tag()\Open = #True
RTFTag + "\" + Tag()\RTFName + " "
EndIf
EndIf
Next
Break
Else
TagList + TagName
EndIf
TagOffset + 1
ForEver
AttributeText = ReplaceString(AttributeText, "[" + TagList + "]", RTFTag, #PB_String_NoCase, Offset, 1)
AttributeText = ReplaceString(AttributeText, #CR$, "\line")
EndIf
ForEver
SendMessage_(GadgetID(EditorGadgetID), #EM_SETSEL, -1, -1)
AttributeText = "{\rtf1" +
"{\colortbl;\red0\green0\blue0;" +
"\red200\green50\blue50;" +
"\red100\green200\blue100;" +
"\red0\green0\blue255;}" +
AttributeText + "}"
CompilerIf #PB_Compiler_Unicode
ASCIIAttributeText = Space(StringByteLength(AttributeText, #PB_Ascii))
PokeS(@ASCIIAttributeText, AttributeText, -1, #PB_Ascii)
CompilerElse
ASCIIAttributeText = AttributeText
CompilerEndIf
SendMessage_(GadgetID(EditorGadgetID), #EM_REPLACESEL, 0, ASCIIAttributeText)
EndProcedure
OpenWindow(0, 100, 100, 500, 200, "EditorGadget mit Text-Attributen")
EditorGadget(0, 10, 10, WindowWidth(0) - 20, WindowHeight(0) - 20)
SetGadgetFont(0, LoadFont(0, "Arial", 12))
AddTextWithAttributes(0, "[g]Die erste Zeile ist in grüner Schrift.[g]" + #CR$)
AddTextWithAttributes(0, "[r]Diese Zeile ist in roter Schrift.[r]" + #CR$)
AddTextWithAttributes(0, "[b]Diese Zeile ist in blauer Schrift.[b]" + #CR$)
AddTextWithAttributes(0, "Diese Zeile enthält [g]grüne[g], [r]rote[r] und " +
"[b]blau[b] gefärbte Wörter." + #CR$ + #CR$)
AddTextWithAttributes(0, "Dies ist [f]fetter Text[f] und der folgende ist " +
"[u]unterstrichen[u]." + #CR$)
AddTextWithAttributes(0, "Das folgende Wort ist [k]kursiv[k]." + #CR$)
AddTextWithAttributes(0, "[ku]Dieser Text ist kursiv und unterstrichen![ku] " +
"Und jetzt wieder normal.")
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow
End
DataSection
Data.S "f", "b" ; [f] = Fett
Data.S "k", "i" ; [k] = Kursiv
Data.S "u", "ul" ; [u] = Unterstrichen
Data.S "r", "cf2" ; [r] = Rot
Data.S "g", "cf3" ; [g] = Grün
Data.S "b", "cf4" ; [b] = Blau
Data.S ""
EndDataSection
