Class TMyOle (unit myOle)

Inherits from

IOleObject

Constructors


constructor Create(ObjectClass:TDelphiOleClass);

TMyOle supports following aggregated interfaces: - IViewObject - IDataObject - IPersistStorage Those interfaces are implemented with coresponding Txxxx objects.


Functions

function AddRef: Longint;

!!!! We are doing counnting for aggregated object too !

function Advise(advSink: IAdviseSink; var dwConnection: Longint): HResult;

if containerControl=nil then begin

function Close(dwSaveOption: Longint): HResult;


destructor Destroy;

neccessary?

function DoVerb(iVerb: Longint; msg: PMsg; activeSite: IOleClientSite; lindex: Longint; hwndParent: HWND; const posRect: TRect): HResult;

[out] parameter

function EnumAdvise(var enumAdv1: IEnumStatData): HResult;


function EnumVerbs(var enumOleVerb: IEnumOleVerb): HResult;


function GetClientSite(var clientSite: IOleClientSite): HResult;

if fclientSite<>nil then viewChanged(DVASPECT_CONTENT); To pomaga le pri mojem insert

function GetClipboardData(dwReserved: Longint; var dataObject: IDataObject): HResult;

debug2(self,'InitFromData '+intToStr(integer(dataObject))+' '+intToStr(integer(fCreation))); result:=S_OK; if DataObject=nil then begin result:=S_OK; exit; end; // we are capable of initializating object from data FormatEtc.

function GetExtent(dwDrawAspect: Longint; var size: TPoint): HResult;


function GetMiscStatus(dwAspect: Longint; var dwStatus: Longint): HResult;


function GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint; var mk: IMoniker): HResult;

From inside ole 2

function GetObjHandle:integer;

following functions are used for debugging and are not part of IOleObject interface

property access


procedure GetPersistStorage(var persistStorage:IPersistStorage);


procedure GetStorage(var storage:IStorage);


function GetUserClassID(var clsid: TCLSID): HResult;


function GetUserType(dwFormOfType: Longint; var pszUserType: POleStr): HResult;


function InitFromData(dataObject: IDataObject; fCreation: BOOL; dwReserved: Longint): HResult;

From inside ole 2

function IsUpToDate: HResult;


function QueryInterface(const iid: TIID; var obj): HResult;

I am not following IOL2 guidelines here because I know, that all inner objects are local native Delphi objects.

function Release: Longint;


function SetClientSite(clientSite: IOleClientSite): HResult;

THIS LINE CAUESES GPF.

function SetColorScheme(var logpal: TLogPalette): HResult;


function SetExtent(dwDrawAspect: Longint; const size: TPoint): HResult;

debug2(self,wideCharToString(pszUserType));

function SetHostNames(szContainerApp: POleStr; szContainerObj: POleStr): HResult;

Caller will releaseObject

function SetMoniker(dwWhichMoniker: Longint; mk: IMoniker): HResult;

CoDisconnet object.

procedure Test;

valid only for Delphi control, otherwise nil

function Unadvise(dwConnection: Longint): HResult;


function Update: HResult;


procedure ViewChanged(dwaspect:DWORD);

following functions are not part of IOleObject interface

non-IOleObject routines


function GetContainerControl:TWInControl;


function GetHasStorage:boolean;


Properties

property ContainerControl : TWinControl


property hasStorage : boolean


property theObject : TDelphiOle


Events

Variables

fDataObject : TMyDataObject;

we *do* own the object

ftheObject : TDelphiOle;

internal handle used for debbuging

fClientSite : IOleClientSite;


fObjHandle : integer;


fOleAdviseHolder : IOleAdviseHolder;


fPersistStorage : TMyPersistStorage;


fRefCount : longint;


fViewObject : TViewObject;



Constructors


constructor Create(ObjectClass:TDelphiOleClass);

TMyOle supports following aggregated interfaces: - IViewObject - IDataObject - IPersistStorage Those interfaces are implemented with coresponding Txxxx objects. We are also doing reference count in inner objects, although inner object's reference count in never used.


Functions


function AddRef: Longint;

!!!! We are doing counnting for aggregated object too !


function Advise(advSink: IAdviseSink; var dwConnection: Longint): HResult;

if containerControl=nil then begin


function Close(dwSaveOption: Longint): HResult;


destructor Destroy;

neccessary?


