PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Parser Problem PB 6.00 LTS

https://www.purebasic.fr/german/viewtopic.php?t=32764

Seite 1 von 1

Parser Problem PB 6.00 LTS

Verfasst: 05.09.2022 15:34
von Velindos
Hallo Leute,
hab mal mein zusammengestellten Parser aus PB 5.71 probiert und musste feststellen das er nicht mehr Funzt!

Code: Alles auswählen

; RTF To HTML im PB 5.73 ÖÜÄ
; ====================================================================
; Darstellen einer RTF-Textes im HTML-Format
;- >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
EnableExplicit
; >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Enumeration
  #Window_0
EndEnumeration
;- Gadget Constants
;
Enumeration
  #Button_Kursiv
  #Button_Fett
  #Button_Unterstrichen
  #Button_Durchgestrichen
  
  #HTML_Gadget
  #Button_HTML_Konvert
  #RTF_Gadget_Notiz
  #Button_SetzeText
  #Button_ClearText
  #AnzeigeHTML
  #AnzeigePosition
EndEnumeration
;

; *****************************************************************************
Global Parser_NOTIZ$ = ""
Parser_NOTIZ$ + "{\rtf1\ansi\ansicpg1252\deff0\deflang1031\deflangfe1031{\fonttbl{\f0\fswiss\fprq2\fcharset0 Verdana;}{\f1\fswiss\fprq2\fcharset0 Segoe WP SemiLight;}}"
Parser_NOTIZ$ + "{\colortbl ;\red0\green128\blue128;\red51\green51\blue51;}"
Parser_NOTIZ$ + "{\*\generator Msftedit 5.41.21.2510;}\viewkind4\uc1\pard\nowidctlpar\cf1\f0\fs20 So kennen wir den \'84Riverdale\ldblquote -Star gar nicht. \cf2\f1 (was so viel wie \'84Baumwollburg\ldblquote  bedeutet)\cf1\f0\par"
Parser_NOTIZ$ + "\cf1\ul\b\i\fs28 APPNAME é à ç è ê @ €   é à ç è ê Ö Ü Ä ö ü ä €  "
Parser_NOTIZ$ + "}"
; *****************************************************************************
Global Ende = 0
Global Parser_Puffer$ = ""
Global Parser_RawRichText$

Global Memo_E_Notiz
Global Formatieren
Global Editorstrike
Global Editorunderl
Global Editoritalic
Global Editorfettdr

