pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

richmemo: implementation of win32 inline objects

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3847 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz
2014-12-20 16:45:53 +00:00
parent 7c11c226d3
commit 9b07721e51
3 changed files with 529 additions and 18 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -25,7 +25,7 @@ interface
uses uses
// Win32 headers // Win32 headers
Windows, RichEdit, Windows, RichEdit, ActiveX,
// RTL headers // RTL headers
Classes, SysUtils, Classes, SysUtils,
// LCL headers // LCL headers
@ -34,7 +34,7 @@ uses
// Win32WidgetSet // Win32WidgetSet
Win32WSControls, Win32Int, Win32WSStdCtrls, win32proc, Win32WSControls, Win32Int, Win32WSStdCtrls, win32proc,
// RichMemo headers // RichMemo headers
RichMemo, WSRichMemo, Win32RichMemoProc; RichMemo, WSRichMemo, Win32RichMemoProc, Win32RichMemoOle;
type type
@ -105,8 +105,28 @@ type
const SearchOpts: TIntSearchOpt): Integer; override; const SearchOpts: TIntSearchOpt): Integer; override;
class procedure SetZoomFactor(const AWinControl: TWinControl; AZoomFactor: Double); override; class procedure SetZoomFactor(const AWinControl: TWinControl; AZoomFactor: Double); override;
class function InlineInsert(const AWinControl: TWinControl; ATextStart, ATextLength: Integer;
const ASize: TSize; AHandler: TRichMemoInline; var wsObj: TRichMemoInlineWSObject): Boolean; override;
class procedure InlineInvalidate(const AWinControl: TWinControl;
AHandler: TRichMemoInline; wsObj: TRichMemoInlineWSObject); override;
end; end;
{ TWin32Inline }
TWin32Inline = class(TCustomDataViewObject, IOleObject, IDataObject, IViewObject)
public
richMemo : TCustomRichMemo;
canvas : TCanvas;
rminline : TRichMemoInline;
isvis : Boolean;
function Draw(dwDrawAspect:DWord;LIndex:Long;pvaspect:pointer;ptd:PDVTARGETDEVICE;hdcTargetDev:HDC; hdcDraw:HDC;lprcBounds:PRECTL;lprcWBounds:PRECTL;pfncontinue:TContinueCallback;dwcontinue:ULONG_PTR):HResult; stdcall;
function GetExtent(dwDrawAspect: DWORD; out size: TPoint): HResult;StdCall;
function Close(dwSaveOption: DWORD): HResult;StdCall;
destructor Destroy; override;
end;
implementation implementation
type type
@ -169,6 +189,64 @@ begin
end; end;
end; end;
{ TWin32Inline }
function TWin32Inline.Draw(dwDrawAspect: DWord; LIndex: Long;
pvaspect: pointer; ptd: PDVTARGETDEVICE; hdcTargetDev: HDC; hdcDraw: HDC;
lprcBounds: PRECTL; lprcWBounds: PRECTL; pfncontinue: TContinueCallback;
dwcontinue: ULONG_PTR): HResult; stdcall;
var
rst : Boolean;
pts : Windows.TPOINT;
sz : TSize;
begin
if not isvis then begin
isvis:=true;
rminline.SetVisible(isvis);
end;
canvas.Handle:=hdcDraw;
rst:= Assigned(lprcBounds);
if rst then begin
Windows.OffsetViewportOrgEx(hdcDraw, lprcBounds^.left, lprcBounds^.top, @pts);
sz.cx:=lprcBounds^.right - lprcBounds^.left;
sz.cy:=lprcBounds^.bottom - lprcBounds^.top;
end else begin
sz.cx:=0;
sz.cy:=0;
end;
rminline.Draw(canvas, sz);
if rst then Windows.OffsetViewportOrgEx(hdcDraw, pts.x, pts.y, nil);
Result:=S_OK;
end;
function TWin32Inline.GetExtent(dwDrawAspect: DWORD; out size: TPoint
): HResult; StdCall;
begin
if not isvis then begin
rminline.SetVisible(true);
isvis:=true;
end;
Result:=inherited GetExtent(dwDrawAspect, size);
end;
function TWin32Inline.Close(dwSaveOption: DWORD): HResult; StdCall;
begin
if isvis then begin
rminline.SetVisible(false);
isvis:=false;
end;
Result:=inherited Close(dwSaveOption);
end;
destructor TWin32Inline.Destroy;
begin
rminline.Free;
inherited Destroy;
end;
{ TWin32RichMemoStringsW } { TWin32RichMemoStringsW }
constructor TWin32RichMemoStringsW.Create(AHandle: HWND; TheOwner: TWinControl); constructor TWin32RichMemoStringsW.Create(AHandle: HWND; TheOwner: TWinControl);
@ -718,5 +796,80 @@ begin
SendMessage( AWinControl.Handle, EM_SETZOOM, round(AZoomFactor * DN), DN); SendMessage( AWinControl.Handle, EM_SETZOOM, round(AZoomFactor * DN), DN);
end; end;
class function TWin32WSCustomRichMemo.InlineInsert(
const AWinControl: TWinControl; ATextStart, ATextLength: Integer;
const ASize: TSize; AHandler: TRichMemoInline;
var wsObj: TRichMemoInlineWSObject): Boolean;
var
hnd : THandle;
rch : IRichEditOle;
Fmt : FORMATETC;
LockBytes: ILockBytes;
ClientSite: IOleClientSite;
Storage: IStorage;
Image: IOleObject;
c: TWin32Inline;
Obj: TREOBJECT;
sl, ss: Integer;
const
PointSize = 72.0;
RtfSizeToInch = 2.54 * 1000.0;
SizeFactor = 1 / PointSize * RtfSizeToInch;
begin
Result:=False;
if not Assigned(RichEditManager) or not Assigned(AWinControl) then Exit;
hnd:=(AWinControl.Handle);
RichEditManager.GetSelection(hnd, ss, sl);
try
SendMessage(hnd, EM_GETOLEINTERFACE, 0, LPARAM(@rch));
FillChar(Fmt, sizeoF(Fmt), 0);
Fmt.dwAspect:=DVASPECT_CONTENT;
Fmt.lindex:=-1;
CreateILockBytesOnHGlobal(0, True, LockBytes);
StgCreateDocfileOnILockBytes(LockBytes, STGM_SHARE_EXCLUSIVE or STGM_CREATE or STGM_READWRITE, 0, Storage);
rch.GetClientSite(ClientSite);
c:=TWin32Inline.Create;
c.richMemo:=TCustomRichMemo(AWinControl);
c.canvas:=TCanvas.Create;
c.rminline:=AHandler;
Image:=c;
OleSetContainedObject(Image, True);
FillChar(Obj, sizeof(Obj),0);
Obj.cbStruct := SizeOf(Obj);
Obj.cp := REO_CP_SELECTION;
Image.GetUserClassID(Obj.clsid);
Obj.poleobj := Image;
Obj.pstg := Storage;
Obj.polesite := ClientSite;
Obj.dvaspect := DVASPECT_CONTENT;
Obj.dwFlags := REO_OWNERDRAWSELECT;
Obj.sizel.cx:=round(ASize.cx * SizeFactor);
Obj.sizel.cy:=round(ASize.cy * SizeFactor);
Result:= Succeeded(rch.InsertObject(obj));
if Result then wsObj:=c;
finally
RichEditManager.SetSelection(hnd, ss, sl);
end;
end;
class procedure TWin32WSCustomRichMemo.InlineInvalidate(
const AWinControl: TWinControl; AHandler: TRichMemoInline;
wsObj: TRichMemoInlineWSObject);
begin
//inherited InlineInvalidate(AWinControl, AHandler, wsObj);
if not Assigned(AHandler) or not Assigned(wsObj) or (not (wsObj is TWin32Inline)) then Exit;
if not Assigned(TWin32Inline(wsObj).fSink) then Exit;
TWin32Inline(wsObj).fSink.OnViewChange(DVASPECT_CONTENT, -1);
end;
end. end.

