Implementing the IRichEditOleCallback interface allows to perform insertion, deletion, cut, copy and paste, and drag operations with objects, such images, in a rich edit control.
The following example demonstrates how to implement the IRichEditOleCallback interface.
' ########################################################################################
' RichOle demo
' ########################################################################################
#DIM ALL
#COMPILE EXE
%UNICODE = 1
%USERICHEDIT = 1
' // Include files for external files
#INCLUDE ONCE "CWindow.inc" ' // CWindow class
#INCLUDE ONCE "RichOle.inc"
' Control identifier
%IDC_RICHEDIT = 101
' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS WSTRINGZ PTR, BYVAL nCmdShow AS LONG) AS LONG
' // Set process DPI aware
' SetProcessDPIAware
' // Create an instance of the class
LOCAL pWindow AS IWindow
pWindow = CLASS "CWindow"
IF ISNOTHING(pWindow) THEN EXIT FUNCTION
' // Create the main window
' // Note: CW_USEDEFAULT is used as the default value When passing 0's as the width and height
pWindow.CreateWindow(%NULL, "Rich Ole Demo", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
' // Set the client size
pWindow.SetClientSize 500, 320
' // Center the window
pWindow.CenterWindow
' // Add a subclassed rich edit control without coordinates (it will be resized in WM_SIZE, below)
LOCAL hRichEdit AS DWORD
hRichEdit = pWindow.AddRichEdit(pWindow.hwnd, %IDC_RICHEDIT, "RichEdit box", 0, 0, 0, 0, 0, 0, CODEPTR(RichEditSubclassProc))
' // Specify which notifications the control sends to its parent window
RichEdit_SetEventMask hRichEdit, %ENM_CHANGE
' // Set the IRichEditOleCallback object.
' // The control calls the AddRef function for the object before returning.
LOCAL pRichEditOleCallback AS IRichEditOleCallbackImpl
pRichEditOleCallback = CLASS "CRichEditOleCallback"
RichEdit_SetOleCallback hRichEdit, OBJPTR(pRichEditOleCallback)
' // Load the file
RichEdit_LoadRtfFromFile hRichEdit, EXE.Path$ & "Test.rtf"
' // Default message pump (you can replace it with your own)
pWindow.DoEvents(nCmdShow)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Main window callback
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
LOCAL tlf AS LOGFONT ' font attributes
LOCAL tcf AS CHARFORMAT ' rich edit character formatting information
LOCAL ptnmhdr AS NMHDR PTR ' information about a notification message
LOCAL ptmmi AS MINMAXINFO PTR ' pointer to the maximized and tracking info
LOCAL hwndChild AS DWORD ' handle of child window
LOCAL hFont AS DWORD ' handle of font used by form
LOCAL dwMask AS DWORD ' specifies the attributes of an item to retrieve or set
LOCAL hDC AS DWORD ' handle of memory device context
STATIC pWindow AS IWindow ' // Reference to the IWindow interface
SELECT CASE uMsg
CASE %WM_CREATE
' // Get a reference to the IWindow interface from the CREATESTRUCT structure
pWindow = CWindow_GetObjectFromCreateStruct(lParam)
EXIT FUNCTION
CASE %WM_COMMAND
SELECT CASE LO(WORD, wParam)
CASE %IDCANCEL
' // If the Escape key has been pressed...
IF HI(WORD, wParam) = %BN_CLICKED THEN
' // ... close the application by sending a WM_CLOSE message
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
CASE %IDC_RICHEDIT
IF HI(WORD, wParam) = %EN_CHANGE THEN
END IF
END SELECT
CASE %WM_NOTIFY
ptnmhdr = lParam
SELECT CASE @ptnmhdr.idFrom
END SELECT
CASE %WM_SETFOCUS
' Set the keyboard focus to the first control that is
' visible, not disabled, and has the WS_TABSTOP style
SetFocus GetNextDlgTabItem(hwnd, %NULL, %FALSE)
CASE %WM_DESTROY
PostQuitMessage 0
EXIT FUNCTION
CASE %WM_SIZE
IF wParam <> %SIZE_MINIMIZED THEN
pWindow.MoveWindow GetDlgItem(hwnd, %IDC_RICHEDIT), 10, 10, pWindow.ClientWidth - 20, pWindow.ClientHeight - 20, %TRUE
END IF
END SELECT
FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' RichEdit control subclassed procedure
' ========================================================================================
FUNCTION RichEditSubclassProc ( _
BYVAL hwnd AS DWORD, _ ' control handle
BYVAL uMsg AS DWORD, _ ' type of message
BYVAL wParam AS DWORD, _ ' first message parameter
BYVAL lParam AS LONG _ ' second message parameter
) AS LONG
LOCAL lpOldWndProc AS DWORD ' address of original window procedure
lpOldWndProc = GetProp(hwnd, "OLDWNDPROC")
SELECT CASE uMsg
CASE %WM_DESTROY
' // Remove control subclassing
SetWindowLong hwnd, %GWL_WNDPROC, RemoveProp(hwnd, "OLDWNDPROC")
END SELECT
FUNCTION = CallWindowProc(lpOldWndProc, hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ########################################################################################
' IRichEditOleCallback interface
' IID = 00020D03-0000-0000-C000-000000000046
' Inherited interface = IUnknown
' Custom implementation of the IRichEditOleCallback interface.
' Used by the RichEdit to get OLE-related stuff from the application using RichEdit.
' Note: Callback interfaces must be declared AS COMMON to avoid code removal.
' ########################################################################################
CLASS CRichEditOleCallback AS COMMON
INTERFACE IRichEditOleCallbackImpl $IID_IRichEditOleCallback
INHERIT IUnknown
' =====================================================================================
METHOD GetNewStorage ( _ ' VTable offset = 12
BYREF lplpstg AS IStorage _ ' LPSTORAGE FAR * lplpstg
) AS LONG ' HRESULT
LOCAL hr AS LONG
LOCAL pILockBytes AS ILockBytes
hr = CreateILockBytesOnHGlobal(%NULL, %TRUE, pILockBytes)
IF FAILED(hr) THEN METHOD = hr : EXIT METHOD
hr = StgCreateDocfileOnILockBytes(pILockBytes, _
%STGM_SHARE_EXCLUSIVE OR %STGM_READWRITE OR %STGM_CREATE, _
0, lplpstg)
METHOD = hr
END METHOD
' =====================================================================================
METHOD GetInPlaceContext ( _ ' VTable offset = 16
BYREF lplpFrame AS IOleInPlaceFrame _ ' LPOLEINPLACEFRAME FAR * lplpFrame
, BYREF lplpDoc AS IOleInPlaceUIWindow _ ' LPOLEINPLACEUIWINDOW FAR * lplpDoc
, BYREF lpFrameInfo AS OLEINPLACEFRAMEINFO _ ' LPOLEINPLACEFRAMEINFO lpFrameInfo
) AS LONG ' HRESULT
METHOD = %E_NOTIMPL
END METHOD
' =====================================================================================
METHOD ShowContainerUI ( _ ' VTable offset = 20
BYVAL fShow AS LONG _ ' BOOL fShow
) AS LONG ' HRESULT
METHOD = %E_NOTIMPL
END METHOD
' =====================================================================================
METHOD QueryInsertObject ( _ ' VTable offset = 24
BYREF lpclsid As GUID _ ' LPCLSID lpclsid
, BYVAL lpstg AS IStorage _ ' LPSTORAGE lpstg
, BYVAL cp AS LONG _ ' LONG cp
) AS LONG ' HRESULT
METHOD = %S_OK
END METHOD
' =====================================================================================
METHOD DeleteObject ( _ ' VTable offset = 28
BYVAL lpoleobj AS IOleObject _ ' LPOLEOBJECT lpoleobj
) AS LONG ' HRESULT
METHOD = %S_OK
END METHOD
' =====================================================================================
METHOD QueryAcceptData ( _ ' VTable offset = 32
BYVAL lpdataobj AS IOleObject _ ' LPDATAOBJECT lpdataobj
, BYREF lpcfFormat AS DWORD _ ' CLIPFORMAT FAR * lpcfFormat
, BYVAL reco AS DWORD _ ' DWORD reco
, BYVAL fReally AS LONG _ ' BOOL fReally
, BYVAL hMetaPict AS DWORD _ ' HGLOBAL hMetaPict
) AS LONG ' HRESULT
METHOD = %E_NOTIMPL
END METHOD
' =====================================================================================
METHOD ContextSensitiveHelp ( _ ' VTable offset = 36
BYVAL fEnterMode AS LONG _ ' BOOL fEnterMode
) AS LONG ' HRESULT
METHOD = %E_NOTIMPL
END METHOD
' =====================================================================================
METHOD GetClipboardData ( _ ' VTable offset = 40
BYREF lpchrg AS CHARRANGE _ ' CHARRANGE FAR * lpchrg
, BYVAL reco AS DWORD _ ' DWORD reco
, BYREF lplpdataobj AS IOleObject _ ' LPDATAOBJECT FAR * lplpdataobj
) AS LONG ' HRESULT
METHOD = %E_NOTIMPL
END METHOD
' =====================================================================================
METHOD GetDragDropEffect ( _ ' VTable offset = 44
BYVAL fDrag AS LONG _ ' BOOL fDrag
, BYVAL grfKeyState AS DWORD _ ' DWORD grfKeyState
, BYREF pdwEffect AS DWORD _ ' LPDWORD pdwEffect
) AS LONG ' HRESULT
METHOD = %E_NOTIMPL
END METHOD
' =====================================================================================
METHOD GetContextMenu ( _ ' VTable offset = 48
BYVAL seltype AS WORD _ ' WORD seltype
, BYVAL lpoleobj AS IOleObject _ ' LPOLEOBJECT lpoleobj
, BYREF lpchrg AS CHARRANGE _ ' CHARRANGE FAR * lpchrg
, BYREF lphmenu AS DWORD _ ' HMENU FAR * lphmenu
) AS LONG ' HRESULT
METHOD = %E_NOTIMPL
END METHOD
' =====================================================================================
END INTERFACE
END CLASS
' ========================================================================================