Just a note to say that if you are streaming text into an editor gadget using CatchRTF() then, in the case of the text being Unicode encoded, you must add the #SF_UNICODE flag to the format parameter (use #SF_TEXT | #SF_UNICODE). In particular, if streaming in text from a string variable, then use these flags if the Unicode compiler switch is set.
Update : 29th Nov 2007.
Have adjusted the CatchRTF() and LoadRTF() functions which now add a second optional parameter in which you specify the format of the stream/file being loaded; #SF_TEXT (default) or #SF_RTF.
See topic : http://www.purebasic.fr/english/viewtop ... 733#220733
Updated code is below.
Bug fix: 30th August 2006.
Code updated 2nd July 2006.
Code updated: 27 March.
2 bugs fixed: 25 March.
Code updated: 24 March.
I've been taking a delve into COM and interfaces and thought that a good start would be to try and load and paste images into an editor gadget.
It turns out to be quite straight forward; for more so than I imagined!
The following include file is based on some Powerbasic code I found at
http://www.hellobasic.com/ by Edwin Knoppert which translated very painlessly to Purebasic.
I take no credit for this, but simply used Edwin's code to learn from.
I intend to add to this code somewhat when I get the time. A save as .rtf format will be first.
***Update***
Have added functions:
- CatchRTF() - Now with optional parameter to replace selection or entire contents.
- LoadRTF() - Now with optional parameter to replace selection or entire contents.
- SaveRTF()
Include file
Code: Select all
;Rich edit functions.
;Include basic formatting procedures by 'Freak',
;IRichEditOleCallback - place images into an editor gadget.
;Based on some Powerbasic code found at http://www.hellobasic.com/ by Edwin Knoppert
;and translated to Purebasic by Stephen Rodriguez.
;Coded in Purebasic 4.
;Enhanced by Nico - July 01 2007.
#STGM_SHARE_EXCLUSIVE=$00000010
#STGM_READWRITE = $00000002
#STGM_CREATE = $00001000
;Future proof!
CompilerIf Defined(ENM_LINK, #PB_Constant)
CompilerElse
#ENM_LINK = $04000000
CompilerEndIf
CompilerIf Defined(CFM_LINK, #PB_Constant)
CompilerElse
#CFM_LINK = $00000020
CompilerEndIf
CompilerIf Defined(CFE_LINK, #PB_Constant)
CompilerElse
#CFE_LINK = $0020
CompilerEndIf
CompilerIf Defined(CFE_SUBSCRIPT, #PB_Constant)
CompilerElse
#CFE_SUBSCRIPT = $00010000
CompilerEndIf
CompilerIf Defined(CFE_SUPERSCRIPT, #PB_Constant)
CompilerElse
#CFE_SUPERSCRIPT = $00020000
CompilerEndIf
CompilerIf Defined(CFM_SUBSCRIPT, #PB_Constant)
CompilerElse
#CFM_SUBSCRIPT = #CFE_SUBSCRIPT | #CFE_SUPERSCRIPT
#CFM_SUPERSCRIPT=#CFM_SUBSCRIPT
CompilerEndIf
CompilerIf Defined(CFM_BACKCOLOR, #PB_Constant)
CompilerElse
#CFM_BACKCOLOR =$4000000
CompilerEndIf
;-Declares.
Declare Editor_BackColor(Gadget, Color.l)
Declare Editor_Color(Gadget, Color.l)
Declare Editor_Font(Gadget, FontName.s)
Declare Editor_FontSize(Gadget, Fontsize.l)
Declare Editor_Format(Gadget, flags, alternate=0)
Declare Editor_Select(Gadget, LineStart.l, CharStart.l, LineEnd.l, CharEnd.l)
Declare Editor_Bulleted(Gadget)
Declare Editor_JustifyParagraph(Gadget, justify)
Declare Editor_CopyText(gadget)
Declare Editor_CutText(gadget)
Declare Editor_InsertText(gadget,Text$)
Declare Editor_PasteText(gadget)
Declare.l StreamDataCallback(dwCookie, pbBuff, cb, pcb)
Declare.l StreamFileInCallback(dwCookie, pbBuff, cb, pcb)
Declare.l StreamFileOutCallback(dwCookie, pbBuff, cb, pcb)
Structure RichEditOle
*pIntf.IRicheditOle
Refcount.l
hwnd.l
EndStructure
;The following variable forms the IRichEditOleCallback interface for a rich edit control.
Global NewList RichComObject.RichEditOle()
;The following variable points to the rtf stream when including rtf files.
Global prtf
;-*****USER FUNCTIONS***************************************************************************
;***********************************************************************************************
;The following procedure includes a text or an rtf file from a memory stream.
;Include the file using Include Binary etc.
;Returns zero if no error encountered.
;***********************************************************************************************
Procedure.l CatchRTF(gadget, datastart, dataend, format=#SF_TEXT, replaceall=0)
Protected edstr.EDITSTREAM
prtf = datastart
edstr\dwCookie = dataend
edstr\dwError = 0
edstr\pfnCallback = @StreamDataCallback()
SendMessage_(GadgetID(gadget), #EM_STREAMIN, format|replaceall, edstr)
ProcedureReturn edstr\dwError
EndProcedure
;The following is called repeatedly by Windows to stream data into an editor gadget.
Procedure.l StreamDataCallback(dwCookie, pbBuff, cb, pcb)
Protected result
result = 0
If prtf>=dwCookie
cb = 0
result = 1
ElseIf prtf+cb>=dwCookie
cb = dwCookie-prtf
EndIf
CopyMemory(prtf, pbBuff, cb)
prtf+cb
PokeL(pcb, cb)
ProcedureReturn result
EndProcedure
;***********************************************************************************************
;The following procedure loads text or an rtf file into an editor gadget.
;Returns zero if no error encountered.
;***********************************************************************************************
Procedure.l LoadRTF(gadget, filename.s, format=#SF_TEXT, replaceall=0)
Protected edstr.EDITSTREAM
edstr\dwCookie = ReadFile(#PB_Any, filename)
If edstr\dwCookie
edstr\dwError = 0
edstr\pfnCallback = @StreamFileInCallback()
SendMessage_(GadgetID(gadget), #EM_STREAMIN, format|replaceall, edstr)
CloseFile(edstr\dwCookie)
ProcedureReturn edstr\dwError
Else
ProcedureReturn 1
EndIf
EndProcedure
;The following is called repeatedly by Windows to stream data into an editor gadget from an external file.
Procedure.l StreamFileInCallback(dwCookie, pbBuff, cb, pcb)
Protected result, length
result=0
length=ReadData(dwCookie, pbBuff, cb)
PokeL(pcb, length)
If length = 0
result = 1
EndIf
ProcedureReturn result
EndProcedure
;***********************************************************************************************
;The following procedure saves the rtf content of an editor gadget to an external file.
;Returns zero if no error encountered.
;***********************************************************************************************
Procedure.l SaveRTF(gadget, filename.s)
Protected edstr.EDITSTREAM
edstr\dwCookie = CreateFile(#PB_Any, filename)
If edstr\dwCookie
edstr\dwError = 0
edstr\pfnCallback = @StreamFileOutCallback()
SendMessage_(GadgetID(gadget), #EM_STREAMOUT, #SF_RTF, edstr)
CloseFile(edstr\dwCookie)
ProcedureReturn edstr\dwError
Else
ProcedureReturn 1
EndIf
EndProcedure
;The following is called repeatedly by Windows to stream data from an editor gadget to an external file.
Procedure.l StreamFileOutCallback(dwCookie, pbBuff, cb, pcb)
Protected result, length
result=0
WriteData(dwCookie, pbBuff, cb)
PokeL(pcb, cb)
If cb = 0
result = 1
EndIf
ProcedureReturn result
EndProcedure
;-----------------------------------------------Character formatting.
Procedure Editor_BackColor(Gadget, Color.l)
format.CHARFORMAT2
format\cbSize = SizeOf(CHARFORMAT2)
format\dwMask = #CFM_BACKCOLOR
format\crBackColor = Color
SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure
; Set the Text color for the Selection
; in RGB format
Procedure Editor_Color(Gadget, Color.l)
format.CHARFORMAT2
format\cbSize = SizeOf(CHARFORMAT2)
format\dwMask = #CFM_COLOR
format\crTextColor = Color
SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure
; Set Font for the Selection
; You must specify a font name, the font doesn't need
; to be loaded
Procedure Editor_Font(Gadget, FontName.s)
format.CHARFORMAT2
format\cbSize = SizeOf(CHARFORMAT2)
format\dwMask = #CFM_FACE
PokeS(@format\szFaceName, FontName)
SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure
; Set Font Size for the Selection
; in pt
Procedure Editor_FontSize(Gadget, Fontsize.l)
format.CHARFORMAT2
format\cbSize = SizeOf(CHARFORMAT2)
format\dwMask = #CFM_SIZE
format\yHeight = FontSize*20
SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure
; Set Format of the Selection. This can be a combination of
; the following values:
; #CFE_BOLD
; #CFE_ITALIC
; #CFE_UNDERLINE
; #CFE_STRIKEOUT
; #CFE_LINK
; #CFE_SUBSCRIPT
; #CFE_SUPERSCRIPT
;If the optional parameter 'alternate' is non-zero then the formatting attributes specified in
;'flags' will be xored with those already present within the first character of the selection.
;This has the effect of removing individual attributes if already present.
;E.g. specifying #CFE_BOLD on an already bold selection, will remove the bold formatting etc.
Procedure Editor_Format(Gadget, flags, alternate=0)
format.CHARFORMAT2
format\cbSize = SizeOf(CHARFORMAT2)
If alternate
SendMessage_(GadgetID(Gadget), #EM_GETCHARFORMAT, 1, @format)
flags=format\dwEffects!flags
EndIf
format\dwMask = #CFM_ITALIC|#CFM_BOLD|#CFM_STRIKEOUT|#CFM_UNDERLINE|#CFM_LINK|#CFM_SUBSCRIPT|#CFM_SUPERSCRIPT
format\dwEffects = flags
SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure
; Selects Text inside an EditorGadget
; Line numbers range from 0 to CountGadgetItems(#Gadget)-1
; Char numbers range from 0 to the length of a line
; Set Line numbers to -1 to indicate the last line, and Char
; numbers to -1 to indicate the end of a line
; selecting from 0,1 to -1, -1 selects all.
Procedure Editor_Select(Gadget, LineStart.l, CharStart.l, LineEnd.l, CharEnd.l)
sel.CHARRANGE
sel\cpMin = SendMessage_(GadgetID(Gadget), #EM_LINEINDEX, LineStart, 0) + CharStart
If LineEnd = -1
LineEnd = SendMessage_(GadgetID(Gadget), #EM_GETLINECOUNT, 0, 0)-1
EndIf
sel\cpMax = SendMessage_(GadgetID(Gadget), #EM_LINEINDEX, LineEnd, 0)
If CharEnd = -1
sel\cpMax + SendMessage_(GadgetID(Gadget), #EM_LINELENGTH, sel\cpMax, 0)
Else
sel\cpMax + CharEnd
EndIf
SendMessage_(GadgetID(Gadget), #EM_EXSETSEL, 0, @sel)
EndProcedure
;-----------------------------------------------Paragraph formatting.
Procedure Editor_Bulleted(Gadget)
format.PARAFORMAT
format\cbSize = SizeOf(PARAFORMAT)
format\dwMask = #PFM_NUMBERING
format\wnumbering = #PFN_BULLET
SendMessage_(GadgetID(Gadget), #EM_SETPARAFORMAT, 0, @format)
EndProcedure
;Set paragraph justification.
;Can be one of the following values:
; #PFA_LEFT
; #PFA_RIGHT
; #PFA_CENTER
Procedure Editor_JustifyParagraph(Gadget, justify)
format.PARAFORMAT
format\cbSize = SizeOf(PARAFORMAT)
format\dwMask = #PFM_ALIGNMENT
format\wAlignment = justify
SendMessage_(GadgetID(Gadget), #EM_SETPARAFORMAT, 0, @format)
EndProcedure
;-----------------------------------------------Clipboard.
Procedure Editor_CopyText(gadget)
SendMessage_(GadgetID(gadget), #WM_COPY,0,0)
EndProcedure
Procedure Editor_CutText(gadget)
SendMessage_(GadgetID(gadget), #WM_CUT,0,0)
EndProcedure
Procedure Editor_InsertText(gadget,Text$)
ProcedureReturn SendMessage_(GadgetID(gadget),#EM_REPLACESEL,0,Text$)
EndProcedure
Procedure Editor_PasteText(gadget)
SendMessage_(GadgetID(gadget), #WM_PASTE,0,0)
EndProcedure
;-*****END USER FUNCTIONS***********************************************************************
;***********************************************************************************************
;Implementation procedures for OLE. Most are not actually used but are still needed.
;***********************************************************************************************
;***********************************************************************************************
;Set up the com interface for our rich edit control.
;***********************************************************************************************
Procedure.l RichEdit_SetInterface(hWnd)
Protected No_Com.l
ForEach RichComObject()
If RichComObject()\hwnd=hwnd
No_Com=1
Break
EndIf
Next
If No_Com=0
AddElement(RichComObject())
RichComObject()\pIntf = ?VTable
RichComObject()\hwnd=hwnd
SendMessage_(hWnd, #EM_SETOLECALLBACK, 0, RichComObject())
ProcedureReturn RichComObject()
EndIf
EndProcedure
Procedure.l RichEdit_QueryInterface(*pObject.RichEditOle, REFIID, *ppvObj.LONG)
Protected *pointeur.IRicheditOle
*pointeur=*pObject
If CompareMemory(REFIID, ?IID_IUnknown, 16)=1 Or CompareMemory(REFIID, ?IID_IRichEditOleCallback, 16)=1
Debug "QueryInterface"
*ppvObj\l = *pObject
*pointeur\AddRef()
ProcedureReturn #S_OK
Else
*ppvObject=0
ProcedureReturn #E_NOINTERFACE
EndIf
EndProcedure
Procedure.l RichEdit_AddRef(*pObject.RichEditOle)
*pObject\Refcount+1
ProcedureReturn *pObject\Refcount
EndProcedure
Procedure.l RichEdit_Release(*pObject.RichEditOle)
*pObject\Refcount-1
If *pObject\Refcount > 0
ProcedureReturn *pObject\Refcount
Else
;Remove entry in the linked list.
ForEach RichComObject()
If RichComObject()=*pObject
DeleteElement(RichComObject()) : Break
EndIf
Next
*pObject=0
EndIf
EndProcedure
Procedure.l RichEdit_GetInPlaceContext(*pObject.RichEditOle, lplpFrame, lplpDoc, lpFrameInfo)
Debug 1
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure.l RichEdit_ShowContainerUI(*pObject.RichEditOle, fShow)
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure.l RichEdit_QueryInsertObject(*pObject.RichEditOle, lpclsid, lpstg, cp)
ProcedureReturn #S_OK
EndProcedure
Procedure.l RichEdit_DeleteObject(*pObject.RichEditOle, lpoleobj)
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure.l RichEdit_QueryAcceptData(*pObject.RichEditOle, lpdataobj, lpcfFormat, reco, fReally, hMetaPict)
ProcedureReturn #S_OK
EndProcedure
Procedure.l RichEdit_ContextSensitiveHelp(*pObject.RichEditOle, fEnterMode)
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure.l RichEdit_GetClipboardData(*pObject.RichEditOle, lpchrg, reco, lplpdataobj)
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure.l RichEdit_GetDragDropEffect(*pObject.RichEditOle, fDrag, grfKeyState, pdwEffect)
;PokeL(pdwEffect,0) ;Uncomment this to prevent dropping to the editor gadget.
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure.l RichEdit_GetContextMenu(*pObject.RichEditOle, seltype.w, lpoleobj, lpchrg, lphmenu)
ProcedureReturn #E_NOTIMPL
EndProcedure
;The following function does the main work!
Procedure.l RichEdit_GetNewStorage(*pObject.RichEditOle, lplpstg)
Protected sc, lpLockBytes, t.ILockBytes
;Attempt to create a byte array object which acts as the 'foundation' for the upcoming compound file.
sc=CreateILockBytesOnHGlobal_(#Null, #True, @lpLockBytes)
If sc ;This means that the allocation failed.
ProcedureReturn sc
EndIf
;Allocation succeeded so we now attempt to create a compound file storage object.
sc=StgCreateDocfileOnILockBytes_(lpLockBytes, #STGM_SHARE_EXCLUSIVE|#STGM_READWRITE|#STGM_CREATE, 0, lplpstg)
t = lpLockBytes
t\Release()
EndProcedure
;***********************************************************************************************
DataSection
VTable:
Data.l @RichEdit_QueryInterface(), @RichEdit_AddRef(), @RichEdit_Release(), @RichEdit_GetNewStorage()
Data.l @RichEdit_GetInPlaceContext(), @RichEdit_ShowContainerUI(), @RichEdit_QueryInsertObject()
Data.l @RichEdit_DeleteObject(), @RichEdit_QueryAcceptData(), @RichEdit_ContextSensitiveHelp(), @RichEdit_GetClipboardData()
Data.l @RichEdit_GetDragDropEffect(), @RichEdit_GetContextMenu()
IID_IRichEditOleCallback: ;" 0x00020D03, 0, 0, 0xC0,0,0,0,0,0,0,0x46"
Data.l $00020D03
Data.w $0000,$0000
Data.b $C0,$00,$00,$00,$00,$00,$00,$46
IID_IUnknown: ;"{00000000-0000-0000-C000-000000000046}"
Data.l $00000000
Data.w $0000,$0000
Data.b $C0,$00,$00,$00,$00,$00,$00,$46
EndDataSection
