From 052a7a2ad13842c108fa0b6538a5bc73bbb06c08 Mon Sep 17 00:00:00 2001 From: skalogryz Date: Wed, 14 Sep 2016 13:28:09 +0000 Subject: [PATCH] richmemo: win32, assigning IRichMemoOLECallback object on RichMemo creation. The object would generate storages for incoming OLE object (needed for WinXP machines to load RTF embedded objects). based on the sample by engkin git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5159 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/richmemo/win32/win32richmemo.pas | 29 ++++++- .../richmemo/win32/win32richmemoole.pas | 87 ++++++++++++++++++- 2 files changed, 112 insertions(+), 4 deletions(-) diff --git a/components/richmemo/win32/win32richmemo.pas b/components/richmemo/win32/win32richmemo.pas index c8dcde5e0..d9ad3552e 100644 --- a/components/richmemo/win32/win32richmemo.pas +++ b/components/richmemo/win32/win32richmemo.pas @@ -167,6 +167,7 @@ var // the value can be set to nil to use system-native drawing only. // or set it to whatever function desired NCPaint : TNCPaintProc = nil; + AllocOLEObject : procedure (ARichMemo: TCustomRichMemo; AHandle: Windows.THandle; out OleCallback: IRichEditOleCallback); function GetSelRTF(amemo: TCustomRichMemo): string; @@ -505,6 +506,16 @@ begin Result:=Assigned(AWinControl) and (SendMessage(AWinControl.Handle, EM_CANPASTE, 0, 0)<>0); end; +procedure AssignOLECallback(ARichMemo: TCustomRichMemo; ahandle: Windows.THandle); +var + cb : IRichEditOleCallback; +begin + if not Assigned(AllocOLEObject) then Exit; + AllocOLEObject(ARichMemo, ahandle, cb); + if Assigned(cb) then + Windows.SendMessage(ahandle, EM_SETOLECALLBACK, 0, LPARAM(cb)); +end; + class function TWin32WSCustomRichMemo.CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; var @@ -562,6 +573,11 @@ begin // SetMaxLength call, see above. SendMessage(AWincontrol.Handle, EM_EXLIMITTEXT, 0, LParam(-1)); + // Setting OLE callback. + if AWinControl is TCustomRichMemo then // sanity checl + AssignOLECallback(TCustomRichMemo(AWincontrol), AWincontrol.Handle); + + // memo is not a transparent control -> no need for parentpainting Params.WindowInfo^.ParentMsgHandler := @RichEditNotifyProc; Params.WindowInfo^.needParentPaint := false; @@ -1393,8 +1409,6 @@ begin end; end; - - type TStreamText = record buf : AnsiString; @@ -1403,7 +1417,7 @@ type function Read(dwCookie:PDWORD; pbBuff:LPBYTE; cb:LONG; var pcb:LONG):DWORD; stdcall; var - p : PStreamText; + //p : PStreamText; b : string; i : integer; begin @@ -1441,8 +1455,17 @@ begin Result:=tt.buf; end; +procedure DefAllocOleObject(ARichMemo: TCustomRichMemo; AHandle: Windows.THandle; out OleCallback: IRichEditOleCallback); +var + cb : TRichEditCallback; +begin + cb:=TRichEditCallback.Create; + OleCallBack:=cb; +end; + initialization NCPaint := @ThemedNCPaint; + AllocOLEObject := @DefAllocOleObject; end. diff --git a/components/richmemo/win32/win32richmemoole.pas b/components/richmemo/win32/win32richmemoole.pas index c89fb7ec5..e34307da7 100644 --- a/components/richmemo/win32/win32richmemoole.pas +++ b/components/richmemo/win32/win32richmemoole.pas @@ -21,7 +21,7 @@ unit Win32RichMemoOle; interface uses - Windows, ActiveX, ComObj; + Windows, ActiveX, ComObj, Win32RichMemoProc, RichEdit; {.$define oledebug} @@ -80,8 +80,93 @@ type function Getadvise(paspects:pdword;padvf:pdword;out ppadvsink: IADviseSink):HRESULT;stdcall; end; + { TRichEditCallback } + + TRichEditCallback = class(TInterfacedObject, IRichEditOleCallback) + function GetNewStorage(out stg: IStorage): HRESULT; stdcall; + function GetInPlaceContext(out Frame: IOleInPlaceFrame; + out Doc: IOleInPlaceUIWindow; + lpFrameInfo: POleInPlaceFrameInfo): HRESULT; stdcall; + function ShowContainerUI(fShow: BOOL): HRESULT; stdcall; + function QueryInsertObject(const clsid: TCLSID; const stg: IStorage; + cp: LongInt): HRESULT; stdcall; + function DeleteObject(const oleobj: IOleObject): HRESULT; stdcall; + function QueryAcceptData(const dataobj: IDataObject; + var cfFormat: TClipFormat; reco: DWORD; fReally: BOOL; + hMetaPict: HGLOBAL): HRESULT; stdcall; + function ContextSensitiveHelp(fEnterMode: BOOL): HRESULT; stdcall; + function GetClipboardData(const chrg: RichEdit.TCharRange; reco: DWORD; + out dataobj: IDataObject): HRESULT; stdcall; + function GetDragDropEffect(fDrag: BOOL; grfKeyState: DWORD; + var dwEffect: DWORD): HRESULT; stdcall; + function GetContextMenu(seltype: Word; oleobj: IOleObject; + const chrg: TCharRange; var menu: HMENU): HRESULT; stdcall; + end; + + implementation +{ TRichEditCallback } + +function TRichEditCallback.GetNewStorage(out stg: IStorage): HRESULT; stdcall; +begin + StgCreateDocfile(nil, STGM_READWRITE or STGM_SHARE_EXCLUSIVE, 0,stg); + Result := S_OK; +end; + +function TRichEditCallback.GetInPlaceContext(out Frame: IOleInPlaceFrame; out + Doc: IOleInPlaceUIWindow; lpFrameInfo: POleInPlaceFrameInfo): HRESULT; + stdcall; +begin + Result := E_NOTIMPL; +end; + +function TRichEditCallback.ShowContainerUI(fShow: BOOL): HRESULT; stdcall; +begin + Result := E_NOTIMPL; +end; + +function TRichEditCallback.QueryInsertObject(const clsid: TCLSID; + const stg: IStorage; cp: LongInt): HRESULT; stdcall; +begin + Result := S_OK; +end; + +function TRichEditCallback.DeleteObject(const oleobj: IOleObject): HRESULT; stdcall; +begin + Result := E_NOTIMPL; +end; + +function TRichEditCallback.QueryAcceptData(const dataobj: IDataObject; + var cfFormat: TClipFormat; reco: DWORD; fReally: BOOL; hMetaPict: HGLOBAL + ): HRESULT; stdcall; +begin + Result := E_NOTIMPL; +end; + +function TRichEditCallback.ContextSensitiveHelp(fEnterMode: BOOL): HRESULT; stdcall; +begin + Result := E_NOTIMPL; +end; + +function TRichEditCallback.GetClipboardData(const chrg: TCharRange; reco: DWORD; out + dataobj: IDataObject): HRESULT; stdcall; +begin + Result := E_NOTIMPL; +end; + +function TRichEditCallback.GetDragDropEffect(fDrag: BOOL; grfKeyState: DWORD; + var dwEffect: DWORD): HRESULT; stdcall; +begin + Result := E_NOTIMPL; +end; + +function TRichEditCallback.GetContextMenu(seltype: Word; oleobj: IOleObject; + const chrg: TCharRange; var menu: HMENU): HRESULT; stdcall; +begin + Result := E_NOTIMPL; +end; + { TCustomObject } function TCustomObject.SetClientSite(const clientSite: IOleClientSite