;
Procedure Formatlesen(Gadget,Position)
  Protected preval.CHARFORMAT
  Protected Pretyp
  ; EditorGadget Format Zeichen für Zeichen auslesen
  SendMessage_(GadgetID(Gadget),#EM_SETSEL,Position,Position+1)
  SendMessage_(GadgetID(#AnzeigePosition),#EM_REPLACESEL,#WM_PASTE," ")
  SendMessage_(GadgetID(#AnzeigePosition),#EM_REPLACESEL,#WM_PASTE,Str(Formatieren))
  SendMessage_(GadgetID(Memo_E_Notiz), #WM_COPY, Position, Position+1)
  SetGadgetText(#AnzeigeHTML,"")
  SendMessage_(GadgetID(#AnzeigeHTML), #WM_PASTE, 0, 0)
  preval.CHARFORMAT
  preval\cbSize=SizeOf(CHARFORMAT)
  SendMessage_(GadgetID(Gadget),#EM_GETCHARFORMAT,#SCF_SELECTION,@preval)
  Pretyp=preval\dwEffects
  If Pretyp & #CFM_STRIKEOUT: Editorstrike=1: Else: Editorstrike=0: EndIf
  If Pretyp & #CFM_UNDERLINE: Editorunderl=1: Else: Editorunderl=0: EndIf
  If Pretyp & #CFM_ITALIC: Editoritalic=1: Else: Editoritalic=0: EndIf
  If Pretyp & #CFM_BOLD: Editorfettdr=1: Else: Editorfettdr=0: EndIf
EndProcedure
Procedure Formatsetzen(Gadget,Neuformat)
  ; EditorGadget formatieren mit Berücksichtigung bestehender Formate
  Protected Speicher1.l
  Protected Speicher2.l
  Protected Gesamtformat=0
  Protected format.CHARFORMAT
  
  Speicher1.l=0: Speicher2.l=0
  SendMessage_(GadgetID(Gadget),#EM_GETSEL,@Speicher1,@Speicher2)
  For Formatieren=Speicher1 To Speicher2 -1
    Formatlesen(Gadget,Formatieren): Gesamtformat=0
    If Neuformat=#CFM_BOLD And Editorfettdr=0: Gesamtformat=Gesamtformat|#CFM_BOLD: EndIf
    If Neuformat<>#CFM_BOLD And Editorfettdr=1: Gesamtformat=Gesamtformat|#CFM_BOLD: EndIf
    If Neuformat=#CFM_ITALIC And Editoritalic=0: Gesamtformat=Gesamtformat|#CFM_ITALIC: EndIf
    If Neuformat<>#CFM_ITALIC And Editoritalic=1: Gesamtformat=Gesamtformat|#CFM_ITALIC: EndIf
    If Neuformat=#CFM_UNDERLINE And Editorunderl=0: Gesamtformat=Gesamtformat|#CFM_UNDERLINE: EndIf
    If Neuformat<>#CFM_UNDERLINE And Editorunderl=1: Gesamtformat=Gesamtformat|#CFM_UNDERLINE: EndIf
    If Neuformat=#CFM_STRIKEOUT And Editorstrike=0: Gesamtformat=Gesamtformat|#CFM_STRIKEOUT: EndIf
    If Neuformat<>#CFM_STRIKEOUT And Editorstrike=1: Gesamtformat=Gesamtformat|#CFM_STRIKEOUT: EndIf
    format.CHARFORMAT
    format\cbSize=SizeOf(CHARFORMAT)
    format\dwMask=#CFM_ITALIC|#CFM_BOLD|#CFM_STRIKEOUT|#CFM_UNDERLINE
    format\dwEffects=Gesamtformat
    SendMessage_(GadgetID(Gadget),#EM_SETCHARFORMAT,#SCF_SELECTION,@format)
  Next
  SendMessage_(GadgetID(Gadget),#EM_SETSEL,Speicher1,Speicher2)
EndProcedure
Procedure SetzeVorlageText6()
  SendMessage_(GadgetID(Memo_E_Notiz),#EM_REPLACESEL,#WM_PASTE,Parser_NOTIZ$)
EndProcedure
  ; -------------------------------
Procedure PARSING_Konvert_Memo_HTML(VonGadget,ZumGadget)
  ; -------------------------------------
  Protected HTML$ =""
  Protected Ergebnis
  Protected Linienschaltung$
  Protected Linienschaltunglaenge
  Protected ErsatzLinienschaltung$
  
  Protected Speicher1.l=0
  Protected Speicher2.l=0
  
  Protected Textfeld$
  Protected Textfeldlange
  
  Protected Formatieren
  Protected Aktuellzeichen$
  
  Protected HtmlFettdr = 0
  Protected HtmlKursiv = 0
  Protected HtmlUnters = 0
  Protected HtmlStrike = 0
  Protected Html_LF = 0

  ; -------------------------------------
  Ergebnis = CountGadgetItems(VonGadget)
  Debug "Zeilenanzahl = " +Str(Ergebnis)
  ; -------------------------------------
  Linienschaltung$ = "-------------------------------------------------------------------------------------------------------------------------------"
  Linienschaltunglaenge= Len(Linienschaltung$)
  ErsatzLinienschaltung$ = "<HR>"
  ; -------------------------------------
  HTML$ + "<HTML>"
  
  HTML$ + "<HEAD>"
;   HTML$ + "<TITLE>" + GetGadgetText(Memo_S_Stichwort) + "</TITLE>"
;   HTML$ + "<link href='Data:image/x-icon;base64,"+Base64_Encode_FotoIcon(#Parser_FavIcon)+"  'rel='icon' type='image/x-icon' />"
  HTML$ + "</HEAD>"
  
  HTML$ + "<meta charset=\'UTF-8\'>"
  
  HTML$ + "<BODY>"
  ; -------------------------------------
  Speicher1.l=0: Speicher2.l=0
  ; -------------------------------------
  Textfeld$=GetGadgetText(VonGadget)
  Textfeldlange=Len(GetGadgetText(VonGadget))
  ; -------------------------------------
  ;:Formatieren=Formatieren+1
  Textfeld$ = ReplaceString(GetGadgetText(VonGadget),Linienschaltung$,ErsatzLinienschaltung$)
  ; -------------------------------------
  SendMessage_(GadgetID(VonGadget), #EM_SETSEL, 0, Len(GetGadgetText(VonGadget)))
  SendMessage_(GadgetID(VonGadget),#EM_GETSEL,@Speicher1,@Speicher2)
  ; -------------------------------------
  HtmlFettdr = 0: HtmlKursiv = 0: HtmlUnters = 0: HtmlStrike = 0: Html_LF = 0
  ; -------------------------------------
  For Formatieren = Speicher1 To Textfeldlange + 1
    Aktuellzeichen$ = Mid(Textfeld$, Formatieren + 1  , 1)
    If Aktuellzeichen$ = #LF$ Or Aktuellzeichen$=" "
      HTML$ + " "
    ElseIf Aktuellzeichen$ = #LFCR$
      HTML$ + "<BR>"
      Formatieren = Formatieren+1
    Else
      If Aktuellzeichen$ = #FF$ Or Aktuellzeichen$ = #CR$
        Debug "sonderzeichen"
        If Aktuellzeichen$ = #FF$
          HTML$ + "<HR>"
          Formatieren = Formatieren +1
        Else
          HTML$ + "<BR>"
        EndIf
      Else
        ; -------------------------------------
        Formatlesen(VonGadget,Formatieren)
        ; -------------------------------------
        Debug "zeichen"
        If Editorfettdr=0 And HtmlFettdr=1: HTML$ + "</B>": HtmlFettdr=0: EndIf
        If Editoritalic=0 And HtmlKursiv=1: HTML$ + "</I>": HtmlKursiv=0: EndIf
        If Editorunderl=0 And HtmlUnters=1: HTML$ + "</U>": HtmlUnters=0: EndIf
        If Editorstrike=0 And HtmlStrike=1: HTML$ + "</S>": HtmlStrike=0: EndIf
        ;Beginmodus
        If Editorfettdr=1 And HtmlFettdr=0: HTML$ + "<B>": HtmlFettdr=1: EndIf
        If Editoritalic=1 And HtmlKursiv=0: HTML$ + "<I>": HtmlKursiv=1: EndIf
        If Editorunderl=1 And HtmlUnters=0: HTML$ + "<U>": HtmlUnters=1: EndIf
        If Editorstrike=1 And HtmlStrike=0: HTML$ + "<S>": HtmlStrike=1: EndIf
        ; -------------------------------------
        HTML$ + Aktuellzeichen$:
        ; -------------------------------------
      EndIf
    EndIf
  Next
  If HtmlFettdr=1: HTML$ + "</B>": EndIf
  If HtmlKursiv=1: HTML$ + "</I>": EndIf
  If HtmlUnters=1: HTML$ + "</U>": EndIf
  If HtmlStrike=1: HTML$ + "</S>": EndIf
  HTML$ + "</BODY></HTML>"
  SetGadgetItemText(ZumGadget, #PB_Web_HtmlCode, HTML$)
  SetClipboardText(HTML$)
EndProcedure
  ; -------------------------------

Procedure Richtext_From_Callback(dwCookie, pbBuff, cb, pcb)
  If cb
    ;{ Liest einen String von der angegebenen Speicheradresse.
    Parser_RawRichText$ + PeekS(pbBuff, cb ,#PB_Ascii)
    ; Parser_RawRichText$ + PeekS(pbBuff, cb ,#PB_Unicode)
    ; Parser_RawRichText$ + PeekS(pbBuff, cb,#PB_UTF16 )
    ;}
  EndIf
  pcb = cb
EndProcedure
 Procedure.s GetGadget_TXToAscii(gad)
  Parser_RawRichText$=""
  
  Protected str.EDITSTREAM\dwCookie=0
  str\dwError=0
  str\pfnCallback = @Richtext_From_Callback()
  SendMessage_(GadgetID(gad),#EM_STREAMOUT,#SF_TEXT,@str)
  
  ProcedureReturn Parser_RawRichText$
EndProcedure
 ; -------------------------------
Procedure Open_Window_0()
  If OpenWindow(#Window_0, 683, 1, 670, 731, "Konvert RTF to HTML",  #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar )
    If CreateGadgetList(WindowID(#Window_0))
      ButtonGadget(#Button_Kursiv, 80, 10, 70, 30, "Kursiv")
      ButtonGadget(#Button_Fett, 10, 10, 70, 30, "Fett")
      ButtonGadget(#Button_Unterstrichen, 150, 10, 100, 30, "Unterstreichen")
      ButtonGadget(#Button_Durchgestrichen, 250, 10, 100, 30, "Durchstreichen")
      ButtonGadget(#Button_SetzeText, 570, 10, 100, 30, "Setze Text")
      ButtonGadget(#Button_ClearText, 470, 10, 100, 30, "Clear Text")
      Memo_E_Notiz = EditorGadget(#PB_Any, 10, 40, 650, 320)
      WebGadget(#HTML_Gadget, 10, 400, 650, 320, "")
      ButtonGadget(#Button_HTML_Konvert, 10, 370, 130, 20, "HTML Exportieren")
      StringGadget(#AnzeigeHTML,140, 370, 130, 20, "HTML Exportieren")
      StringGadget(#AnzeigePosition,340, 370, 130, 20, "HTML #AnzeigePosition")
    EndIf
  EndIf
EndProcedure
;
Open_Window_0()
; URLs werden automatisch als Links dargestellt
SetGadgetText(Memo_E_Notiz,Parser_NOTIZ$)
;SendMessage_(GadgetID(Memo_E_Notiz),#EM_AUTOURLDETECT,#True,0)
; Zeilenumbruch wird gesetzt
SendMessage_(GadgetID(Memo_E_Notiz), #EM_SETTARGETDEVICE, #Null, 0)
; SetGadgetFont
SetGadgetFont(Memo_E_Notiz,LoadFont(#RTF_Gadget_Notiz,"Tahoma",10))
;SendMessage_(GadgetID(#String_0), #EM_SETSEL, 2, 2)

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Ende = 1
      
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #Button_SetzeText
          SetzeVorlageText6()
        Case #Button_ClearText
          SendMessage_(GadgetID(Memo_E_Notiz) , #EM_STREAMOUT , #SF_RTF , 0)
        Case #Button_Fett: Formatsetzen(Memo_E_Notiz,#CFM_BOLD)
        Case #Button_Kursiv: Formatsetzen(Memo_E_Notiz,#CFM_ITALIC)
        Case #Button_Unterstrichen: Formatsetzen(Memo_E_Notiz,#CFM_UNDERLINE)
        Case #Button_Durchgestrichen: Formatsetzen(Memo_E_Notiz,#CFM_STRIKEOUT)
        Case #Button_HTML_Konvert
          PARSING_Konvert_Memo_HTML(Memo_E_Notiz,#HTML_Gadget)
          
          ; Parser_Puffer$ = GetGadget_TXToAscii(Memo_E_Notiz)
          ; SetGadgetItemText(#HTML_Gadget, #PB_Web_HtmlCode, Parser_Puffer$)
          
          
          
      EndSelect
  EndSelect
Until Ende=1
Jemand einen Tip?

Gruss ... Velindos!

Re: Parser Problem PB 6.00 LTS

Verfasst: 05.09.2022 15:54
von Kiffi
Es wäre für alle Beteiligten von Vorteil, wenn Du erwähnen würdest, was nicht mehr "funzt".

Re: Parser Problem PB 6.00 LTS

Verfasst: 05.09.2022 16:08
von Velindos
Hallo,
bei mir sehe ich gleich das die Sonderzeichen, Häckchen etc. nicht funzen!

Gruss ... Velindos!

Re: Parser Problem PB 6.00 LTS

Verfasst: 05.09.2022 20:50
von ccode_new
Hallo Velindos,

RTF-Text ist in der Handhabung mit UTF8/Unicode eine Katastrophe, weil es offiziell eigentlich gar kein Unicode unterstützt.
RTF ist ein Ascii Patchwork mit unterschiedlichen Codepages, die irgendwie Unicode-Unterstützung suggerieren sollen.

Du musst also deinen Test als "Ascii-Text" mit Angabe der festgelegten Codepage übergeben.

Code: Alles auswählen

; RTF To HTML im PB 5.73 ÖÜÄ
; ====================================================================
; Darstellen einer RTF-Textes im HTML-Format
;- >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
EnableExplicit
; >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Enumeration
  #Window_0
EndEnumeration
;- Gadget Constants
;
Enumeration
  #Button_Kursiv
  #Button_Fett
  #Button_Unterstrichen
  #Button_Durchgestrichen
  
  #HTML_Gadget
  #Button_HTML_Konvert
  #RTF_Gadget_Notiz
  #Button_SetzeText
  #Button_ClearText
  #AnzeigeHTML
  #AnzeigePosition
EndEnumeration
;

; *****************************************************************************
Global Parser_NOTIZ$ = ""
Parser_NOTIZ$ + "{\rtf1\ansi\ansicpg1252\deff0\deflang1031\deflangfe1031{\fonttbl{\f0\fswiss\fprq2\fcharset0 Verdana;}{\f1\fswiss\fprq2\fcharset0 Segoe WP SemiLight;}}"
Parser_NOTIZ$ + "{\colortbl ;\red0\green128\blue128;\red51\green51\blue51;}"
Parser_NOTIZ$ + "{\*\generator Msftedit 5.41.21.2510;}\viewkind4\uc1\pard\nowidctlpar\cf1\f0\fs20 So kennen wir den \'84Riverdale\ldblquote -Star gar nicht. \cf2\f1 (was so viel wie \'84Baumwollburg\ldblquote  bedeutet)\cf1\f0\par"
Parser_NOTIZ$ + "\cf1\ul\b\i\fs28 APPNAME é à ç è ê @ €   é à ç è ê Ö Ü Ä ö ü ä €  "
Parser_NOTIZ$ + "}"
; *****************************************************************************
Global Ende = 0
Global Parser_Puffer$ = ""
Global Parser_RawRichText$

Global Memo_E_Notiz
Global Formatieren
Global Editorstrike
Global Editorunderl
Global Editoritalic
Global Editorfettdr

;
Procedure Formatlesen(Gadget,Position)
  Protected preval.CHARFORMAT
  Protected Pretyp
  ; EditorGadget Format Zeichen für Zeichen auslesen
  SendMessage_(GadgetID(Gadget),#EM_SETSEL,Position,Position+1)
  SendMessage_(GadgetID(#AnzeigePosition),#EM_REPLACESEL,#WM_PASTE," ")
  SendMessage_(GadgetID(#AnzeigePosition),#EM_REPLACESEL,#WM_PASTE,Str(Formatieren))
  SendMessage_(GadgetID(Memo_E_Notiz), #WM_COPY, Position, Position+1)
  SetGadgetText(#AnzeigeHTML,"")
  SendMessage_(GadgetID(#AnzeigeHTML), #WM_PASTE, 0, 0)
  preval.CHARFORMAT
  preval\cbSize=SizeOf(CHARFORMAT)
  SendMessage_(GadgetID(Gadget),#EM_GETCHARFORMAT,#SCF_SELECTION,@preval)
  Pretyp=preval\dwEffects
  If Pretyp & #CFM_STRIKEOUT: Editorstrike=1: Else: Editorstrike=0: EndIf
  If Pretyp & #CFM_UNDERLINE: Editorunderl=1: Else: Editorunderl=0: EndIf
  If Pretyp & #CFM_ITALIC: Editoritalic=1: Else: Editoritalic=0: EndIf
  If Pretyp & #CFM_BOLD: Editorfettdr=1: Else: Editorfettdr=0: EndIf
EndProcedure
Procedure Formatsetzen(Gadget,Neuformat)
  ; EditorGadget formatieren mit Berücksichtigung bestehender Formate
  Protected Speicher1.l
  Protected Speicher2.l
  Protected Gesamtformat=0
  Protected format.CHARFORMAT
  
  Speicher1.l=0: Speicher2.l=0
  SendMessage_(GadgetID(Gadget),#EM_GETSEL,@Speicher1,@Speicher2)
  For Formatieren=Speicher1 To Speicher2 -1
    Formatlesen(Gadget,Formatieren): Gesamtformat=0
    If Neuformat=#CFM_BOLD And Editorfettdr=0: Gesamtformat=Gesamtformat|#CFM_BOLD: EndIf
    If Neuformat<>#CFM_BOLD And Editorfettdr=1: Gesamtformat=Gesamtformat|#CFM_BOLD: EndIf
    If Neuformat=#CFM_ITALIC And Editoritalic=0: Gesamtformat=Gesamtformat|#CFM_ITALIC: EndIf
    If Neuformat<>#CFM_ITALIC And Editoritalic=1: Gesamtformat=Gesamtformat|#CFM_ITALIC: EndIf
    If Neuformat=#CFM_UNDERLINE And Editorunderl=0: Gesamtformat=Gesamtformat|#CFM_UNDERLINE: EndIf
    If Neuformat<>#CFM_UNDERLINE And Editorunderl=1: Gesamtformat=Gesamtformat|#CFM_UNDERLINE: EndIf
    If Neuformat=#CFM_STRIKEOUT And Editorstrike=0: Gesamtformat=Gesamtformat|#CFM_STRIKEOUT: EndIf
    If Neuformat<>#CFM_STRIKEOUT And Editorstrike=1: Gesamtformat=Gesamtformat|#CFM_STRIKEOUT: EndIf
    format.CHARFORMAT
    format\cbSize=SizeOf(CHARFORMAT)
    format\dwMask=#CFM_ITALIC|#CFM_BOLD|#CFM_STRIKEOUT|#CFM_UNDERLINE
    format\dwEffects=Gesamtformat
    SendMessage_(GadgetID(Gadget),#EM_SETCHARFORMAT,#SCF_SELECTION,@format)
  Next
  SendMessage_(GadgetID(Gadget),#EM_SETSEL,Speicher1,Speicher2)
EndProcedure
Procedure SetzeVorlageText6()
  SendMessage_(GadgetID(Memo_E_Notiz),#EM_REPLACESEL,#WM_PASTE,Parser_NOTIZ$)
EndProcedure
  ; -------------------------------
Procedure PARSING_Konvert_Memo_HTML(VonGadget,ZumGadget)
  ; -------------------------------------
  Protected HTML$ =""
  Protected Ergebnis
  Protected Linienschaltung$
  Protected Linienschaltunglaenge
  Protected ErsatzLinienschaltung$
  
  Protected Speicher1.l=0
  Protected Speicher2.l=0
  
  Protected Textfeld$
  Protected Textfeldlange
  
  Protected Formatieren
  Protected Aktuellzeichen$
  
  Protected HtmlFettdr = 0
  Protected HtmlKursiv = 0
  Protected HtmlUnters = 0
  Protected HtmlStrike = 0
  Protected Html_LF = 0

  ; -------------------------------------
  Ergebnis = CountGadgetItems(VonGadget)
  Debug "Zeilenanzahl = " +Str(Ergebnis)
  ; -------------------------------------
  Linienschaltung$ = "-------------------------------------------------------------------------------------------------------------------------------"
  Linienschaltunglaenge= Len(Linienschaltung$)
  ErsatzLinienschaltung$ = "<HR>"
  ; -------------------------------------
  HTML$ + "<HTML>"
  
  HTML$ + "<HEAD>"
;   HTML$ + "<TITLE>" + GetGadgetText(Memo_S_Stichwort) + "</TITLE>"
;   HTML$ + "<link href='Data:image/x-icon;base64,"+Base64_Encode_FotoIcon(#Parser_FavIcon)+"  'rel='icon' type='image/x-icon' />"
  
  HTML$ + "<meta charset='UTF-8'>"
  
  HTML$ + "</HEAD>"
  
  HTML$ + "<BODY>"
  ; -------------------------------------
  Speicher1.l=0: Speicher2.l=0
  ; -------------------------------------
  Textfeld$=GetGadgetText(VonGadget)
  Textfeldlange=Len(GetGadgetText(VonGadget))
  ; -------------------------------------
  ;:Formatieren=Formatieren+1
  Textfeld$ = ReplaceString(GetGadgetText(VonGadget),Linienschaltung$,ErsatzLinienschaltung$)
  ; -------------------------------------
  SendMessage_(GadgetID(VonGadget), #EM_SETSEL, 0, Len(GetGadgetText(VonGadget)))
  SendMessage_(GadgetID(VonGadget),#EM_GETSEL,@Speicher1,@Speicher2)
  ; -------------------------------------
  HtmlFettdr = 0: HtmlKursiv = 0: HtmlUnters = 0: HtmlStrike = 0: Html_LF = 0
  ; -------------------------------------
  For Formatieren = Speicher1 To Textfeldlange + 1
    Aktuellzeichen$ = Mid(Textfeld$, Formatieren + 1  , 1)
    If Aktuellzeichen$ = #LF$ Or Aktuellzeichen$=" "
      HTML$ + " "
    ElseIf Aktuellzeichen$ = #LFCR$
      HTML$ + "<BR>"
      Formatieren = Formatieren+1
    Else
      If Aktuellzeichen$ = #FF$ Or Aktuellzeichen$ = #CR$
        Debug "sonderzeichen"
        If Aktuellzeichen$ = #FF$
          HTML$ + "<HR>"
          Formatieren = Formatieren +1
        Else
          HTML$ + "<BR>"
        EndIf
      Else
        ; -------------------------------------
        Formatlesen(VonGadget,Formatieren)
        ; -------------------------------------
        Debug "zeichen"
        If Editorfettdr=0 And HtmlFettdr=1: HTML$ + "</B>": HtmlFettdr=0: EndIf
        If Editoritalic=0 And HtmlKursiv=1: HTML$ + "</I>": HtmlKursiv=0: EndIf
        If Editorunderl=0 And HtmlUnters=1: HTML$ + "</U>": HtmlUnters=0: EndIf
        If Editorstrike=0 And HtmlStrike=1: HTML$ + "</S>": HtmlStrike=0: EndIf
        ;Beginmodus
        If Editorfettdr=1 And HtmlFettdr=0: HTML$ + "<B>": HtmlFettdr=1: EndIf
        If Editoritalic=1 And HtmlKursiv=0: HTML$ + "<I>": HtmlKursiv=1: EndIf
        If Editorunderl=1 And HtmlUnters=0: HTML$ + "<U>": HtmlUnters=1: EndIf
        If Editorstrike=1 And HtmlStrike=0: HTML$ + "<S>": HtmlStrike=1: EndIf
        ; -------------------------------------
        HTML$ + Aktuellzeichen$:
        ; -------------------------------------
      EndIf
    EndIf
  Next
  If HtmlFettdr=1: HTML$ + "</B>": EndIf
  If HtmlKursiv=1: HTML$ + "</I>": EndIf
  If HtmlUnters=1: HTML$ + "</U>": EndIf
  If HtmlStrike=1: HTML$ + "</S>": EndIf
  HTML$ + "</BODY></HTML>"
  SetGadgetItemText(ZumGadget, #PB_Web_HtmlCode, HTML$)
  SetClipboardText(HTML$)
EndProcedure
  ; -------------------------------

Procedure Richtext_From_Callback(dwCookie, pbBuff, cb, pcb)
  If cb
    ;{ Liest einen String von der angegebenen Speicheradresse.
    Parser_RawRichText$ + PeekS(pbBuff, cb ,#PB_Ascii)
    ; Parser_RawRichText$ + PeekS(pbBuff, cb ,#PB_Unicode)
    ; Parser_RawRichText$ + PeekS(pbBuff, cb,#PB_UTF16 )
    ;}
  EndIf
  pcb = cb
EndProcedure
 Procedure.s GetGadget_TXToAscii(gad)
  Parser_RawRichText$=""
  
  Protected str.EDITSTREAM\dwCookie=0
  str\dwError=0
  str\pfnCallback = @Richtext_From_Callback()
  SendMessage_(GadgetID(gad),#EM_STREAMOUT,#SF_TEXT,@str)
  
  ProcedureReturn Parser_RawRichText$
EndProcedure
 ; -------------------------------
Procedure Open_Window_0()
  If OpenWindow(#Window_0, 683, 1, 670, 731, "Konvert RTF to HTML",  #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar )
    If CreateGadgetList(WindowID(#Window_0))
      ButtonGadget(#Button_Kursiv, 80, 10, 70, 30, "Kursiv")
      ButtonGadget(#Button_Fett, 10, 10, 70, 30, "Fett")
      ButtonGadget(#Button_Unterstrichen, 150, 10, 100, 30, "Unterstreichen")
      ButtonGadget(#Button_Durchgestrichen, 250, 10, 100, 30, "Durchstreichen")
      ButtonGadget(#Button_SetzeText, 570, 10, 100, 30, "Setze Text")
      ButtonGadget(#Button_ClearText, 470, 10, 100, 30, "Clear Text")
      Memo_E_Notiz = EditorGadget(#PB_Any, 10, 40, 650, 320)
      WebGadget(#HTML_Gadget, 10, 400, 650, 320, "")
      ButtonGadget(#Button_HTML_Konvert, 10, 370, 130, 20, "HTML Exportieren")
      StringGadget(#AnzeigeHTML,140, 370, 130, 20, "HTML Exportieren")
      StringGadget(#AnzeigePosition,340, 370, 130, 20, "HTML #AnzeigePosition")
    EndIf
  EndIf
EndProcedure
;
Open_Window_0()
; URLs werden automatisch als Links dargestellt

;SetGadgetText(Memo_E_Notiz,Parser_NOTIZ$)

Define.SETTEXTEX st
st\codepage=1252
SendMessage_(GadgetID(Memo_E_Notiz), #EM_SETTEXTEX, @st, Ascii(Parser_NOTIZ$))

;SendMessage_(GadgetID(Memo_E_Notiz),#EM_AUTOURLDETECT,#True,0)
; Zeilenumbruch wird gesetzt
SendMessage_(GadgetID(Memo_E_Notiz), #EM_SETTARGETDEVICE, #Null, 0)
; SetGadgetFont
SetGadgetFont(Memo_E_Notiz,LoadFont(#RTF_Gadget_Notiz,"Tahoma",10))
;SendMessage_(GadgetID(#String_0), #EM_SETSEL, 2, 2)

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Ende = 1
      
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #Button_SetzeText
          SetzeVorlageText6()
        Case #Button_ClearText
          SendMessage_(GadgetID(Memo_E_Notiz) , #EM_STREAMOUT , #SF_RTF , 0)
        Case #Button_Fett: Formatsetzen(Memo_E_Notiz,#CFM_BOLD)
        Case #Button_Kursiv: Formatsetzen(Memo_E_Notiz,#CFM_ITALIC)
        Case #Button_Unterstrichen: Formatsetzen(Memo_E_Notiz,#CFM_UNDERLINE)
        Case #Button_Durchgestrichen: Formatsetzen(Memo_E_Notiz,#CFM_STRIKEOUT)
        Case #Button_HTML_Konvert
          PARSING_Konvert_Memo_HTML(Memo_E_Notiz,#HTML_Gadget)
          
          ; Parser_Puffer$ = GetGadget_TXToAscii(Memo_E_Notiz)
          ; SetGadgetItemText(#HTML_Gadget, #PB_Web_HtmlCode, Parser_Puffer$)
          
          
          
      EndSelect
  EndSelect
Until Ende=1
Schaue hier:

Code: Alles auswählen

Open_Window_0()
; URLs werden automatisch als Links dargestellt

;SetGadgetText(Memo_E_Notiz,Parser_NOTIZ$)

Define.SETTEXTEX st
st\codepage=1252
SendMessage_(GadgetID(Memo_E_Notiz), #EM_SETTEXTEX, @st, Ascii(Parser_NOTIZ$))
Außerdem gehört </HEAD> nach der Zeichensatzfestlegung eingefügt.

Code: Alles auswählen

 HTML$ + "<meta charset='UTF-8'>"
 HTML$ + "</HEAD>"
Anbei:
rtf

Re: Parser Problem PB 6.00 LTS

Verfasst: 06.09.2022 11:41
von Velindos
Hallo ccode_new

Danke für die ausführliche Beschreibung!

Gruss ... Velindos!
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de