346
components/richmemo/win32/win32richmemoole.pas Normal file
View File

@ -0,0 +1,346 @@
{
Win32RichMemoOle.pas
Author: Dmitry 'skalogryz' Boyarintsev
*****************************************************************************
* *
* This file is part of the Lazarus Component Library (LCL) *
* *
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
}
unit Win32RichMemoOle;
interface
uses
Windows, ActiveX, ComObj
,RichMemo;
{.$define oledebug}
type
{ TCustomObject }
TCustomObject = class(TInterfacedObject, IOleObject)
protected
fSink : IAdviseSink;
function SetClientSite(const clientSite: IOleClientSite): HResult;StdCall;
function GetClientSite(out clientSite: IOleClientSite): HResult;StdCall;
function SetHostNames(szContainerApp: POleStr; szContainerObj: POleStr): HResult;StdCall;
function Close(dwSaveOption: DWORD): HResult;StdCall;
function SetMoniker(dwWhichMoniker: DWORD; const mk: IMoniker): HResult;StdCall;
function GetMoniker(dwAssign: DWORD; dwWhichMoniker: DWORD; out mk: IMoniker): HResult;StdCall;
function InitFromData(const dataObject: IDataObject; fCreation: BOOL; dwReserved: DWORD): HResult;StdCall;
function GetClipboardData({%H-}dwReserved: DWORD; out {%H-}dataObject: IDataObject): HResult;StdCall;
function DoVerb(iVerb: LONG; msg: PMsg; const activeSite: IOleClientSite; lindex: LONG; hwndParent: HWND; const posRect: TRect): HResult;StdCall;
function EnumVerbs(out {%H-}enumOleVerb: IEnumOleVerb): HResult;StdCall;
function Update: HResult;StdCall;
function IsUpToDate: HResult;StdCall;
function GetUserClassID(out clsid: TCLSID): HResult;StdCall;
function GetUserType(dwFormOfType: DWORD; out pszUserType: POleStr): HResult;StdCall;
function SetExtent(dwDrawAspect: DWORD; const size: TPoint): HResult;StdCall;
function GetExtent(dwDrawAspect: DWORD; out size: TPoint): HResult;StdCall;
function Advise(const advSink: IAdviseSink; out dwConnection: Longint): HResult;StdCall;
function Unadvise(dwConnection: DWORD): HResult;StdCall;
function EnumAdvise(out aenumAdvise: IEnumStatData): HResult;StdCall;
function GetMiscStatus(dwAspect: DWORD; out dwStatus: DWORD): HResult;StdCall;
function SetColorScheme(const logpal: TLogPalette): HResult;StdCall;
end;
{ TCustomDataObject }
TCustomDataObject = class(TCustomObject, IOleObject, IDataObject)
Function GetData(Const formatetcIn : FORMATETC;Out medium : STGMEDIUM):HRESULT; STDCALL;
Function GetDataHere(CONST pformatetc : FormatETC; Out medium : STGMEDIUM):HRESULT; STDCALL;
Function QueryGetData(const pformatetc : FORMATETC):HRESULT; STDCALL;
Function GetCanonicalFormatEtc(const pformatetcIn : FORMATETC;Out pformatetcOut : FORMATETC):HResult; STDCALl;
Function SetData (Const pformatetc : FORMATETC;const medium:STGMEDIUM;FRelease : BOOL):HRESULT; StdCall;
Function EnumFormatEtc(dwDirection : DWord; OUT enumformatetcpara : IENUMFORMATETC):HRESULT; StdCall;
Function DAdvise(const formatetc : FORMATETC;advf :DWORD; CONST AdvSink : IAdviseSink;OUT dwConnection:DWORD):HRESULT;StdCall;
Function DUnadvise(dwconnection :DWord) :HRESULT;StdCall;
Function EnumDAdvise(Out aenumAdvise : IEnumStatData):HResult;StdCall;
end;
{ TCustomDataViewObject }
TCustomDataViewObject = class(TCustomDataObject, IOleObject, IDataObject, IViewObject)
function Draw(dwDrawAspect:DWord;LIndex:Long;pvaspect:pointer;ptd:PDVTARGETDEVICE;hdcTargetDev:HDC; hdcDraw:HDC;lprcBounds:PRECTL;lprcWBounds:PRECTL;pfncontinue:TContinueCallback;dwcontinue:ULONG_PTR):HResult; stdcall;
function GetColorSet(wDrawAspect:DWord;LIndex:Long;pvaspect:pointer;ptd:PDVTARGETDEVICE;hdcTargetDev:HDC;var ppcolorset:PLogPalette):HREsult; stdcall;
function Freeze(dwDrawAspect:DWord;LIndex:Long;pvaspect:pointer;pdwfreeze:pdword):HResult;stdcall;
function Unfreeze(dwfreeze:dword):HResult; stdcall;
function SetAdvise(aspects:DWORD;advf:DWORD;padvSink:IAdviseSink):HRESULT;stdcall;
function Getadvise(paspects:pdword;padvf:pdword;out ppadvsink: IADviseSink):HRESULT;stdcall;
end;
implementation
{ TCustomObject }
function TCustomObject.SetClientSite(const clientSite: IOleClientSite
): HResult; StdCall;
begin
{$ifdef oledebug}writeln('IOleObject.SetClientSide');{$endif}
Result:=S_OK;
end;
function TCustomObject.GetClientSite(out clientSite: IOleClientSite): HResult;
StdCall;
begin
{$ifdef oledebug}writeln('IOleObject.GetClientSite');{$endif}
Result:=S_OK;
end;
function TCustomObject.SetHostNames(szContainerApp: POleStr;
szContainerObj: POleStr): HResult; StdCall;
begin
{$ifdef oledebug}writeln('IOleObject.SetHostNames');{$endif}
Result:=S_OK;
end;
function TCustomObject.Close(dwSaveOption: DWORD): HResult; StdCall;
begin
{$ifdef oledebug}writeln('IOleObject.Close');{$endif}
Result:=S_OK;
end;
function TCustomObject.SetMoniker(dwWhichMoniker: DWORD; const mk: IMoniker
): HResult; StdCall;
begin
{$ifdef oledebug}writeln('IOleObject.SetMoniker');{$endif}
Result:=S_OK;
end;
function TCustomObject.GetMoniker(dwAssign: DWORD; dwWhichMoniker: DWORD; out
mk: IMoniker): HResult; StdCall;
begin
{$ifdef oledebug}writeln('IOleObject.GetMoniker');{$endif}
Result:=E_NOTIMPL;
end;
function TCustomObject.InitFromData(const dataObject: IDataObject;
fCreation: BOOL; dwReserved: DWORD): HResult; StdCall;
begin
{$ifdef oledebug}writeln('IOleObject.InitFromData');{$endif}
Result:=S_OK;
end;
function TCustomObject.GetClipboardData(dwReserved: DWORD; out
dataObject: IDataObject): HResult; StdCall;
begin
{$ifdef oledebug}writeln('IOleObject.GetClipboardData');{$endif}
Result:=E_NOTIMPL;
end;
function TCustomObject.DoVerb(iVerb: LONG; msg: PMsg;
const activeSite: IOleClientSite; lindex: LONG; hwndParent: HWND;
const posRect: TRect): HResult; StdCall;
begin
{$ifdef oledebug}writeln('IOleObject.DoVerb');{$endif}
Result:=S_OK;
end;
function TCustomObject.EnumVerbs(out enumOleVerb: IEnumOleVerb): HResult;
StdCall;
begin
{$ifdef oledebug}writeln('IOleObject.EnumVerbs');{$endif}
Result:=S_OK;
end;
function TCustomObject.Update: HResult; StdCall;
begin
{$ifdef oledebug}writeln('IOleObject.Update');{$endif}
Result:=S_OK;
end;
function TCustomObject.IsUpToDate: HResult; StdCall;
begin
{$ifdef oledebug}writeln('IOleObject.IsUpToDate');{$endif}
Result:=S_OK;
end;
function TCustomObject.GetUserClassID(out clsid: TCLSID): HResult; StdCall;
begin
{$ifdef oledebug}writeln('IOleObject.GetUserClassID');{$endif}
Result:=S_OK;
end;
function TCustomObject.GetUserType(dwFormOfType: DWORD; out pszUserType: POleStr
): HResult; StdCall;
begin
{$ifdef oledebug}writeln('IOleObject.GetUserType');{$endif}
Result:=S_OK;
end;
function TCustomObject.SetExtent(dwDrawAspect: DWORD; const size: TPoint
): HResult; StdCall;
begin
{$ifdef oledebug}writeln('IOleObject.SetExtent');{$endif}
Result:=S_OK;
end;
function TCustomObject.GetExtent(dwDrawAspect: DWORD; out size: TPoint
): HResult; StdCall;
begin
{$ifdef oledebug}writeln('IOleObject.GetExtent');{$endif}
Result:=S_OK;
end;
function TCustomObject.Advise(const advSink: IAdviseSink; out
dwConnection: Longint): HResult; StdCall;
begin
{$ifdef oledebug}writeln('IOleObject.Advise');{$endif}
fSink := advSink;
dwConnection:=1;
Result:=S_OK;
end;
function TCustomObject.Unadvise(dwConnection: DWORD): HResult; StdCall;
begin
{$ifdef oledebug}writeln('IOleObject.Unadvise');{$endif}
fSink:=nil;
Result:=S_OK;
end;
function TCustomObject.EnumAdvise(out aenumAdvise: IEnumStatData): HResult;
StdCall;
begin
{$ifdef oledebug}writeln('IOleObject.EnumAdvise');{$endif}
Result:=S_OK;
end;
function TCustomObject.GetMiscStatus(dwAspect: DWORD; out dwStatus: DWORD
): HResult; StdCall;
begin
{$ifdef oledebug}writeln('IOleObject.GetMiscStatus');{$endif}
Result:=S_OK;
end;
function TCustomObject.SetColorScheme(const logpal: TLogPalette): HResult;
StdCall;
begin
{$ifdef oledebug}writeln('IOleObject.SetColorScheme');{$endif}
Result:=S_OK;
end;
{ TCustomDataObject }
function TCustomDataObject.GetData(const formatetcIn: FORMATETC; out
medium: STGMEDIUM): HRESULT; STDCALL;
begin
{$ifdef oledebug}writeln('IDataObject.getData');{$endif}
Result:=S_OK;
end;
function TCustomDataObject.GetDataHere(const pformatetc: FormatETC; out
medium: STGMEDIUM): HRESULT; STDCALL;
begin
{$ifdef oledebug}writeln('IDataObject.GetDataHere');{$endif}
Result:=S_OK;
end;
function TCustomDataObject.QueryGetData(const pformatetc: FORMATETC): HRESULT;
STDCALL;
begin
{$ifdef oledebug}writeln('IDataObject.QueryGetData');{$endif}
Result:=S_OK;
end;
function TCustomDataObject.GetCanonicalFormatEtc(const pformatetcIn: FORMATETC;
out pformatetcOut: FORMATETC): HResult; STDCALl;
begin
{$ifdef oledebug}writeln('IDataObject.GetCanonicalFormatEtc');{$endif}
Result:=S_OK;
end;
function TCustomDataObject.SetData(const pformatetc: FORMATETC;
const medium: STGMEDIUM; FRelease: BOOL): HRESULT; StdCall;
begin
{$ifdef oledebug}writeln('IDataObject.SetData');{$endif}
Result:=S_OK;
end;
function TCustomDataObject.EnumFormatEtc(dwDirection: DWord; out
enumformatetcpara: IENUMFORMATETC): HRESULT; StdCall;
begin
{$ifdef oledebug}writeln('IDataObject.EnumFormatEtc');{$endif}
Result:=E_NOTIMPL;
end;
function TCustomDataObject.DAdvise(const formatetc: FORMATETC; advf: DWORD;
const AdvSink: IAdviseSink; out dwConnection: DWORD): HRESULT; StdCall;
begin
{$ifdef oledebug}writeln('IDataObject.DAdvise');{$endif}
Result:=S_OK;
end;
function TCustomDataObject.DUnadvise(dwconnection: DWord): HRESULT; StdCall;
begin
{$ifdef oledebug}writeln('IDataObject.DUnadvise');{$endif}
Result:=S_OK;
end;
function TCustomDataObject.EnumDAdvise(out aenumAdvise: IEnumStatData): HResult;
StdCall;
begin
{$ifdef oledebug}writeln('IDataObject.EnumDAdvise');{$endif}
Result:=S_OK;
end;
{ TCustomDataViewObject }
function TCustomDataViewObject.Draw(dwDrawAspect: DWord; LIndex: Long;
pvaspect: pointer; ptd: PDVTARGETDEVICE; hdcTargetDev: HDC; hdcDraw: HDC;
lprcBounds: PRECTL; lprcWBounds: PRECTL; pfncontinue: TContinueCallback;
dwcontinue: ULONG_PTR): HResult; stdcall;
begin
{$ifdef oledebug}writeln('IDataView.Draw');{$endif}
Result:=S_OK;
end;
function TCustomDataViewObject.GetColorSet(wDrawAspect: DWord; LIndex: Long;
pvaspect: pointer; ptd: PDVTARGETDEVICE; hdcTargetDev: HDC;
var ppcolorset: PLogPalette): HREsult; stdcall;
begin
{$ifdef oledebug}writeln('IDataView.GetColorSet');{$endif}
Result:=S_OK;
end;
function TCustomDataViewObject.Freeze(dwDrawAspect: DWord; LIndex: Long;
pvaspect: pointer; pdwfreeze: pdword): HResult; stdcall;
begin
{$ifdef oledebug}writeln('IDataView.Freeze');{$endif}
Result:=S_OK;
end;
function TCustomDataViewObject.Unfreeze(dwfreeze: dword): HResult; stdcall;
begin
{$ifdef oledebug}writeln('IDataView.Unfreeze');{$endif}
Result:=S_OK;
end;
function TCustomDataViewObject.SetAdvise(aspects: DWORD; advf: DWORD;
padvSink: IAdviseSink): HRESULT; stdcall;
begin
{$ifdef oledebug}writeln('IDataView.SetAdvise');{$endif}
Result:=S_OK;
end;
function TCustomDataViewObject.Getadvise(paspects: pdword; padvf: pdword; out
ppadvsink: IADviseSink): HRESULT; stdcall;
begin
{$ifdef oledebug}writeln('IDataView.Getadvise');{$endif}
Result:=S_OK;
end;
end.

