PureBoard

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

RTF to HTML

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

Seite 1 von 1

RTF to HTML

Verfasst: 09.04.2012 16:03
von Velindos
Hallo Leute,
hab mir aus dem Forum ein Beispiel zusammengestellt für den Transfer des Textes aus dem Editorgadget ins HTML. Habe aber ein Probleme mit den weiteren Funktionen, wie dem Font, ColorFont, Fontisize etc. Bis dato funktioineren nur Bold, Italic, Underline und Strikeout.

Code: Alles auswählen

EnableExplicit

;- Constanten
Enumeration
  #FrameMain
  #myFragezeichen
  #StatusBar_1
  #Velindoslink
  #Container_00
  #Container_01
  #Container_99
  #Container_Button_00
  #Container_Button_01
  #Container_Button_99
  #Editor_Gadget
  #Editor_StyleF
  #Editor_StyleY
  #Editor_StyleB
  #Editor_StyleS
  #Editor_StyleI
  #Editor_StyleU
  #Editor_HTML
  #Editor_StyleFC
  #Editor_StyleBC
  #Editor_Number
  #Editor_AlignR
  #Editor_AlignC
  #Editor_AlignL
  #Editor_Menu
  #Editor_MenuNew
  #Editor_MenuOpen
  #Editor_MenuSave
  #Editor_MenuQuit
  #Editor_ImageFC
  #Editor_ImageBC
  #Web_Notiz
#CFM_LINK  = $20

EndEnumeration

#CFM_BACKCOLOR    = $4000000
#SF_USECODEPAGE   = $20
#CP_UTF8      = 65001

