paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

richmemo: win32, assigning IRichMemoOLECallback object on RichMemo creation.

Browse Source 
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
This commit is contained in:
skalogryz 2016-09-14 13:28:09 +00:00
parent e55cc71598
commit 052a7a2ad1
2 changed files with 112 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
components/richmemo/win32/win32richmemo.pas
View File

@ -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.

87
components/richmemo/win32/win32richmemoole.pas
View File

@ -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