Richedit-eigenschaften

[stevie1401]

Ich suche für einen Chat eine Möglichkeit in einer Textbox (oder was auch immer) Zeilen per Befehl wie sendmessge() mit unterschiedlicher Farbe hinzufügen zu können. Andere Formatierungen benötige ich nicht.
Also so:
erste Zeile in grüner Schrift
diese Zeile in roter Schrift
diese Zeile in blauer Schrift

Ist sowas zu machen?

[Andesdaf]

Das EditorGadget von PB unterstützt RTF.

Code: Alles auswählen

If OpenWindow(0, 0, 0, 322, 150, "EditorGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  EditorGadget(0, 8, 8, 306, 133)
  SetGadgetText(0, "{\rtf1\ansi\deff0" + 
                   "{\colortbl;\red0\green0\blue0;\red255\green0\blue0;\red255\green255\blue0;}" +
                   "Dieses Wort ist \cf2 rot\cf1 .\line"+
                   "\highlight3 Diese Zeile hat ein \cf2 rotes \cf1 Wort auf gelbem Hintergrund.\highlight0\line" +
                   " Normale Formatierung.\line" +
                   "}")
  Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf

Kurze Dokumentation dazu unter anderem hier

[Kiffi]

Das EditorGadget von PB unterstützt RTF.

scheint mit den 5.31er Beta-Versionen nicht mehr zu funktionieren?



Grüße ... Peter

[ts-soft]

@Peter
Dann laß mal Unicode weg!

Ich denke mal, stevie1401 sucht eine Crossplattform-Lösung?

Vielleicht so in der Art:

Code: Alles auswählen

Procedure myDrawText(x, y, text.s, color = 0, backcolor = $FFFFFF)
  StartDrawing(CanvasOutput(0))
    DrawText(x, y, text, color, backcolor)
  StopDrawing()
EndProcedure

OpenWindow(0, #PB_Ignore, #PB_Ignore, 640, 480, "")
CanvasGadget(0, 10, 10, 620, 460)

myDrawText(10, 10, "Hallo die Enten", $0000FF)
myDrawText(10, 30, "Holla der Rucksack", $FF0000)

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Break
  EndSelect
ForEver

[Kiffi]

@Peter
Dann laß mal Unicode weg!

AuHa! Ja, danke!

Grüße ... Peter

[stevie1401]

Das Beispiel von Andesdaf geht leider nicht.
Das zweite Beispiel sieht gut aus, aber wie kann man da scrollen?
Das ist anscheinend nur ein Feld auf dem "gemalt" wird, aber keine Textbox oder Richedit.
Also eigentlich benötige ich schon sowas wie eine Richedit.
Kann man sich die evtl. basteln?

[Kiffi]

Das Beispiel von Andesdaf geht leider nicht.

wie äußert sich das?

Grüße ... Peter

[stevie1401]

Das hast du doch schon selbst mit dem betreffenden Bild dokumentiert...

[Shardik]

Das hast du doch schon selbst mit dem betreffenden Bild dokumentiert...

Damit Andesdafs Beispiel korrekt funktioniert, muß der Unicode-Modus deaktiviert werden:

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

[ts-soft]

Und hier noch ein Beispiel für Windows. Das Beispiel ist von freak, habe es nur angepaßt (war von 2006).
Einfach Text selektieren und dann formatieren (funktioniert auch ASCII und Unicode).

Code: Alles auswählen

EnableExplicit
; Selects Text inside an EditorGadget
; Line numbers range from 0 to CountGadgetItems(#Gadget)-1
; Char numbers range from 1 to the length of a line
; Set Line numbers to -1 to indicate the last line, and Char
; numbers to -1 to indicate the end of a line
; selecting from 0,1 to -1, -1 selects all.
Procedure Editor_Select(Gadget, LineStart.l, CharStart.l, LineEnd.l, CharEnd.l)   
  Protected sel.CHARRANGE
  sel\cpMin = SendMessage_(GadgetID(Gadget), #EM_LINEINDEX, LineStart, 0) + CharStart - 1
  
  If LineEnd = -1
    LineEnd = SendMessage_(GadgetID(Gadget), #EM_GETLINECOUNT, 0, 0)-1
  EndIf
  sel\cpMax = SendMessage_(GadgetID(Gadget), #EM_LINEINDEX, LineEnd, 0)
  
  If CharEnd = -1
    sel\cpMax + SendMessage_(GadgetID(Gadget), #EM_LINELENGTH, sel\cpMax, 0)
  Else
    sel\cpMax + CharEnd - 1
  EndIf
  SendMessage_(GadgetID(Gadget), #EM_EXSETSEL, 0, @sel)
EndProcedure

; Set the Text color for the Selection
; in RGB format
Procedure Editor_Color(Gadget, Color.l)
  Protected format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_COLOR
  format\crTextColor = Color
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

; Set Font Size for the Selection
; in pt
Procedure Editor_FontSize(Gadget, Fontsize.l)
  Protected format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_SIZE
  format\yHeight = FontSize*20
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

; Set Font for the Selection
; You must specify a font name, the font doesn't need
; to be loaded
Procedure Editor_Font(Gadget, FontName.s)
  Protected format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_FACE
  PokeS(@format\szFaceName, FontName)
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure

; Set Format of the Selection. This can be a combination of
; the following values:
; #CFM_BOLD
; #CFM_ITALIC
; #CFM_UNDERLINE
; #CFM_STRIKEOUT
Procedure Editor_Format(Gadget, Flags.l)
  Protected format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_ITALIC | #CFM_BOLD | #CFM_STRIKEOUT | #CFM_UNDERLINE
  format\dwEffects = Flags
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure


; -------------------------------------------------------------
; Source Example:


#Editor = 1

If OpenWindow(0, 0, 0, 500, 500, "EditorGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  
  EditorGadget(#Editor, 10, 10, 480, 480)
  
  AddGadgetItem(#Editor, 0, "This is a blue, bold and underlined big text")     
  AddGadgetItem(#Editor, 1, "Times new Roman, red, striked out and italic")   
  AddGadgetItem(#Editor, 2, "This is usual Text.")
  
  
  Editor_Select(#Editor, 0, 1, 0, -1)  ; select line 1
  Editor_Color(#Editor, RGB(0, 0, 255))
  Editor_FontSize(#Editor, 18)
  Editor_Format(#Editor, #CFM_UNDERLINE)
  
  Editor_Select(#Editor, 1, 1, 1, -1)  ; select line 2
  Editor_Color(#Editor, RGB(255, 0, 0))
  Editor_Font(#Editor, "Times New Roman")
  Editor_Format(#Editor, #CFM_ITALIC | #CFM_STRIKEOUT)
  
  Editor_Select(#Editor, 0, 0, 0, 0)   ; select nothing again
  
  
  Repeat
  Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf

End 

Es gibt keine einfache Crossplattform Lösung und alle Lösungen haben Vor- und Nachteile.

Gruß
Thomas