Global MyFrageZeichen=CatchImage(#myFragezeichen,?Fragezeichen)

Global WindowsHeadText$="RTF to HTML Sheet"
Global HtmlExporter$="D:\HTML_Test.html"
Global RF=100; Zeiger für CSV Dateien CF
Global CF=100; Zeiger für CSV Dateien 
Global Speicher1.l = 0
Global Speicher2.l = 0
Global Formatieren
Global Gesamtformat
Global Editorstrike
Global Editorunderl
Global Editoritalic
Global Editorfettdr
Global EditorFont            ;=> #CFM_FACE
Global EditorSize            ;=> Size =>#CFM_CHARSET 
Global EditorColor           ;=> #CFM_COLOR
Global EditorBackColor           ;=> #CFM_COLOR
Global HtmlFettdr=0: 
Global HtmlKursiv=0: 
Global HtmlUnters=0: 
Global HtmlStrike=0
Global HtmlCharFont=0
Global HtmlCharSize=0
Global HtmlCharColor=0
Global HtmlCharBackColor=0
Global Zeilenschaltung$
Global Erweitertezeile$
Global Textfeld$
Global Aktuellzeichen$
Global Letzteszeichen$
Global Anzeige_HTML$

Global Editor_FileName$ = ""
Global Editor_Pattern$ = "RTF (*.rtf)|*.rtf|Text (*.txt)|*.txt|Unicode (*.txt)|*.txt|UTF8 (*.utf8)|*.utf8"

CreateImage(#Editor_ImageFC,12,12)
CreateImage(#Editor_ImageBC,12,12)


Procedure Editor_EnumFontProc(*lpelfe.LOGFONT , *lpntme.TEXTMETRIC , fontType , lParam)
  AddGadgetItem(#Editor_StyleF , -1 , PeekS(@*lpelfe\lfFaceName))
  ProcedureReturn 1
EndProcedure

Procedure Editor_StreamOutCallback(dwCookie , *pbBuff , cb , *pcb.Long)
  *pcb\l = WriteData(dwCookie , *pbBuff , cb)
  ProcedureReturn (Not *pcb\l)
EndProcedure

Procedure Editor_StreamInCallback(dwCookie , *pbBuff.l , cb , *pcb.Long)
  *pcb\l = ReadData(dwCookie , *pbBuff , cb)
  ProcedureReturn (Not *pcb\l)
EndProcedure

Procedure Editor_UpdateGadgets(editor)
  Protected cf.CHARFORMAT2
  Protected pf.PARAFORMAT2
  Protected fName$ , i
  
  cf\cbSize   = SizeOf(CHARFORMAT2)
  SendMessage_(GadgetID(editor) , #EM_GETCHARFORMAT , #SCF_SELECTION , cf)
  
  pf\cbSize   = SizeOf(PARAFORMAT2)
  SendMessage_(GadgetID(editor) , #EM_GETPARAFORMAT , 0 , pf)   
  
  If cf\dwMask   & #CFM_SIZE
    SetGadgetText(#Editor_StyleY , Str(cf\yHeight * 0.05))
  EndIf   
  If cf\dwMask   & #CFM_FACE
    fName$ = PeekS(@cf\szFaceName , 32)
    For i = 0 To CountGadgetItems(#Editor_StyleF) - 1
      If GetGadgetItemText(#Editor_StyleF , i) = fName$
        SetGadgetState(#Editor_StyleF , i)
        Debug #Editor_StyleF
        Break
      EndIf
    Next
  EndIf   
  If cf\dwEffects & #CFE_BOLD
    SetGadgetState(#Editor_StyleB , 1)
  Else
    SetGadgetState(#Editor_StyleB , 0)
  EndIf
  If cf\dwEffects & #CFE_ITALIC
    SetGadgetState(#Editor_StyleI , 1)
  Else
    SetGadgetState(#Editor_StyleI , 0)
  EndIf
  If cf\dwEffects & #CFE_UNDERLINE
    SetGadgetState(#Editor_StyleU , 1)
  Else
    SetGadgetState(#Editor_StyleU , 0)
  EndIf   
    If cf\dwEffects & #CFE_STRIKEOUT
    SetGadgetState(#Editor_StyleS , 1)
  Else
    SetGadgetState(#Editor_StyleS , 0)
  EndIf   

  
  If cf\crTextColor <> -1
    StartDrawing(ImageOutput(#Editor_ImageFC))
    Box(0,0,ImageWidth(#Editor_ImageFC),ImageHeight(#Editor_ImageFC), cf\crTextColor)
    StopDrawing()
    SetGadgetAttribute(#Editor_StyleFC , #PB_Button_Image , ImageID(#Editor_ImageFC))
  EndIf
  If cf\crBackColor <> -1
    StartDrawing(ImageOutput(#Editor_ImageBC))
    Box(0,0,ImageWidth(#Editor_ImageBC),ImageHeight(#Editor_ImageBC), cf\crBackColor)
    StopDrawing()
    SetGadgetAttribute(#Editor_StyleBC , #PB_Button_Image , ImageID(#Editor_ImageBC))
  EndIf
  If pf\dwMask & #PFM_ALIGNMENT
    SetGadgetState(#Editor_AlignR , 0)
    SetGadgetState(#Editor_AlignC , 0)
    SetGadgetState(#Editor_AlignL , 0)   
    Select pf\wAlignment
      Case #PFA_LEFT      : SetGadgetState(#Editor_AlignL , 1)
      Case #PFA_CENTER   : SetGadgetState(#Editor_AlignC , 1)
      Case #PFA_RIGHT      : SetGadgetState(#Editor_AlignR , 1)
    EndSelect
  EndIf
  If pf\dwMask & #PFM_NUMBERING
    Select pf\wNumbering
      Case 0            : SetGadgetState(#Editor_Number , 0)           
      Default         : SetGadgetState(#Editor_Number , 1)
        
    EndSelect
  EndIf   
  SetActiveGadget(editor)
EndProcedure

Procedure Editor_SetFontName(editor , fontName$)
  Protected cf.CHARFORMAT2
  If fontName$ <> ""
    cf\cbSize      = SizeOf(CHARFORMAT2)               
    cf\dwMask      = #CFM_FACE
    PokeS(@cf\szFaceName   , fontName$ , 32)
    SendMessage_(GadgetID(editor) , #EM_SETCHARFORMAT , #SCF_SELECTION , cf)
    Editor_UpdateGadgets(editor)
  EndIf
EndProcedure

Procedure Editor_SetFontHeight(editor , fontSize)   
  Protected cf.CHARFORMAT2
  If fontSize > 0
    cf\cbSize      = SizeOf(CHARFORMAT2)               
    cf\dwMask      = #CFM_SIZE
    cf\yHeight      = fontSize * 20.0
    SendMessage_(GadgetID(editor) , #EM_SETCHARFORMAT , #SCF_SELECTION , cf)
    Editor_UpdateGadgets(editor)
  EndIf   
EndProcedure

Procedure Editor_SetFontColor(editor , fontColor)
  Protected cf.CHARFORMAT2
  If fontColor <> -1     
    cf\cbSize      = SizeOf(CHARFORMAT2)               
    cf\dwMask      = #CFM_COLOR
    cf\crTextColor   = fontColor
    SendMessage_(GadgetID(editor) , #EM_SETCHARFORMAT , #SCF_SELECTION , cf)     
    Editor_UpdateGadgets(editor)
  EndIf
EndProcedure

Procedure Editor_SetBackColor(editor , backColor)
  Protected cf.CHARFORMAT2
  If backColor <> -1     
    cf\cbSize      = SizeOf(CHARFORMAT2)               
    cf\dwMask      = #CFM_BACKCOLOR
    cf\crBackColor   = backColor
    SendMessage_(GadgetID(editor) , #EM_SETCHARFORMAT , #SCF_SELECTION , cf)     
    Editor_UpdateGadgets(editor)
  EndIf
EndProcedure

Procedure Editor_SetFontStyle(editor , mask)
  Protected cf.CHARFORMAT2
  cf\cbSize         = SizeOf(CHARFORMAT2)               
  cf\dwMask         = mask
  cf\dwEffects      = 0
  If GetGadgetState(#Editor_StyleB)
    cf\dwEffects   | #CFE_BOLD
  EndIf
  If GetGadgetState(#Editor_StyleI)
    cf\dwEffects   | #CFE_ITALIC
  EndIf
  If GetGadgetState(#Editor_StyleU)
    cf\dwEffects   | #CFE_UNDERLINE
  EndIf
  If GetGadgetState(#Editor_StyleS)
    cf\dwEffects   | #CFE_STRIKEOUT
  EndIf
  
  SendMessage_(GadgetID(editor) , #EM_SETCHARFORMAT , #SCF_SELECTION , cf)               
  Editor_UpdateGadgets(editor)
EndProcedure

Procedure Editor_SetAlignment(editor , alignment)
  Protected pf.PARAFORMAT2
  pf\cbSize         = SizeOf(PARAFORMAT2)               
  pf\dwMask         = #PFM_ALIGNMENT
  pf\wAlignment      = alignment
  SendMessage_(GadgetID(editor) , #EM_SETPARAFORMAT , 0 , pf)
  Editor_UpdateGadgets(editor)
EndProcedure

Procedure Editor_SetNumbering(editor , format)
  Protected pf.PARAFORMAT2
  pf\cbSize         = SizeOf(PARAFORMAT2)               
  pf\dwMask         = #PFM_NUMBERING | #PFM_NUMBERINGTAB
  pf\wNumbering      = format
  pf\wNumberingTab   = 500
  SendMessage_(GadgetID(editor) , #EM_SETPARAFORMAT , 0 , pf)
  Editor_UpdateGadgets(editor)
EndProcedure

Procedure Editor_Quit()
  End   
EndProcedure

Procedure Editor_Callback(hwnd , msg , wparam , lparam)
  Protected *nmhdr.NMHDR   
  If msg = #WM_NOTIFY
    *nmhdr = lparam
    If *nmhdr\code = #EN_SELCHANGE
      Editor_UpdateGadgets(*nmhdr\idFrom)
    EndIf      
  EndIf   
  ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

Procedure Editor_Initialize(editor , fontName$ = "Arial" , fontHeight = 10 , fontStyle = 0 , fontColor = #Black , backColor = #White)
  Protected lf.LOGFONT , y
  
  ClearGadgetItems(editor)
  ClearGadgetItems(#Editor_StyleF)
  ClearGadgetItems(#Editor_StyleY)
  
  EnumFontFamiliesEx_(GetDC_(GadgetID(editor)) , lf , @Editor_EnumFontProc() , 0 , 0)
  
  For y = 1 To 100
    AddGadgetItem(#Editor_StyleY , -1 , Str(y))
  Next   
  
  If fontStyle & #CFM_BOLD
    SetGadgetState(#Editor_StyleB , 1)
  Else
    SetGadgetState(#Editor_StyleB , 0)
  EndIf   
  If fontStyle & #CFM_ITALIC
    SetGadgetState(#Editor_StyleI , 1)
  Else
    SetGadgetState(#Editor_StyleI , 0)
  EndIf   
  If fontStyle & #CFM_UNDERLINE
    SetGadgetState(#Editor_StyleU , 1)
  Else
    SetGadgetState(#Editor_StyleU , 0)
  EndIf   
    If fontStyle & #CFM_STRIKEOUT
    SetGadgetState(#Editor_StyleS , 1)
  Else
    SetGadgetState(#Editor_StyleS , 0)
  EndIf   

  Editor_SetFontStyle   (editor , fontStyle)   
  Editor_SetFontName   (editor , fontName$)
  Editor_SetFontHeight(editor , fontHeight)
  Editor_SetFontColor   (editor , fontColor)
  Editor_SetBackColor   (editor , backColor)
  
  SendMessage_(GadgetID(editor) , #EM_SETEVENTMASK , 0 , #ENM_SELCHANGE)
  SetWindowCallback(@Editor_Callback())
EndProcedure

Procedure Editor_Open(editor , fileName$)
  Protected es.EDITSTREAM , file
  file = ReadFile(#PB_Any , fileName$)
  If IsFile(file)
    Editor_Initialize(editor)
    es\pfnCallback   = @Editor_StreamInCallback()
    es\dwCookie      = file
    Select SelectedFilePattern()
      Case 0 : SendMessage_(GadgetID(editor) , #EM_STREAMIN , #SF_RTF , es)
      Case 1 : SendMessage_(GadgetID(editor) , #EM_STREAMIN , #SF_TEXT , es)
      Case 2 : SendMessage_(GadgetID(editor) , #EM_STREAMIN , #SF_UNICODE | #SF_TEXT , es)
      Case 3 : SendMessage_(GadgetID(editor) , #EM_STREAMIN , (#CP_UTF8 << 16) | #SF_USECODEPAGE | #SF_TEXT , es)            
    EndSelect      
    CloseFile(file)
    Editor_FileName$ = fileName$
  EndIf
EndProcedure

Procedure Editor_Save(editor , fileName$)
  Protected es.EDITSTREAM , file
  file = CreateFile(#PB_Any , fileName$)
  If IsFile(file)      
    es\pfnCallback   = @Editor_StreamOutCallback()
    es\dwCookie      = file      
    Select SelectedFilePattern()
      Case 0 : SendMessage_(GadgetID(editor) , #EM_STREAMOUT , #SF_RTF , es)
      Case 1 : SendMessage_(GadgetID(editor) , #EM_STREAMOUT , #SF_TEXT , es)
      Case 2 : SendMessage_(GadgetID(editor) , #EM_STREAMOUT , #SF_UNICODE | #SF_TEXT , es)
      Case 3 : SendMessage_(GadgetID(editor) , #EM_STREAMOUT , (#CP_UTF8 << 16) | #SF_USECODEPAGE | #SF_TEXT , es)            
    EndSelect      
    CloseFile(file)
    Editor_FileName$ = fileName$
  EndIf
EndProcedure
; EditorGadget Format Zeichen für Zeichen auslesen
Procedure Formatlesen(Gadget,Position)
  Protected preval.CHARFORMAT, Pretyp
  SendMessage_(GadgetID(Gadget),#EM_SETSEL,Position,Position+1)
  
  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
  If Pretyp & #CFM_FACE: EditorFont=1: Else: EditorFont=0: EndIf
  If Pretyp & #CFM_SIZE: EditorSize=1: Else: EditorSize=0: EndIf
  If Pretyp & #CFM_COLOR: EditorColor=1: Else: EditorColor=0: EndIf
  If Pretyp & #CFM_BACKCOLOR: EditorBackColor=1: Else: EditorBackColor=0: EndIf
EndProcedure




; EditorGadget formatieren mit Berücksichtigung bestehender Formate
Procedure Formatsetzen(Gadget,Neuformat)
  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
    
    If Neuformat=#CFM_FACE And EditorFont=0: Gesamtformat=Gesamtformat|#CFM_FACE: EndIf
    If Neuformat<>#CFM_FACE And EditorFont=1: Gesamtformat=Gesamtformat|#CFM_FACE: EndIf
    
    If Neuformat=#CFM_SIZE And EditorSize=0: Gesamtformat=Gesamtformat|#CFM_SIZE: EndIf
    If Neuformat<>#CFM_SIZE And EditorSize=1: Gesamtformat=Gesamtformat|#CFM_SIZE: EndIf
    
    If Neuformat=#CFM_COLOR And EditorColor=0: Gesamtformat=Gesamtformat|#CFM_COLOR: EndIf
    If Neuformat<>#CFM_COLOR And EditorColor=1: Gesamtformat=Gesamtformat|#CFM_COLOR: EndIf
    
    If Neuformat=#CFM_BACKCOLOR And EditorBackColor=0: Gesamtformat=Gesamtformat|#CFM_BACKCOLOR: EndIf
    If Neuformat<>#CFM_BACKCOLOR And EditorBackColor=1: Gesamtformat=Gesamtformat|#CFM_BACKCOLOR: EndIf
    

    
    format\cbSize=SizeOf(CHARFORMAT)
    format\dwMask = #CFM_FACE|#CFM_COLOR|#CFM_SIZE|#CFM_ITALIC|#CFM_BOLD|#CFM_STRIKEOUT|#CFM_UNDERLINE|#CFM_LINK
    format\dwEffects=Gesamtformat
    SendMessage_(GadgetID(Gadget),#EM_SETCHARFORMAT,#SCF_SELECTION,@format)
  Next
  SendMessage_(GadgetID(Gadget),#EM_SETSEL,Speicher1,Speicher2)
EndProcedure

Procedure CharFormat(Gadget,FName$,FSize,FColor,FFlags)
  Protected format.CHARFORMAT
  format\cbSize = SizeOf(CHARFORMAT)
  format\dwMask = #CFM_FACE|#CFM_COLOR|#CFM_SIZE|#CFM_ITALIC|#CFM_BOLD|#CFM_STRIKEOUT|#CFM_UNDERLINE|#CFM_LINK
  PokeS(@format\szFaceName, FName$)
  format\yHeight = FSize*1440/72
  format\crTextColor = FColor
  format\dwEffects = FFlags
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format) 
EndProcedure



Procedure ShowContainer(index)
  Protected i
  
  For i =  #Container_00 To #Container_01
    HideGadget(i, #True)
    
  Next
  HideGadget(index, #False)
  Debug "Container= " + Str(index)
  
EndProcedure


Procedure MainWindow()
  
  ;*************** C O T A I N E R -  W I N D O W S
  OpenWindow(#FrameMain, 683, 0,667, 730,WindowsHeadText$, #PB_Window_SystemMenu |#PB_Window_SizeGadget|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget | #PB_Window_Invisible)
  If CreateStatusBar(#StatusBar_1, WindowID(#FrameMain))
    HyperLinkGadget(#Velindoslink, 25, 5, 140, StatusBarHeight(#StatusBar_1), "www.purebasic.com", RGB(255,0,0), #PB_HyperLink_Underline)
    AddStatusBarField(667)
  EndIf
  
  ;-[00]Master
  ;*************** F R A M E  M A S T E R
  ContainerGadget(#Container_00, 0, 0, 667, 706)
  ButtonGadget(#Container_Button_00, 0, 0, 667, 30, "M A S T E R")
  
  ComboBoxGadget      (#Editor_StyleF   ,  5, 35, 140, 20)
  ComboBoxGadget      (#Editor_StyleY   ,155,  35, 50, 20)
  ButtonGadget      (#Editor_StyleB   ,215,  35, 20, 20 , "B"   ,#PB_Button_Toggle)
  ButtonGadget      (#Editor_StyleI   ,240,  35, 20, 20 , "I"   ,#PB_Button_Toggle)
  ButtonGadget      (#Editor_StyleU   ,265,  35, 20, 20 , "U"   ,#PB_Button_Toggle)
  ButtonGadget      (#Editor_StyleS   ,290,  35, 20, 20 , "S"   ,#PB_Button_Toggle)
  ButtonGadget      (#Editor_AlignL   ,335,  35, 20, 20 , "<"   ,#PB_Button_Toggle)
  ButtonGadget      (#Editor_AlignC   ,360,  35, 20, 20 , "-"   ,#PB_Button_Toggle)
  ButtonGadget      (#Editor_AlignR   ,385,  35, 20, 20 , ">"   ,#PB_Button_Toggle)
  ButtonGadget      (#Editor_Number   ,410,  35, 20, 20 , "o"   ,#PB_Button_Toggle)
  ButtonGadget(#Editor_HTML,485,  35, 20, 20,"H")
  ButtonImageGadget   (#Editor_StyleFC  ,435,  35, 20, 20 , ImageID(#Editor_ImageFC))
  ButtonImageGadget   (#Editor_StyleBC  ,455,  35, 20, 20 , ImageID(#Editor_ImageBC))
  EditorGadget      (#Editor_Gadget, 5, 65, 490, 445)
  
  StatusBarText(#StatusBar_1,0,"MASTER ",#PB_StatusBar_Right|  #PB_StatusBar_BorderLess )
  CloseGadgetList()
  
  ;-[01]Notiz
  ;***************  F R A M E   W O R K
  ContainerGadget(#Container_01, 0, 0, 667, 706)
  ButtonGadget(#Container_Button_01, 0, 0, 667, 30, " W O R K")
  
  WebGadget(#Web_Notiz,10,65,WindowWidth(#FrameMain)-20,WindowHeight(#FrameMain)-55,"")
  
  StatusBarText(#StatusBar_1,0,"EDIT ",#PB_StatusBar_Right|  #PB_StatusBar_BorderLess )
  CloseGadgetList()
  
  ;-[99]MyFrageZeichen
  ;*************** C O N T A N E R  -   B U T T O N
  ContainerGadget(#Container_99, 3, 3, 16, 16)
  ButtonImageGadget(#Container_Button_99, 0, 0, 16, 16, MyFrageZeichen)
  GadgetToolTip(#Container_Button_99, "Velindos Version & Lizenz & Laufzeit")
  CloseGadgetList()
  
EndProcedure




;- Windows Start
MainWindow()
HideWindow(#FrameMain, #False)
ShowContainer(#Container_00)
SetParent_(GadgetID(#Velindoslink), StatusBarID(#StatusBar_1))
SetParent_(GadgetID(#Container_99), StatusBarID(#StatusBar_1))
SetGadgetFont(#Editor_Gadget,LoadFont(#Editor_Gadget,"Tahoma",10))
; URLs werden automatisch als Links dargestellt
SendMessage_(GadgetID(#Editor_Gadget),#EM_AUTOURLDETECT,#True,0)
SendMessage_(GadgetID(#Editor_Gadget), #EM_SETTARGETDEVICE, #Null, 0)

Editor_Initialize(#Editor_Gadget)
SetGadgetItemText(#Editor_Gadget,0,"Bis jetzt funktioniert BOLD, ITALIC, Underline, STRIKEOUT! bei der HTML übernahme!")

Repeat   
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow         
      Editor_Quit()
    Case #PB_Event_SizeWindow
      ResizeGadget(#Editor_Gadget , #PB_Ignore,#PB_Ignore , WindowWidth(#FrameMain) - 10 , WindowHeight(#FrameMain) - 55)
    Case #PB_Event_Gadget         
      Select EventGadget()
        Case #Editor_StyleF
          Editor_SetFontName(#Editor_Gadget , GetGadgetText(#Editor_StyleF))
        Case #Editor_StyleY               
          Editor_SetFontHeight(#Editor_Gadget , Val(GetGadgetText(#Editor_StyleY)))
        Case #Editor_StyleB
          Editor_SetFontStyle(#Editor_Gadget , #CFM_BOLD)
        Case #Editor_StyleI
          Editor_SetFontStyle(#Editor_Gadget , #CFM_ITALIC)
        Case #Editor_StyleU
          Editor_SetFontStyle(#Editor_Gadget , #CFM_UNDERLINE)
        Case #Editor_StyleS
          Editor_SetFontStyle(#Editor_Gadget , #CFM_STRIKEOUT)
        Case #Editor_StyleFC
          Editor_SetFontColor(#Editor_Gadget , ColorRequester())
        Case #Editor_StyleBC
          Editor_SetBackColor(#Editor_Gadget , ColorRequester()) 
        Case #Editor_Number
          Editor_SetNumbering(#Editor_Gadget , GetGadgetState(#Editor_Number))
        Case #Editor_AlignL
          Editor_SetAlignment(#Editor_Gadget , #PFA_LEFT)
        Case #Editor_AlignC
          Editor_SetAlignment(#Editor_Gadget , #PFA_CENTER)
        Case #Editor_AlignR
          Editor_SetAlignment(#Editor_Gadget , #PFA_RIGHT)
          
        Case #Container_Button_00
          ShowContainer(#Container_01)
          StatusBarText(#StatusBar_1,0,"WORK ",#PB_StatusBar_Right|  #PB_StatusBar_BorderLess )
        Case #Container_Button_01 
          ShowContainer(#Container_00)
          StatusBarText(#StatusBar_1,0,"MASTER ",#PB_StatusBar_Right|  #PB_StatusBar_BorderLess )
          
          
          
          
          
        Case #Editor_HTML
          ShowContainer(#Container_01)
          HtmlExporter$="D:\Velindos\PROFI\HTML\HTML_Test.html"
          
          If CreateFile(RF,HtmlExporter$)
            WriteStringN(RF,"<HTML><HEAD><TITLE>Export aus einem EditorGadget</TITLE></HEAD><BODY>")
            SendMessage_(GadgetID(#Editor_Gadget),#EM_SETSEL,0,-1)
            Speicher1.l=0: Speicher2.l=0
            SendMessage_(GadgetID(#Editor_Gadget),#EM_GETSEL,@Speicher1,@Speicher2)
            HtmlFettdr=0: HtmlKursiv=0: HtmlUnters=0: HtmlStrike=0
            Zeilenschaltung$=Chr(10)
            Erweitertezeile$=Chr(13)+Chr(10)
            Textfeld$=ReplaceString(GetGadgetText(#Editor_Gadget),Erweitertezeile$,Zeilenschaltung$)
            For Formatieren=Speicher1 To Speicher2
              Formatlesen(#Editor_Gadget,Formatieren)
              Aktuellzeichen$=Mid(Textfeld$,Formatieren+1,1)
              If Editorfettdr=0 And HtmlFettdr=1: WriteString(RF,"</B>"): HtmlFettdr=0: EndIf
              If Editoritalic=0 And HtmlKursiv=1: WriteString(RF,"</I>"): HtmlKursiv=0: EndIf
              If Editorunderl=0 And HtmlUnters=1: WriteString(RF,"</U>"): HtmlUnters=0: EndIf
              If Editorstrike=0 And HtmlStrike=1: WriteString(RF,"</S>"): HtmlStrike=0: EndIf
              If EditorFont=0 And HtmlCharFont=1: WriteString(RF,"</font>"): HtmlCharFont=0: EndIf
              
              If Aktuellzeichen$=Zeilenschaltung$: WriteStringN(RF,"<BR>"): Formatieren=Formatieren+1: EndIf
              If Editorfettdr=1 And HtmlFettdr=0: WriteString(RF,"<B>"): HtmlFettdr=1: EndIf
              If Editoritalic=1 And HtmlKursiv=0: WriteString(RF,"<I>"): HtmlKursiv=1: EndIf
              If Editorunderl=1 And HtmlUnters=0: WriteString(RF,"<U>"): HtmlUnters=1: EndIf
              If Editorstrike=1 And HtmlStrike=0: WriteString(RF,"<S>"): HtmlStrike=1: EndIf
              If EditorFont=1 And HtmlCharFont=0: WriteString(RF,"<font face='verdana'>"): HtmlCharFont=1: EndIf
              
              If Not Aktuellzeichen$=Zeilenschaltung$: WriteString(RF,Aktuellzeichen$): EndIf
              Letzteszeichen$=Aktuellzeichen$
            Next
            If HtmlFettdr=1: WriteString(RF,"</B>"): EndIf
            If HtmlKursiv=1: WriteString(RF,"</I>"): EndIf
            If HtmlUnters=1: WriteString(RF,"</U>"): EndIf
            If HtmlStrike=1: WriteString(RF,"</S>"): EndIf
            If HtmlCharFont=1: WriteString(RF,"</font>"): EndIf
            WriteStringN(RF,"</BODY></HTML>")
            CloseFile(RF)
          Else
            MessageRequester("Fehler!","Die Erstellung der HTML-Datei ist leider fehlgeschlagen."+Chr(10)+"Der Vorgang war nicht erfolgreich!",#MB_ICONERROR)
          EndIf
          Anzeige_HTML$=""
          If ReadFile(CF, HtmlExporter$)   ; wenn die Datei geöffnet werden konnte, setzen wir fort...
            While Eof(CF) = 0           ; sich wiederholende Schleife bis das Ende der Datei ("end of file") erreicht ist
              ;Debug ReadString(RF)      ; Zeile für Zeile im Debugger-Fenster anzeigen
              Anzeige_HTML$ = ReadString(CF)
              Debug Anzeige_HTML$
            Wend
            CloseFile(CF)               ; schließen der zuvor geöffneten Datei
          Else
            MessageRequester("Information","Konnte Datei nicht öffnen!")
          EndIf
          ShowContainer(#Container_01)
          Delay(20)
          SetGadgetItemText(#Web_Notiz, #PB_Web_HtmlCode, Anzeige_HTML$)
          StatusBarText(#StatusBar_1,0,"WORK ",#PB_StatusBar_Right|  #PB_StatusBar_BorderLess )
          
      EndSelect
    Case #PB_Event_Menu
      Select EventMenu()
        Case #Editor_MenuNew
          ClearGadgetItems(#Editor_Gadget)
        Case #Editor_MenuOpen
          Editor_Open(#Editor_Gadget , OpenFileRequester("" , Editor_FileName$ , Editor_Pattern$ , SelectedFilePattern()))
        Case #Editor_MenuSave
          Editor_Save(#Editor_Gadget , SaveFileRequester("" , Editor_FileName$ , Editor_Pattern$ , SelectedFilePattern()))
        Case #Editor_MenuQuit
          Editor_Quit()
      EndSelect         
  EndSelect      
ForEver
;Images
DataSection
  Fragezeichen:
  IncludeBinary "D:\Pure@Store\DESIGN_LITE_SMART\Fragezeichen.ico"
EndDataSection

; font eintragne <font face="Avalon,Wide Latin">Das ist Text in Schriftart Avalon,
; oder, falls Avalon nicht darstellbar, in Wide Latin</font>
; strikeout eintragen => <S>Jodi</S> 
; <p>
 ;  <font size="7">Ziemlich riesiger Text</font><br>
 ;  <font size="1">Ziemlich winziger Text</font><br>
  ; <font size="+1">Text etwas gr&ouml;&szlig;er als normal</font><br>
;   <font size="-2">Text deutlich kleiner als normal</font>
; </p>

; <p>
;   <font color="#FF0000">Knallroter Text</font><br>
;   <font color="#00C000">Gr&uuml;ner Text</font><br>
;   <font color="#0000FF">Blauer Text</font>
; </p>

; <p>
;   <font face="Avalon,Wide Latin">Das ist Text in Schriftart Avalon,
 ;  oder, falls Avalon nicht darstellbar, in Wide Latin</font>
; </p>

;WriteString(1, "<pre style='font-family:'Courier New', Courier, monospace; font-size: 12px;'>"+Sorce$+"</pre>")
;<font size="3" color="red">This is some text!</font>
;<font size="2" color="blue">This is some text!</font>
;*********************************************************************
;<font face="verdana" size="2" color="green">This is some text!</font> 
;FONT-SIZE:28PX; ....; ALIGN: CENTER
;HR {HEIGHT: 3PX; BACKGROUND-COLOR: #0; BORDER: 8PX; OUTSET #AA0000; }
;*********Vorschlag Font/Size/Color übernehmen _____________
Vielleicht kann jemanden helfen, komme mit dem Auslesen des Format etc. nicht so zu recht!

Gruss ... Velindos

Re: RTF to HTML

Verfasst: 09.04.2012 17:54
von Derren
Die Farben werden in einer Tabelle am Beginn der Datei gespeichert.
Hier kannst du alles über das Format nachlesen. http://msdn.microsoft.com/de-de/library ... 10%29.aspx

Hier wurde das ganze "Rückwärts", alos HTML -> RTF umgesetzt.
Da findest du vielleicht Infos über den Aufbau der Farbtabelle:

http://purebasic.fr/english/viewtopic.p ... 71#p348771

Re: RTF to HTML

Verfasst: 21.04.2012 19:21
von Velindos
Hallo Derren!
Danke für deinen Tip. Habe mir die Sache angesehn und einiges aus den Foren zusammengestellt. Läuft aber noch nicht komplett.
Habe jetzt mir der Procedure GetSelectText() den eingestellten Font aufgenommen. Nun wollte ich die Procedure NotizGadgetSetFont(Gadget) einbauen, bringe das aber nicht ganz in die Reihe.
Vielleicht weiss jemand mehr ...

Code: Alles auswählen

;- RELEASE NOTIZ
; Praser_000  RTF Editor mit einstellen der Font´s
; Praser_001  RTF Editor mit einstellen der Font´s
; Praser_002  Plugin für Formatieren eingefügt
; Praser_003  Zusätzliches EditorCopy Frame eingefügt
; Praser_004  RTF Editor mit einstellen der Font´s


;-Constanten

Enumeration
  #Container_00
  #Container_01
  #Container_02
  #Container_99
  #Container_Button_00
  #Container_Button_01
  #Container_Button_02
  #Container_Button_03
  #Container_Button_99
  #FrameMain
  #myFragezeichen
  #StatusBar_1
  #Velindoslink
  #Editor_Gadget
  #Editor_GadgetCopy
  #Web_Notiz
  #PopUp_Container_00
  #PopUp_Ausschneiden
  #PopUp_Kopieren
  #PopUp_Einfuegen
  #PopUp_Markieren
  #PopUp_Rueckgaengig
  #PopUp_Fett
  #PopUp_Kursiv
  #PopUp_Unterstrichen
  #PopUp_Durchgestrichen
  #Button_FormatSelect
  #Button_Fett
  #Button_Kursiv
  #Button_Unterstrichen
  #Button_Durchgestrichen
  #Button_HTML
  #Button_Formatieren
  #Button_Kopieren
  #EditorGadget
EndEnumeration
;-Globale
Global Editorfettdr, Editoritalic, Editorunderl, Editorstrike
Global MyFrageZeichen=CatchImage(#myFragezeichen,?Fragezeichen)
Global RF=100; Zeiger für CSV Dateien
Global HTML.s
Global Font_Name.s = "Arial", Font_Size.l = 12, Font_Style.l, Font_Color.l
Global RTF_Text$
Global String.s
;RTF- Text
;RTF_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;}}"
;RTF_Text$ = RTF_Text$ + "{\colortbl ;\red255\green0\blue0;\red0\green128\blue0;\red0\green0\blue255;\red0\green0\blue0;}"
;RTF_Text$ = RTF_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 "
;RTF_Text$ = RTF_Text$ + "Zeilenumbruch \f1 Arial, \f2\fs28 Verdana\fs20 , \f0 Courier New\cf4\par "
;RTF_Text$ = RTF_Text$ + "\par "
;RTF_Text$ = RTF_Text$ + "T\'fcrkisch: \'e7a\u287?\u305?r\u305?nak   \cf0 Japanisch:  \f3\'90\'46\'82\'cd\'93\'f5\'82\'d6\'82\'c7\f0\par "
;RTF_Text$ = RTF_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 "
;RTF_Text$ = RTF_Text$ + "}"
; Erster Schritt
RTF_Text$ = "{\rtf1\ansi\ansicpg1252\deff0\deflang1031{\fonttbl{\f0\fnil\fcharset0 Calibri;}}"
RTF_Text$ + "{\*\generator Msftedit 5.41.21.2510;}\viewkind4\uc1\pard\sa200\sl276\slmult1\lang7\f0\fs22 Das ist ein \b Probetext \b0 mit \i Kursiv\i0 , \ul Unterstrichen \ulnone und \strike Durchgestrichen \strike0 f\'fcr den ersten Schritt!\par"
RTF_Text$ + "}"
;-PopUp
If CreatePopupMenu(#PopUp_Container_00)
  MenuItem(#PopUp_Ausschneiden,"Ausschneiden"+Chr(9)+"Strg+X")
  MenuItem(#PopUp_Kopieren,"Kopieren"+Chr(9)+"Strg+C")
  MenuItem(#PopUp_Einfuegen,"Einfügen"+Chr(9)+"Strg+V")
  MenuItem(#PopUp_Markieren,"Alles markieren"+Chr(9)+"Strg+A")
  MenuBar()
  MenuItem(#PopUp_Rueckgaengig,"Rückgängig"+Chr(9)+"Strg+Z")
  OpenSubMenu("Formatieren")
  MenuItem(#PopUp_Fett,"Fett"+Chr(9)+"Strg+Shift+F")
  MenuItem(#PopUp_Kursiv,"Kursiv"+Chr(9)+"Strg+Shift+K")
  MenuItem(#PopUp_Unterstrichen,"Unterstrichen"+Chr(9)+"Strg+Shift+U")
  MenuItem(#PopUp_Durchgestrichen,"Durchgestrichen"+Chr(9)+"Strg+Shift+D")
  CloseSubMenu()
EndIf
Procedure Editor_FontName(Gadget.l,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) ;#SCF_DEFAULT
EndProcedure
Procedure Editor_FontSize(Gadget.l,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
Procedure Editor_FontStyle(Gadget.l,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
Procedure Editor_FontColor(Gadget.l,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

Procedure Formatlesen(Gadget,Position)
  SendMessage_(GadgetID(Gadget),#EM_SETSEL,Position,Position+1)
  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

; EditorGadget formatieren mit Berücksichtigung bestehender Formate
Procedure Formatsetzen(Gadget,Neuformat)
  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_UNDERLINE|#CFM_STRIKEOUT
    format\dwEffects=Gesamtformat
    SendMessage_(GadgetID(Gadget),#EM_SETCHARFORMAT,#SCF_SELECTION,@format)
  Next
  SendMessage_(GadgetID(Gadget),#EM_SETSEL,Speicher1,Speicher2)
EndProcedure

Procedure SetFont()
  Editor_FontName(#Editor_Gadget,Font_Name)
  Editor_FontSize(#Editor_Gadget,Font_Size)
  Editor_FontStyle(#Editor_Gadget,Font_Style)
  Editor_FontColor(#Editor_Gadget,Font_Color)
EndProcedure

Procedure ShowContainer(index)
  Protected i
  
  For i =  #Container_00 To #Container_02
    HideGadget(i, #True)
    
  Next
  HideGadget(index, #False)
  Debug "Container= " + Str(index)
  
EndProcedure
Procedure GetSelectText()
   Protected name.s, size, farbe, style
  ;Auslesen des Formates des selcectierten Textes Neue
  format.CHARFORMAT2\cbsize = SizeOf(CHARFORMAT2)
  SendMessage_(GadgetID(#Editor_Gadget), #EM_GETCHARFORMAT ,#SCF_SELECTION, @format)

      If format
          name  = PeekS(@format\szFaceName)
      size  = format\yHeight / 20
      farbe = format\crTextColor
      
    Font_Name = PeekS(@format\szFaceName)
    Style      = format\dwMask
    COLOR      = format\dwMask
    PointSize  = format\yHeight/20
    Debug FaceName.s + "  " + Str(PointSize) + "  " + FaceStyle.s
  EndIf
  
  If Not FontRequester(Font_Name, PointSize, #PB_FontRequester_Effects, COLOR, Style)
    ProcedureReturn
  EndIf   
  
        ;set Font
      name = SelectedFontName()
      If Len(name) > SizeOf(format\szFaceName)
         name = Left(name, SizeOf(format\szFaceName))
      EndIf
      PokeS(@format\szFaceName, name) ;kopieren nach \szFaceName.c[32]
      format\yHeight = SelectedFontSize() * 20
     
      ;set Styles, erst Flags löschen ist einfacher
      format\dwEffects & ~ #CFE_BOLD   
      format\dwEffects & ~ #CFE_ITALIC   
      format\dwEffects & ~ #CFM_UNDERLINE   
      format\dwEffects & ~ #CFM_STRIKEOUT
     
      ;nun Flags setzen
      style = SelectedFontStyle()
      If style & #PB_Font_Bold: format\dwEffects | #CFE_BOLD: EndIf
      If style & #PB_Font_Italic: format\dwEffects | #CFE_ITALIC: EndIf
      If style & #PB_Font_Underline: format\dwEffects | #CFM_UNDERLINE: EndIf
      If style & #PB_Font_StrikeOut: format\dwEffects | #CFM_STRIKEOUT: EndIf
         
      SendMessage_(#Editor_Gadget, #EM_SETCHARFORMAT, #SCF_SELECTION, charformat)
     
      ;nur für Farbe, denn wenn Farbe schwarz war, dann wird diese nicht geändert
      ClearStructure(charformat, CharFormat2)
      format\cbSize = SizeOf(CharFormat2)
      format\dwMask = #CFM_COLOR
      format\crTextColor = SelectedFontColor()
      SendMessage_(#Editor_Gadget, #EM_SETCHARFORMAT, #SCF_SELECTION, charformat)
     

EndProcedure
; Formatierung
Procedure.i NotizGadgetSetFont(Gadget)     
   
   
   ;Protected id = Gadget
   Protected charformat.CharFormat2 
   Protected name.s, size, farbe, style
   
     format.CHARFORMAT2\cbsize = SizeOf(CHARFORMAT2)
  SendMessage_(GadgetID(#Editor_Gadget), #EM_GETCHARFORMAT ,#SCF_SELECTION, @charformat)

   With charformat
      \cbSize = SizeOf(CharFormat2)
     
      ;get Font
      \dwMask = #CFM_FACE | #CFM_SIZE | #CFM_COLOR   
      SendMessage_(#Editor_Gadget, #EM_GETCHARFORMAT, #SCF_SELECTION, charformat)
     
      name  = PeekS(@ \szFaceName)
      size  = \yHeight / 20
      farbe = \crTextColor
     
      ;get styles
      \dwMask | #CFM_BOLD
      \dwMask | #CFM_ITALIC
      \dwMask | #CFM_UNDERLINE
      \dwMask | #CFM_STRIKEOUT   
     
      SendMessage_(#Editor_Gadget, #EM_GETCHARFORMAT, #SCF_SELECTION, charformat)
     
      If \dwEffects & #CFE_BOLD: style | #PB_Font_Bold: EndIf
      If \dwEffects & #CFE_ITALIC: style | #PB_Font_Italic: EndIf
      If \dwEffects & #CFE_UNDERLINE: style | #PB_Font_Underline: EndIf
      If \dwEffects & #CFE_STRIKEOUT: style | #PB_Font_StrikeOut: EndIf
     
      If Not FontRequester(name, size, #PB_FontRequester_Effects, farbe, style)
         ProcedureReturn
      EndIf   
     
      ;set Font
      name = SelectedFontName()
      If Len(name) > SizeOf(\szFaceName)
         name = Left(name, SizeOf(\szFaceName))
      EndIf
      PokeS(@ \szFaceName, name) ;kopieren nach \szFaceName.c[32]
      \yHeight = SelectedFontSize() * 20
     
      ;set Styles, erst Flags löschen ist einfacher
      \dwEffects & ~ #CFE_BOLD   
      \dwEffects & ~ #CFE_ITALIC   
      \dwEffects & ~ #CFM_UNDERLINE   
      \dwEffects & ~ #CFM_STRIKEOUT
     
      ;nun Flags setzen
      style = SelectedFontStyle()
      If style & #PB_Font_Bold: \dwEffects | #CFE_BOLD: EndIf
      If style & #PB_Font_Italic: \dwEffects | #CFE_ITALIC: EndIf
      If style & #PB_Font_Underline: \dwEffects | #CFM_UNDERLINE: EndIf
      If style & #PB_Font_StrikeOut: \dwEffects | #CFM_STRIKEOUT: EndIf
         
      SendMessage_(#Editor_Gadget, #EM_SETCHARFORMAT, #SCF_SELECTION, charformat)
     
      ;nur für Farbe, denn wenn Farbe schwarz war, dann wird diese nicht geändert
      ClearStructure(charformat, CharFormat2)
      \cbSize = SizeOf(CharFormat2)
      \dwMask = #CFM_COLOR
      \crTextColor = SelectedFontColor()
      SendMessage_(#Editor_Gadget, #EM_SETCHARFORMAT, #SCF_SELECTION, charformat)
     
   EndWith

EndProcedure

Procedure MainWindow()
  
  ;*************** C O T A I N E R -  W I N D O W S
  OpenWindow(#FrameMain, 683, 0,667, 730,LizenzWindows$, #PB_Window_SystemMenu |#PB_Window_SizeGadget|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget | #PB_Window_Invisible)
  If CreateStatusBar(#StatusBar_1, WindowID(#FrameMain))
    HyperLinkGadget(#Velindoslink, 25, 5, 140, StatusBarHeight(#StatusBar_1), "www.velindos.com", RGB(255,0,0), #PB_HyperLink_Underline)
    AddStatusBarField(667)
  EndIf
  
  ;-[00]R T F
  ;*************** F R A M E   R T F  -  W O R K
  ContainerGadget(#Container_00, 0, 0, 667, 706)
  ButtonGadget(#Container_Button_00, 0, 0, 667, 30, "R T F  -  W O R K")
  
  ButtonGadget(#Button_FormatSelect,10,35,25,25,"F")
  
  ButtonGadget(#Button_Fett,40,35,40,25,"Fett")
  ButtonGadget(#Button_Kursiv,80,35,50,25,"Kursiv")
  ButtonGadget(#Button_Unterstrichen,130,35,80,25,"Unterstrichen")
  ButtonGadget(#Button_Durchgestrichen,210,35,100,25,"Durchgestrichen")
  ButtonGadget(#Button_HTML,310,35,110,25,"HTML Exportieren")
  ButtonGadget(#Button_Kopieren,460,35,25,25,"C")
  
  ButtonGadget(#Button_Formatieren,520,35,110,25,"Formatieren")
  
  EditorGadget(#Editor_Gadget, 5, 65, WindowWidth(#FrameMain)-20,WindowHeight(#FrameMain)-105)
  
  ; Rechtsklick-Menü für EditorGadget wird erstellt
  
  StatusBarText(#StatusBar_1,0,"R T F  -  W O R K ",#PB_StatusBar_Right|  #PB_StatusBar_BorderLess )
  CloseGadgetList()
  
  ;-[01]H T M L
  ;***************  F R A M E   H T M L  K O N V E R T I E R U N G
  ContainerGadget(#Container_01, 0, 0, 667, 706)
  ButtonGadget(#Container_Button_01, 0, 0, 667, 30, " H T M L  K O N V E R T I E R U N G")
  ButtonGadget(#Container_Button_03, 0, 30, 667, 30, " R T F _ C O P Y")
  WebGadget(#Web_Notiz,10,65,WindowWidth(#FrameMain)-20,WindowHeight(#FrameMain)-105,"")
  
  StatusBarText(#StatusBar_1,0,"H T M L  K O N V E R T I E R U N G ",#PB_StatusBar_Right|  #PB_StatusBar_BorderLess )
  CloseGadgetList()
  
    ;-[01]RTF_COPY
  ;***************  F R A M E   R T F _ C O P Y 
  ContainerGadget(#Container_02, 0, 0, 667, 706)
  ButtonGadget(#Container_Button_02, 0, 30, 667, 30, " R T F _ C O P Y ")
  
  EditorGadget(#Editor_GadgetCopy, 5, 65, WindowWidth(#FrameMain)-20,WindowHeight(#FrameMain)-105)
  
  StatusBarText(#StatusBar_1,0,"R T F _ C O P Y ",#PB_StatusBar_Right|  #PB_StatusBar_BorderLess )
  CloseGadgetList()

  
  
  
  
  ;-[99]MyFrageZeichen
  ;*************** C O N T A N E R  -   B U T T O N
  ContainerGadget(#Container_99, 3, 3, 16, 16)
  ButtonImageGadget(#Container_Button_99, 0, 0, 16, 16, MyFrageZeichen)
  GadgetToolTip(#Container_Button_99, "Velindos Version & Lizenz & Laufzeit")
  CloseGadgetList()
  
EndProcedure

MainWindow()

HideWindow(#FrameMain, #False)
ShowContainer(#Container_00)
SetParent_(GadgetID(#Velindoslink), StatusBarID(#StatusBar_1))
SetParent_(GadgetID(#Container_99), StatusBarID(#StatusBar_1))
SetGadgetFont(#Editor_Gadget,LoadFont(#Editor_Gadget,"Tahoma",10))
; URLs werden automatisch als Links dargestellt
SendMessage_(GadgetID(#Editor_Gadget), #EM_SETTARGETDEVICE, #Null, 0)

; Shortcuts für Editor-Fenster werden hinzugefügt
AddKeyboardShortcut(#FrameMain,#PB_Shortcut_Control|#PB_Shortcut_Shift|#PB_Shortcut_F,160)
AddKeyboardShortcut(#FrameMain,#PB_Shortcut_Control|#PB_Shortcut_Shift|#PB_Shortcut_K,170)
AddKeyboardShortcut(#FrameMain,#PB_Shortcut_Control|#PB_Shortcut_Shift|#PB_Shortcut_U,180)
AddKeyboardShortcut(#FrameMain,#PB_Shortcut_Control|#PB_Shortcut_Shift|#PB_Shortcut_D,190)

SetGadgetItemText(#Editor_Gadget,0,RTF_Text$)


;- Repeat
Define Gadget
Repeat
  Select WaitWindowEvent()
      
    Case #PB_Event_CloseWindow:Break
      
    Case #PB_Event_CloseWindow
      Ende=1
      
    Case #PB_Event_Gadget
      Select EventGadget()
          
          
        Case #Container_Button_00 ; Vom DECKBLATT zur NOTIZ
          ShowContainer(#Container_01)
          StatusBarText(#StatusBar_1,0,"WORK ",#PB_StatusBar_Right|  #PB_StatusBar_BorderLess )
          
        Case #Container_Button_01 ; Vom DECKBLATT zur NOTIZ
          ShowContainer(#Container_00)
          StatusBarText(#StatusBar_1,0,"MASTER ",#PB_StatusBar_Right|  #PB_StatusBar_BorderLess )
          
        Case #Container_Button_03
          ShowContainer(#Container_02)
          StatusBarText(#StatusBar_1,0,"MASTER ",#PB_StatusBar_Right|  #PB_StatusBar_BorderLess )
          
        Case #Container_Button_02
          ShowContainer(#Container_01)
          StatusBarText(#StatusBar_1,0,"MASTER ",#PB_StatusBar_Right|  #PB_StatusBar_BorderLess )
          
          
        Case #PB_Event_Gadget
          Gadget = EventGadget()
          Select EventGadget()
          EndSelect
          
        Case #Editor_Gadget
          Debug "notiz"
          Select EventType()
            Case #PB_EventType_RightClick
              ;If GetActiveGadget()=#Editor_Gadget: 
              DisplayPopupMenu(#PopUp_Container_00,WindowID(#FrameMain)): 
              ;EndIf
          EndSelect
          
        Case #WM_RBUTTONDOWN
          If GetActiveGadget()=#Editor_Gadget: 
            DisplayPopupMenu(#PopUp_Container_00,WindowID(#FrameMain)): 
          EndIf
          
          
        Case #Button_Kopieren
          NotizGadgetSetFont(#Editor_Gadget)   
          
        Case #Button_FormatSelect
          GetSelectText()
          
        Case #Button_Formatieren
          If FontRequester(Font_Name,Font_Size,#PB_FontRequester_Effects,Font_Color)
            Font_Name = SelectedFontName()
            Font_Size = SelectedFontSize()
            Font_Style = SelectedFontStyle()
            Font_Color = SelectedFontColor()
            
            If Font_Style < 256 ;normal
            ElseIf Font_Style < 512 ;bold
              Font_Style - 256
              Font_Style + 1
            ElseIf Font_Style < 768 ;italic
              Font_Style - 512
              Font_Style + 2
            ElseIf Font_Style >= 768 ;both
              Font_Style - 768
              Font_Style + 3
            EndIf
            
            SetFont()
            SetActiveGadget(#Editor_Gadget)
          EndIf
          
        Case #Button_Fett: Formatsetzen(#Editor_Gadget,#CFM_BOLD):Debug "Fett"
        Case #Button_Kursiv: Formatsetzen(#Editor_Gadget,#CFM_ITALIC)
        Case #Button_Unterstrichen: Formatsetzen(#Editor_Gadget,#CFM_UNDERLINE)
        Case #Button_Durchgestrichen: Formatsetzen(#Editor_Gadget,#CFM_STRIKEOUT)
          
          ; Hier werden die Formate des EditorGadgets in eine HTML-Datei exportiert
          ;HtmlExporter$=SaveFileRequester("HTML Exportieren","","Alle HTML-Dateien (*.htm,*.html)|*.htm;*.html",0)
          ;If HtmlExporter$<>""
          ;  If Right(HtmlExporter$,3)="htm": Gegeben=1: EndIf
          ; If Right(HtmlExporter$,4)="html": Gegeben=1: EndIf
          ; If Gegeben=0: HtmlExporter$=HtmlExporter$+".htm": EndIf
          
          ;Case #Button_Kopieren
          ;String.s = GetGadgetText(#Editor_Gadget,#PB_Editor_RTF)
          ;SetGadgetText(#Editor_GadgetCopy,String) ;And one could use this to put the nice formatted text info another editor gadget
          
          
        Case #Button_HTML
          
          HTML$ =""
          
          HTML$ + "<HTML><HEAD><TITLE>Export aus einem EditorGadget</TITLE></HEAD><BODY>"
          
          SendMessage_(GadgetID(#Editor_Gadget),#EM_SETSEL,0,-1)
          
          Speicher1.l=0: Speicher2.l=0
          
          SendMessage_(GadgetID(#Editor_Gadget),#EM_GETSEL,@Speicher1,@Speicher2)
          
          HtmlFettdr=0: HtmlKursiv=0: HtmlUnters=0: HtmlStrike=0
          
          ;Zeilenschaltung$=Chr(10)
          
          ;Erweitertezeile$=Chr(13)+Chr(10)
          Textfeld$=ReplaceString(GetGadgetText(#Editor_Gadget), #CR$+#LF$, "<br>")
          Textfeld$=ReplaceString(GetGadgetText(#Editor_Gadget), "---------------------------------------------------------------------------------------------", "  <br><hr>");
          
          ;Textfeld$=ReplaceString(GetGadgetText(#Editor_Gadget),Erweitertezeile$,Zeilenschaltung$)
          
          For Formatieren = Speicher1 To Speicher2
            
            Formatlesen(#Editor_Gadget,Formatieren)
            
            Aktuellzeichen$ = Mid(Textfeld$, Formatieren + 1 , 1)
            Delay(20)
            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
            
            If Aktuellzeichen$=Zeilenschaltung$: HTML$ + "<BR>": Formatieren=Formatieren+1: EndIf
            
            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
            
            If Not Aktuellzeichen$=Zeilenschaltung$: HTML$ + Aktuellzeichen$: EndIf
            
            Letzteszeichen$=Aktuellzeichen$
            
          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>"
          
          ShowContainer(#Container_01)
          SetGadgetItemText(#Web_Notiz, #PB_Web_HtmlCode, HTML$)
          StatusBarText(#StatusBar_1,0,"WORK ",#PB_StatusBar_Right|  #PB_StatusBar_BorderLess )
      EndSelect
      
    Case #PB_Event_Menu
      Select EventMenu()
          ; Befehle des Rechtsklick-Menüs vom EditorGadget
        Case #PopUp_Ausschneiden: SendMessage_(GadgetID(#Editor_Gadget),#WM_CUT,0,0)
        Case #PopUp_Kopieren: SendMessage_(GadgetID(#Editor_Gadget),#WM_COPY,0,0)
        Case #PopUp_Einfuegen: SendMessage_(GadgetID(#Editor_Gadget),#WM_PASTE,0,0)
        Case #PopUp_Markieren: SendMessage_(GadgetID(#Editor_Gadget),#EM_SETSEL,0,-1)
        Case #PopUp_Rueckgaengig: SendMessage_(GadgetID(#Editor_Gadget),#EM_UNDO,0,0)
          Case #PopUp_Fett: If GetActiveGadget()=#Editor_Gadget: Formatsetzen(#Editor_Gadget,#CFM_BOLD): EndIf
          Case #PopUp_Kursiv: If GetActiveGadget()=#Editor_Gadget: Formatsetzen(#Editor_Gadget,#CFM_ITALIC): EndIf
          Case #PopUp_Unterstrichen: If GetActiveGadget()=#Editor_Gadget: Formatsetzen(#Editor_Gadget,#CFM_UNDERLINE): EndIf
          Case #PopUp_Durchgestrichen: If GetActiveGadget()=#Editor_Gadget: Formatsetzen(#Editor_Gadget,#CFM_STRIKEOUT): EndIf
      EndSelect
      
    Case 0: Delay(1)
      
  EndSelect
  
  
ForEver 

;Images
DataSection
  Fragezeichen:
  IncludeBinary "D:\Pure@Store\DESIGN_LITE_SMART\Fragezeichen.ico"
EndDataSection
Gruss ... Velindos

Re: RTF to HTML

Verfasst: 11.07.2012 08:46
von Velindos
Hallo Leute,
habe mir aus den Codeschnippsel aus dem Forum einen HTML-Parser gebastelt. Nun habe ich folgendes Problem:

"Wenn ich eine Linie einfüge und diese Replatziere dann erfolgt nach der Linie keine Formatierung mehr" Kann mir jemand helfen, was ist hier falsch ist.

Beschreibung zur Demo, mit "Setze Text" wird Text gesetzt im Gadget mit "HTML-Export" wird Text ins Webgadget geschrieben. Habe 3 verschiedene Textvorgaben eingebaut.

Code: Alles auswählen

; PureBasic Visual Designer v3.95 build 1485 (PB4Code)
;- Window Constants
;- Applikation Entwurf 0016
Enumeration
  #Window_0
EndEnumeration
;- Gadget Constants
;
Enumeration
  #Button_Kursiv
  #Button_Fett
  #Button_Unterstrichen
  #Button_Durchgestrichen
  #RTF_Gadget
  #HTML_Gadget
  #Button_HTML_Konvert
  #RTF_Gadget_Notiz
  #Button_SetzeText
  #Button_ClearText
  #AnzeigeHTML
  #AnzeigePosition
EndEnumeration
;
Global Ende=0
Global TESTRTF.s
Global Editorfettdr, Editoritalic, Editorunderl, Editorstrike, EditorLF
Global Linienschaltung$
Global ErsatzLinienschaltung$
Global Zeilenschaltung$
Global ErsatzZeilenUmschaltungs$
Global ErsatzAktuellzeichen$ =""
Global FormatierenZeiger
Global Formatieren
Global Linienschaltunglaenge
Global Textfeldlange
Global EditorModus = 0
;
; EditorGadget Format Zeichen für Zeichen auslesen
Procedure Formatlesen(Gadget,Position)
  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(#RTF_Gadget), #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
; EditorGadget formatieren mit Berücksichtigung bestehender Formate
Procedure Formatsetzen(Gadget,Neuformat)
  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()
  TESTRTF =""
  TESTRTF +"Test von RTF To HTML mit Linie"
  TESTRTF +"-------------------------------------------------------------------------------------------------------------------------------und Zeilenumbruch."
  SendMessage_(GadgetID(#RTF_Gadget),#EM_REPLACESEL,#WM_PASTE,TESTRTF)
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")
      ed = EditorGadget(#RTF_Gadget, 10, 40, 650, 320)
      WebGadget(#HTML_Gadget, 10, 400, 650, 320, TESTRTF)
      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
;SendMessage_(GadgetID(#RTF_Gadget),#EM_AUTOURLDETECT,#True,0)
; Zeilenumbruch wird gesetzt
SendMessage_(GadgetID(#RTF_Gadget), #EM_SETTARGETDEVICE, #Null, 0)
; SetGadgetFont
SetGadgetFont(#RTF_Gadget,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(#RTF_Gadget) , #EM_STREAMOUT , #SF_RTF , 0)
        Case #Button_Fett: Formatsetzen(#RTF_Gadget,#CFM_BOLD)
        Case #Button_Kursiv: Formatsetzen(#RTF_Gadget,#CFM_ITALIC)
        Case #Button_Unterstrichen: Formatsetzen(#RTF_Gadget,#CFM_UNDERLINE)
        Case #Button_Durchgestrichen: Formatsetzen(#RTF_Gadget,#CFM_STRIKEOUT)
        Case #Button_HTML_Konvert
          Ergebnis = CountGadgetItems(#RTF_Gadget)
          Debug "Zeilenanzahl = " +Str(Ergebnis)
          HTML$ =""
          Linienschaltung$ = "-------------------------------------------------------------------------------------------------------------------------------"
          Linienschaltunglaenge= Len(Linienschaltung$)
          ErsatzLinienschaltung$ = "<HR>"
          
          HTML$ + "<HTML><HEAD><TITLE>Export aus einem EditorGadget</TITLE></HEAD><BODY>"
          Speicher1.l=0: Speicher2.l=0
          
          Textfeld$=GetGadgetText(#RTF_Gadget)
          Textfeldlange=Len(GetGadgetText(#RTF_Gadget))
          
          Textfeld$=ReplaceString(GetGadgetText(#RTF_Gadget),Linienschaltung$,ErsatzLinienschaltung$);:Formatieren=Formatieren+1
          
          SendMessage_(GadgetID(#RTF_Gadget), #EM_SETSEL, 0, Len(GetGadgetText(#RTF_Gadget)))
          SendMessage_(GadgetID(#RTF_Gadget),#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(#RTF_Gadget,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(#HTML_Gadget, #PB_Web_HtmlCode, HTML$)
      EndSelect
  EndSelect
Until Ende=1
Gruss ... Velindos

Re: RTF to HTML

Verfasst: 16.07.2012 18:39
von Velindos
Hallo Leute,
hier mal der letzte Stand der Sache. Was noch fehlt ist der FONT, SIZE und COLOR. Vieleicht einer eine Idee.

Code: Alles auswählen

Enumeration
  #RTF_Gadget
  #RTF_Gadget2
  #RTF_Gadget3
  #RTF_Gadget4
  #RTF_Gadget5
EndEnumeration

Global TESTRTF.s

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


;PB4
; ************* Variables *************
Global a$
Fensterueberschrift$ = "Unicode-Test"
Button_1     = 20   ; Button-ID

Global FontID1
FontID1 = LoadFont(1, "Courier", 10)    ; Font für die Darstellung

Global Editorstrike=0: Global Editorunderl=0:  Global Editoritalic=0: Global Editorfettdr=0 : Global IsCarakter=0

TESTRTF =""
TESTRTF +"{\rtf1\ansi\ansicpg1252\deff0\deflang1031{\fonttbl{\f0\fnil\fcharset0 Calibri;}}"
TESTRTF +"{\*\generator Msftedit 5.41.21.2510;}\viewkind4\uc1\pard\b\f0\fs26 Notiz \b0 vom 30.05.2012\par"
TESTRTF +"\fs20 Unicode: \u264?\u284?\u292?\u308?\u348?\u364?\u265?\u285?\u293?\u309?\u349?\u365?\par"
TESTRTF +"----------------------------------------------------------------------------------------------------"
;TESTRTF +"\par"
TESTRTF +"\b So \b0 der erste \ul\b Ansatz\par"
TESTRTF +"\pard\sa200\sl276\slmult1\ulnone\b0 Hier sollte der Text weiter gehen.()\lang7\fs22\par"
TESTRTF +"}"




#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 Formatlesen(Gadget,Position)
  SendMessage_(GadgetID(Gadget),#EM_SETSEL,Position,Position+1)
  SendMessage_(GadgetID(Gadget), #WM_COPY, 0, -1)
  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: IsCarakter=1: EndIf
  If Pretyp & #CFM_UNDERLINE: Editorunderl=1: Else: Editorunderl=0:IsCarakter=1: EndIf
  If Pretyp & #CFM_ITALIC: Editoritalic=1: Else: Editoritalic=0: IsCarakter=1:EndIf
  If Pretyp & #CFM_BOLD: Editorfettdr=1: Else: Editorfettdr=0:IsCarakter=1: EndIf: Debug "IsCarakter= "+Str(IsCarakter)
EndProcedure

Procedure StreamOut(dwCookie,pbBuff,cb,*pcb)
  SetGadgetText(dwCookie,PeekS(pbBuff))
  A$ = PeekS(pbBuff) 
EndProcedure

If OpenWindow(0, 1, 1, 800, 650, Fensterueberschrift$,  #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar )
  SetWindowColor(0,RGB(100, 150, 100))
  CreateGadgetList(WindowID(0))
  
  EditorGadget(#RTF_Gadget, 20, 50, 650, 110)  ;#PB_Editor_ReadOnly
  SetGadgetFont(#RTF_Gadget, FontID1)
  EditorGadget(#RTF_Gadget2, 20, 160, 650, 110);#PB_Editor_ReadOnly
  SetGadgetFont(#RTF_Gadget2, FontID1)
  WebGadget(#RTF_Gadget3, 20, 320, 650, 110,"");#PB_Editor_ReadOnly
  SetGadgetFont(#RTF_Gadget3, FontID1)
  EditorGadget(#RTF_Gadget4, 20, 440, 650, 110);#PB_Editor_ReadOnly
  SetGadgetFont(#RTF_Gadget4, FontID1)
  EditorGadget(#RTF_Gadget5, 20, 560,650, 30);#PB_Editor_ReadOnly
  SetGadgetFont(#RTF_Gadget5, FontID1)
  
  
  ButtonGadget(Button_1, 650+25, 130, 100, 20, "Copy")
  SetGadgetText(#RTF_Gadget, TESTRTF)     
  
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
        Break
        
      Case #PB_Event_Gadget
        Select EventGadget()
            
          Case Button_1
            
            HTML$ =""
            HTML$ + "<HTML><HEAD><TITLE>Export aus einem EditorGadget</TITLE></HEAD><BODY>"
            Speicher1.l=0: Speicher2.l=0
            
            Aktuellzeichen$=""
            Stream.EDITSTREAM
            Stream\dwCookie    = #RTF_Gadget
            Stream\pfnCallback = @StreamOut()
            SendMessage_(GadgetID(#RTF_Gadget), #EM_STREAMOUT, #SF_RTF, @Stream)           
            
            ;A$ = ReplaceString(A$, "\u264?", "^C") 
            ;A$ = ReplaceString(A$, "\u284?", "^G")
            ;A$ = ReplaceString(A$, "\u292?", "^H")
            ;A$ = ReplaceString(A$, "\u308?", "^J")
            ;A$ = ReplaceString(A$, "\u348?", "^S")
            ;A$ = ReplaceString(A$, "\u364?", "^U")
            ;A$ = ReplaceString(A$, "\u265?", "^c")
            ;A$ = ReplaceString(A$, "\u285?", "^g")
            ;A$ = ReplaceString(A$, "\u293?", "^h")
            ;A$ = ReplaceString(A$, "\u309?", "^j")
            ;A$ = ReplaceString(A$, "\u349?", "^s")
            ;A$ = ReplaceString(A$, "\u365?", "^u")
            
            
            Zeilenschaltung$=Chr(10)
            ;Erweitertezeile$=Chr(13)+Chr(10)
            Erweitertezeile$="<br>"
            A$ = ReplaceString(A$,Zeilenschaltung$,Erweitertezeile$)
            
            
            
            A$ = ReplaceString(A$,"---------------------------------------------------------------------------------------------------", "<HR>") 
            
            SetGadgetText(#RTF_Gadget, A$)
            
            
            
            SendMessage_(GadgetID(#RTF_Gadget), #EM_SETSEL, 0, Len(GetGadgetText(#RTF_Gadget)))
            SendMessage_(GadgetID(#RTF_Gadget),#EM_GETSEL,@Speicher1,@Speicher2)
            
            
            For Formatieren = Speicher1 To Speicher2+Aufschaltung
              SetGadgetText(#RTF_Gadget4,"")
              Formatlesen(#RTF_Gadget,Formatieren)
              SendMessage_(GadgetID(#RTF_Gadget4), #WM_PASTE, 0, 0)
              Aktuellzeichen$=GetGadgetText(#RTF_Gadget4)
              Debug Aktuellzeichen$
              
              If Editorfettdr=0 And HtmlFettdr=1: HTML$ + "</B>": HtmlFettdr=0: EndIf: Debug "Editorfettdr= "+Str(Editorfettdr)
              If Editoritalic=0 And HtmlKursiv=1: HTML$ + "</I>": HtmlKursiv=0: EndIf: Debug "Editoritalic= "+Str(Editoritalic)
              If Editorunderl=0 And HtmlUnters=1: HTML$ + "</U>": HtmlUnters=0: EndIf: Debug "Editorunderl= "+Str(Editorunderl)
              If Editorstrike=0 And HtmlStrike=1: HTML$ + "</S>": HtmlStrike=0: EndIf: Debug "Editorstrike= "+Str(Editorstrike)
              
              
              ;Beginmodus
              If Editorfettdr=1 And HtmlFettdr=0: HTML$ + "<B>": HtmlFettdr=1: EndIf: Debug "Editorfettdr= "+Str(Editorfettdr)
              If Editoritalic=1 And HtmlKursiv=0: HTML$ + "<I>": HtmlKursiv=1: EndIf: Debug "Editoritalic= "+Str(Editoritalic)
              If Editorunderl=1 And HtmlUnters=0: HTML$ + "<U>": HtmlUnters=1: EndIf: Debug "Editorunderl= "+Str(Editorunderl)
              If Editorstrike=1 And HtmlStrike=0: HTML$ + "<S>": HtmlStrike=1: EndIf: Debug "Editorstrike= "+Str(Editorstrike)
              
              If Not Aktuellzeichen$=Ersatzzeilenschaltung$ Or Aktuellzeichen$=ErstatzzeichenZeilenschaltung$: HTML$ + Aktuellzeichen$:  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(#RTF_Gadget3, #PB_Web_HtmlCode, HTML$)
            
            
            
            
            ;Text mit Format aus RTF Gadget ausschneiden und einfügen
            ;SendMessage_(GadgetID(#RTF_Gadget),#EM_SETSEL,0, 5)
            ;SendMessage_(GadgetID(#RTF_Gadget), #WM_COPY, 0, -1)
            ;SendMessage_(GadgetID(#RTF_Gadget5), #WM_PASTE, 0, 0)
            
            
            
        EndSelect
        
    EndSelect
  ForEver
  
EndIf ; Open Window

End
Viel, Spass beim Testen!
Gruss ... Velindos

PS. Unwissenheit ist nicht ansteckend!
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de