Class TMyOle (unit myOle) |
Inherits from
IOleObject
constructor Create(ObjectClass:TDelphiOleClass);
- TMyOle supports following aggregated interfaces: - IViewObject - IDataObject - IPersistStorage Those interfaces are implemented with coresponding Txxxx objects.
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;
property ContainerControl : TWinControl
property hasStorage : boolean
property theObject : TDelphiOle
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;
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.
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;
property ContainerControl : TWinControl
property hasStorage : boolean
property theObject : TDelphiOle
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;