EditorGadget: Bunte Texte, Sonderzeichen: RTF-Code auslesen

[Eckhard.S]

Wie in
http://www.purebasic.fr/german/viewtopic.php?t=9583
und
http://www.purebasic.fr/german/viewtopic.php?t=9581
zusammengefasst, kann man mit RTF bunte Texte und Unicode (Arabisch, Japanisch...) in ein EditorGadget schreiben, ohne das Programm in unicode zu kompilieren.

Wie kann man diesen Text als RTF-Code wieder auslesen, wenn jemand dort etwas geändert hat?

Vielen Dank an Edel und ts-soft für den folgenden Codeeinbau:

Code: Alles auswählen

; PB 4.0 (auch mit Demoversion)

Prototype SendMessage(hwnd,msg,wParam,lParam) 
OpenLibrary(0,"User32.dll") 
Global SendMessage_.SendMessage = GetFunction(0,"SendMessageA") 


;PB4 
; ************* Variables ************* 
Global a$
Fensterueberschrift$ = "RTF-Auslesen" 
Button_1     = 20   ; Button-ID 
                                                      
Global FontID1 
FontID1 = LoadFont(1, "Courier", 10)    ; Font für die Darstellung 

;RTF- Text 
text$ = "{\rtf1\fbidis\ansi\ansicpg1252\deff0\deflang1031{\fonttbl{\f0\fmodern\fprq1\fcharset0 Courier New;}{\f1\fswiss\fprq2\fcharset0 Arial;}{\f2\fswiss\fprq2\fcharset0 Verdana;}{\f3\fmodern\fprq1\fcharset128 MS Mincho;}{\f4\fmodern\fprq1\fcharset178 Courier New;}}"
text$ = text$ + "{\colortbl ;\red255\green0\blue0;\red0\green128\blue0;\red0\green0\blue255;\red0\green0\blue0;}"
text$ = text$ + "\viewkind4\uc1\pard\ltrpar\f0\fs20 normal \cf1 rot\cf0  \cf2 gr\'fcn\cf0  \b fett\b0  \cf3\b fettblau \cf0\b0 normal\par "
text$ = text$ + "Zeilenumbruch \f1 Arial, \f2\fs28 Verdana\fs20 , \f0 Courier New\cf4\par "
text$ = text$ + "\par "
text$ = text$ + "T\'fcrkisch: \'e7a\u287?\u305?r\u305?nak   \cf0 Japanisch:  \f3\'90\'46\'82\'cd\'93\'f5\'82\'d6\'82\'c7\f0\par "
text$ = text$ + "Arabisch: \f4\rtlch\'da\'d1\'c8\'ed\'c9\f0\ltrch        \cf4 Unicode: \u264?\u284?\u292?\u308?\u348?\u364?\u265?\u285?\u293?\u309?\u349?\u365?\cf0\f1\par "
text$ = text$ + "}"
 
#WM_SETTEXT     = 12 
#SF_RTF         = 2 
#EM_STREAMOUT   = 1098 

CompilerIf Defined(EDITSTREAM,#PB_Structure) = 0 
  Structure EDITSTREAM 
    dwCookie.l 
    dwError.l 
    pfnCallback.l 
  EndStructure 
CompilerEndIf 

; ************* Mainprogram ************* 

Procedure StreamOut(dwCookie,pbBuff,cb,*pcb) 
  SetGadgetText(dwCookie,PeekS(pbBuff)) 
  A$ = PeekS(pbBuff)                          ; der ausgelesene RTF-Code
EndProcedure 

If OpenWindow(0, 1, 1, 800, 350, Fensterueberschrift$,  #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar ) 
  SetWindowColor(0,RGB(100, 150, 100)) 
  CreateGadgetList(WindowID(0)) 
  EditorGadget(1, 20, 50, 650, 110)  ;#PB_Editor_ReadOnly 
  SetGadgetFont(1, FontID1) 
  EditorGadget(2, 20, 160, 650, 110);#PB_Editor_ReadOnly 
  SetGadgetFont(2, FontID1) 
  ButtonGadget(Button_1, 650+25, 130, 100, 20, "Kopieren") 
  SetGadgetText(1, text$)      
  
  Repeat 
    Select WaitWindowEvent() 
      Case #PB_Event_CloseWindow 
        Break 
        
      Case #PB_Event_Gadget 
        Select EventGadget() 
          
          Case Button_1 
            Stream.EDITSTREAM 
            Stream\dwCookie    = 2 
            Stream\pfnCallback = @StreamOut() 
            SendMessage_(GadgetID(1), #EM_STREAMOUT, #SF_RTF, @Stream)            
          
        Debug "RTF-Code: "+ A$                                 ; der ausgelesene RTF-Code
        SetGadgetText(2, A$)
        
            
        EndSelect 
        
    EndSelect 
  ForEver 
  
EndIf ; Open Window 

End

[Eckhard.S]

Noch ein Hinweis (von Edel):

Die Methode geht nur für kurze Texte.
Das 'SetGadgetText(dwCookie,PeekS(pbBuff))'
ueberschreibt den Text, wenn er zu lang ist.