wenn ich die
Procedure.s RTF_Get_Raw_Richtext_Ascii(Gadget)
im PB 5.71 verwende, läuft alles besten´s!
Im PB 5.73 kommt nur Mist raus?
Code: Alles auswählen
; PB 5.73 Richtext to Web
;- >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
EnableExplicit
;- >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Enumeration
#Edt_Win
#Edt_Btn
#Edt_Btn2
#Edt_Btn3
#Edt_Btn4
EndEnumeration
;- >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Global iPage_Richtext
Global iPage_Lesetext
Global iPage_Htmltext
;- >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Global Parser_NOTIZ$ = ""
Global Parser_Puffer$ = ""
Global Parser_RawRichText$
; *****************************************************************************
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$ + "}"
; *****************************************************************************
; SetGadgetRichtText by mk-soft, v1.05, 27.03.2018
Procedure SetGadgetRichtText(Gadget, Text.s , NewLine=#False)
Debug "=>" + Text
; -------------------------------
If Left(Text, 5) <> "{\rtf"
Text = "{\rtf " + Text + "}"
EndIf
; -------------------------------
If NewLine
Text = Left(Text, Len(text) - 1) + "\line}"
EndIf
; -------------------------------
CompilerIf #PB_Compiler_Unicode
; -------------------------------
Protected hEdit = GadgetID(Gadget)
Protected ndx = GetWindowTextLength_(hEdit)
; Protected *szBuffer = UTF8(Text)
Protected *szBuffer = Ascii(Text)
; -------------------------------
SendMessage_(hEdit, #EM_SETSEL, ndx, ndx)
SendMessage_(hEdit, #EM_REPLACESEL, 0, *szBuffer)
FreeMemory(*szBuffer)
; -------------------------------
CompilerElse
; -------------------------------
; AddGadgetItem(Gadget, -1 , Text)
; SetGadgetItemText(Gadget,#PB_Web_HtmlCode, Text)
; -------------------------------
CompilerEndIf
; -------------------------------
EndProcedure
;- >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
;{ [STRUCT] CALLBACK_COOKIE
Structure _CALLBACK_COOKIE_
*Buffer
Pos.l
EndStructure
;}
; ================================
Procedure.i RTF_GadgetReplaceAll(Gadget.i, ToReplace.s, Text.s, Flags.i = 0)
Protected GadgetID.i = GadgetID(Gadget), Info.FINDTEXT, TextLength.i = Len(ToReplace)
Protected Count.i, Range.CHARRANGE
Protected Found
Protected Exit
; --------------
; Debug "ToReplace= "+ToReplace
; Debug "Text= "+Text
; --------------
Info\lpstrText = @ToReplace
Info\chrg\cpMin = 0
Info\chrg\cpMax = -1
; --------------
Flags|#FR_DOWN
; --------------
SendMessage_(GadgetID, #EM_SETSEL, 0, 0)
; --------------
Repeat
Found = SendMessage_(GadgetID, #EM_FINDTEXT, Flags, @Info)
If Found > -1
Info\chrg\cpMin = Found + 1
; Debug "FOUND"
Range\cpMin = Found
Range\cpMax = Found + TextLength
SendMessage_(GadgetID, #EM_EXSETSEL, 0, @Range)
SendMessage_(GadgetID, #EM_REPLACESEL, 0, @Text)
Count + 1
Else
; Debug "END FOUND"
ProcedureReturn Count
; Exit = #True
EndIf
; --------------
ForEver
; --------------
; Until Exit
; --------------
EndProcedure
Procedure RTF_Get_Raw_ASCII_Callback(*dwCookie._CALLBACK_COOKIE_, *pbBuff, cb, *pcb.LONG)
; über Struct
If *dwCookie\Pos + cb > MemorySize(*dwCookie\Buffer)
*dwCookie\Buffer = ReAllocateMemory(*dwCookie\Buffer, *dwCookie\Pos + cb + SizeOf(CHARACTER))
EndIf
CopyMemory(*pbBuff, *dwCookie\Buffer + *dwCookie\Pos, cb)
*dwCookie\Pos + cb
*pcb\l = cb
ProcedureReturn 0
EndProcedure
Procedure.s RTF_Get_Raw_Richtext_Ascii(Gadget)
; -----------------------------------------------------
Protected stream.EDITSTREAM, CC._CALLBACK_COOKIE_, Result.s
; -----------------------------------------------------
RTF_GadgetReplaceAll(Gadget,"„","“")
; -----------------------------------------------------
; über Struct
CC\Buffer = AllocateMemory(2048)
; -----------------------------------------------------
CC\Pos = 0
; -----------------------------------------------------
stream\pfnCallback = @RTF_Get_Raw_ASCII_Callback()
; -----------------------------------------------------
stream\dwCookie = @CC
; -----------------------------------------------------
SendMessage_(GadgetID(Gadget), #EM_STREAMOUT, #SF_RTF | #SFF_PLAINRTF, @stream)
; -----------------------------------------------------
; Das geht mit leerraum
; -----------------------------------------------------
; 5.71 Ascii oder Unicode nicht gleich zwischen den Ständen
Result = PeekS(CC\Buffer, MemorySize(CC\Buffer) , #PB_Ascii)
; -----------------------------------------------------
; 5.73 Ascii oder Unicode nicht gleich zwischen den Ständen
; Result = PeekS(CC\Buffer, MemorySize(CC\Buffer), #PB_Unicode)
; Result = PeekS(CC\Buffer, MemorySize(CC\Buffer), #PB_UTF8)
; -----------------------------------------------------
FreeMemory(CC\Buffer)
; -----------------------------------------------------
ProcedureReturn Result
; -----------------------------------------------------
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_UTF8)
; Parser_RawRichText$ + PeekS(pbBuff, cb ,#PB_Unicode)
; Parser_RawRichText$ + PeekS(pbBuff, cb,#PB_UTF16 )
;}
EndIf
pcb = cb
EndProcedure
Procedure.s SetGadgetRtfText(gad)
Parser_RawRichText$=""
Protected str.EDITSTREAM\dwCookie=0
str\dwError=0
str\pfnCallback = @Richtext_From_Callback()
SendMessage_(GadgetID(gad),#EM_STREAMOUT,#SF_RTF,@str)
ProcedureReturn Parser_RawRichText$
EndProcedure
Procedure.s SetGadgetLeseText(gad)
Parser_RawRichText$=""
Protected str.EDITSTREAM\dwCookie=0
str\dwError=0
str\pfnCallback = @Richtext_From_Callback()
; SendMessage_(GadgetID(gad),#EM_STREAMOUT,#SF_RTF,@str)
SendMessage_(GadgetID(gad),#EM_STREAMOUT,#SF_TEXT,@str)
;SendMessage_(GadgetID(gad),#EM_STREAMOUT,#SF_TEXTIZED,@str)
;SendMessage_(GadgetID(gad),#EM_STREAMOUT,#SF_UNICODE,@str)
ProcedureReturn Parser_RawRichText$
EndProcedure
; *****************************************************************************
OpenWindow(#Edt_Win,0,0,300,475,"PB 5.73 Richtext to Web => TXT Problem",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
CreateGadgetList(WindowID(#Edt_Win))
iPage_Richtext = EditorGadget(#PB_Any,5,5,290,140,#PB_Editor_WordWrap)
iPage_Lesetext = EditorGadget(#PB_Any,5,155,290,140,#PB_Editor_WordWrap)
iPage_Htmltext = WebGadget(#PB_Any,5,300,290,145,"")
; TextGadget(iPage_Htmltext,5,5,300,290,145,"")
; StringGadget(iPage_Htmltext,5,300,290,145,"")
ButtonGadget(#Edt_Btn,5,450,125,20,"RTF => TXT")
ButtonGadget(#Edt_Btn3,130,450,20,20,"C")
ButtonGadget(#Edt_Btn2,150,450,125,20,"TXT => HTML")
ButtonGadget(#Edt_Btn4,275,450,20,20,"C")
SetGadgetRichtText(iPage_Richtext, Parser_NOTIZ$)
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow: End
Case #PB_Event_Gadget
Select EventGadget()
Case #Edt_Btn
; Richtext ins 2.Gadget
SetGadgetText(iPage_Lesetext,"")
Debug "#Edt_Btn"
Parser_Puffer$ = SetGadgetRtfText(iPage_Richtext)
SetGadgetRichtText(iPage_Lesetext,Parser_Puffer$)
Case #Edt_Btn3
SetGadgetText(iPage_Lesetext,"")
Case #Edt_Btn2
; Version 1
; Vom 2.Gadget ins 3.Gadget(HTML)
; Parser_Puffer$ = SetGadgetLeseText(iPage_Lesetext)
; SetGadgetItemText(iPage_Htmltext, #PB_Web_HtmlCode, Parser_Puffer$)
; Version 2
; Vom 1.Gadget ins 3.Gadget(HTML)
Parser_Puffer$ = RTF_Get_Raw_Richtext_Ascii(iPage_Richtext)
SetGadgetItemText(iPage_Htmltext, #PB_Web_HtmlCode, Parser_Puffer$)
Case #Edt_Btn4
SetGadgetItemText(iPage_Htmltext, #PB_Web_HtmlCode,"")
EndSelect
EndSelect
ForEverGruss ... Velindos!