function DoVerb(iVerb: Longint; msg: PMsg; activeSite: IOleClientSite; lindex: Longint; hwndParent: HWND; const posRect: TRect): HResult;

[out] parameter


function EnumAdvise(var enumAdv1: IEnumStatData): HResult;


function EnumVerbs(var enumOleVerb: IEnumOleVerb): HResult;


function GetClientSite(var clientSite: IOleClientSite): HResult;

if fclientSite<>nil then viewChanged(DVASPECT_CONTENT); To pomaga le pri mojem insert


function GetClipboardData(dwReserved: Longint; var dataObject: IDataObject): HResult;

debug2(self,'InitFromData '+intToStr(integer(dataObject))+' '+intToStr(integer(fCreation))); result:=S_OK; if DataObject=nil then begin result:=S_OK; exit; end; // we are capable of initializating object from data FormatEtc.cfFormat := CFDelphiObjectData; FormatEtc.ptd := nil; FormatEtc.dwAspect := DVASPECT_CONTENT; FormatEtc.lIndex := -1; FormatEtc.tymed := TYMED_HGLOBAL; if DataObject.GetData(formatetc,stgMedium)=S_OK then begin debug2(self,'InitFromData: Mora sprostiti medij????'); end else begin result:=S_FALSE; debug2(self,'InitFromData: GetData failed!'); end;


function GetExtent(dwDrawAspect: Longint; var size: TPoint): HResult;


function GetMiscStatus(dwAspect: Longint; var dwStatus: Longint): HResult;


function GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint; var mk: IMoniker): HResult;

From inside ole 2


function GetObjHandle:integer;

following functions are used for debugging and are not part of IOleObject interface

property access


procedure GetPersistStorage(var persistStorage:IPersistStorage);


procedure GetStorage(var storage:IStorage);


function GetUserClassID(var clsid: TCLSID): HResult;


function GetUserType(dwFormOfType: Longint; var pszUserType: POleStr): HResult;


function InitFromData(dataObject: IDataObject; fCreation: BOOL; dwReserved: Longint): HResult;

From inside ole 2


function IsUpToDate: HResult;


function QueryInterface(const iid: TIID; var obj): HResult;

I am not following IOL2 guidelines here because I know, that all inner objects are local native Delphi objects. (* //inc(fRefCount,4); // artifical reference count prevents following lines from calling .Destroy again // any number greather than nuber of aggregated objects could be used {if fViewObject<>nil then }fViewObject.Free; // fViewObject.release; // fRefCount=3 debug('Zdaj pa data!'); {if fDataObject<>nil then }fDataObject.Free; // fDataObject.Release; // fRefCount=2 {if fPersistStorage<>nil then }fPersistStorage.Free; // fPersistStorage.Release; // fRefCount=1 // fRefCount:=0; // we don't need this line, because we will be destroyed in a momnet


function Release: Longint;


function SetClientSite(clientSite: IOleClientSite): HResult;

THIS LINE CAUESES GPF. WHY??? debug2(self,intToStr(ipSite.CanInPlaceActivate)); debug2(self,'uspel');


function SetColorScheme(var logpal: TLogPalette): HResult;


function SetExtent(dwDrawAspect: Longint; const size: TPoint): HResult;

debug2(self,wideCharToString(pszUserType));


function SetHostNames(szContainerApp: POleStr; szContainerObj: POleStr): HResult;

Caller will releaseObject


function SetMoniker(dwWhichMoniker: Longint; mk: IMoniker): HResult;

CoDisconnet object. Not needed bacuse we are not remote???


procedure Test;

valid only for Delphi control, otherwise nil


function Unadvise(dwConnection: Longint): HResult;


function Update: HResult;


procedure ViewChanged(dwaspect:DWORD);

following functions are not part of IOleObject interface

non-IOleObject routines


function GetContainerControl:TWInControl;


function GetHasStorage:boolean;


Properties


property ContainerControl : TWinControl


property hasStorage : boolean


property theObject : TDelphiOle


Events


Variables


fDataObject : TMyDataObject;

we *do* own the object


ftheObject : TDelphiOle;

internal handle used for debbuging


fClientSite : IOleClientSite;


fObjHandle : integer;


fOleAdviseHolder : IOleAdviseHolder;


fPersistStorage : TMyPersistStorage;


fRefCount : longint;


fViewObject : TViewObject;