42
components/richmemo/win32/win32richmemoproc.pas
View File

@ -55,22 +55,34 @@ const
REO_CP_SELECTION = -1; REO_CP_SELECTION = -1;
REO_IOB_SELECTION = -1; REO_IOB_SELECTION = -1;
REO_IOB_USE_CP = -2; REO_IOB_USE_CP = -2;
REO_NULL = 0;
REO_READWRITEMASK = $3F; REO_NULL = $00000000;
REO_DONTNEEDPALETTE = 32;
REO_BLANK = 16; REO_RESIZABLE = $00000001;
REO_DYNAMICSIZE = 8; REO_BELOWBASELINE = $00000002;
REO_INVERTEDSELECT = 4; REO_INVERTEDSELECT = $00000004;
REO_BELOWBASELINE = 2; REO_DYNAMICSIZE = $00000008;
REO_RESIZABLE = 1; REO_BLANK = $00000010;
REO_LINK = $80000000; REO_DONTNEEDPALETTE = $00000020;
REO_STATIC = $40000000;
// Rich edit 3.0
REO_OWNERDRAWSELECT = $00000040;
REO_CANROTATE = $00000080;
REO_ALIGNTORIGHT = $00000100;
REO_WRAPTEXTAROUND = $00000200;
REO_USEASBACKGROUND = $00000400;
REO_READWRITEMASK = $000007FF;
REO_LINKAVAILABLE = $00800000;
REO_GETMETAFILE = $00400000;
REO_HILITED = $01000000;
REO_INPLACEACTIVE = $02000000;
REO_OPEN = $04000000;
REO_SELECTED = $08000000; REO_SELECTED = $08000000;
REO_OPEN = $4000000; REO_STATIC = $40000000;
REO_INPLACEACTIVE = $2000000; REO_LINK = $80000000;
REO_HILITED = $1000000;
REO_LINKAVAILABLE = $800000;
REO_GETMETAFILE = $400000;
RECO_PASTE = 0; RECO_PASTE = 0;
RECO_DROP = 1; RECO_DROP = 1;
RECO_COPY = 2; RECO_COPY = 2;