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

richmemo: win32 ole utility functions

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5162 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz
2016-09-15 03:14:17 +00:00
parent f436b26383
commit 7d3b69a48e
1 changed files with 59 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -170,9 +170,20 @@ var
AllocOLEObject : procedure (ARichMemo: TCustomRichMemo; AHandle: Windows.THandle; out OleCallback: IRichEditOleCallback); AllocOLEObject : procedure (ARichMemo: TCustomRichMemo; AHandle: Windows.THandle; out OleCallback: IRichEditOleCallback);
function GetSelRTF(amemo: TCustomRichMemo): string; function GetSelRTF(amemo: TCustomRichMemo): string;
function GetRichEditOLE(amemo: TCustomRichMemo): IRichEditOle; overload;
function GetRichEditOLE(AHandle: THandle): IRichEditOle; overload;
function GetOleObject(ole: IRichEditOle; SelStart: Integer; out res: TREOBJECT): Boolean;
function SetOleObjectSize(ole: IRichEditOle; SelStart: Integer; const ASize: TSize): Boolean;
function GetOleObjectSize(ole: IRichEditOle; SelStart: Integer; var ASize: TSize): Boolean;
implementation implementation
const
PointSize = 72.0;
RtfSizeToInch = 2.54 * 1000.0;
SizeFactor = 1 / PointSize * RtfSizeToInch; // pt to 0.01 mlmete
RevSizeFactor = 1 / SizeFactor;
type type
TIntCustomRichMemo = class(TCustomRichMemo); TIntCustomRichMemo = class(TCustomRichMemo);
@ -1192,10 +1203,6 @@ var
Obj: TREOBJECT; Obj: TREOBJECT;
sl, ss: Integer; sl, ss: Integer;
eventmask: Integer; eventmask: Integer;
const
PointSize = 72.0;
RtfSizeToInch = 2.54 * 1000.0;
SizeFactor = 1 / PointSize * RtfSizeToInch;
begin begin
Result:=False; Result:=False;
if not Assigned(RichEditManager) or not Assigned(AWinControl) then Exit; if not Assigned(RichEditManager) or not Assigned(AWinControl) then Exit;
@ -1455,6 +1462,17 @@ begin
Result:=tt.buf; Result:=tt.buf;
end; end;
function GetRichEditOLE(amemo: TCustomRichMemo): IRichEditOle;
begin
if Assigned(amemo) then Result:=GetRichEditOle(amemo.Handle)
else Result:=nil;
end;
function GetRichEditOLE(AHandle: THandle): IRichEditOle;
begin
SendMessage(Ahandle, EM_GETOLEINTERFACE, 0, LPARAM(@Result));
end;
procedure DefAllocOleObject(ARichMemo: TCustomRichMemo; AHandle: Windows.THandle; out OleCallback: IRichEditOleCallback); procedure DefAllocOleObject(ARichMemo: TCustomRichMemo; AHandle: Windows.THandle; out OleCallback: IRichEditOleCallback);
var var
cb : TRichEditCallback; cb : TRichEditCallback;
@ -1463,6 +1481,43 @@ begin
OleCallBack:=cb; OleCallBack:=cb;
end; end;
function GetOleObject(ole: IRichEditOle; SelStart: Integer; out res: TREOBJECT): Boolean;
begin
Result:=Assigned(ole);
if not Result then Exit;
FillChar(res{%H-}, sizeof(res), 0);
res.cbStruct:=sizeof(res);
res.cp:=SelStart;
Result:=ole.GetObject(REO_IOB_USE_CP, res, REO_GETOBJ_ALL_INTERFACES)=S_OK;
end;
function SetOleObjectSize(ole: IRichEditOle; SelStart: Integer; const ASize: TSize): Boolean;
var
obj : TREOBJECT;
begin
if not Assigned(ole) then begin
Result:=false;
Exit;
end;
Result:=GetOleObject(ole, SelStart, obj);
if Result then begin
obj.sizel.cx:=round(ASize.cx * SizeFactor);
obj.sizel.cy:=round(ASize.cy * SizeFactor);
Result:=ole.InsertObject(obj)=S_OK;
end;
end;
function GetOleObjectSize(ole: IRichEditOle; SelStart: Integer; var ASize: TSize): Boolean;
var
res : TREOBJECT;
begin
Result:=GetOleObject(ole, SelStart, res);
if not Result then Exit;
ASize.cx:=round(res.sizel.cx*RevSizeFactor);
ASize.cy:=round(res.sizel.cy*RevSizeFactor);
end;
initialization initialization
NCPaint := @ThemedNCPaint; NCPaint := @ThemedNCPaint;
AllocOLEObject := @DefAllocOleObject; AllocOLEObject := @DefAllocOleObject;