• Welcome to Powerbasic Museum 2020-B.
 

How to implement the IRichEditOleCallback interface

Started by José Roca, August 31, 2011, 12:11:01 AM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

José Roca

 
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
' ========================================================================================