| Class TMyOle (unit myOle) |
IOleObject
| Constructors |
constructor Create(ObjectClass:TDelphiOleClass);| Functions |
function AddRef: Longint;
function Advise(advSink: IAdviseSink; var dwConnection: Longint): HResult;
function Close(dwSaveOption: Longint): HResult;
destructor Destroy;
function DoVerb(iVerb: Longint; msg: PMsg; activeSite: IOleClientSite; lindex: Longint; hwndParent: HWND; const posRect: TRect): HResult;
function EnumAdvise(var enumAdv1: IEnumStatData): HResult;
function EnumVerbs(var enumOleVerb: IEnumOleVerb): HResult;
function GetClientSite(var clientSite: IOleClientSite): HResult;
function GetClipboardData(dwReserved: Longint; var dataObject: IDataObject): HResult;
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;
function GetObjHandle:integer;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;
function IsUpToDate: HResult;
function QueryInterface(const iid: TIID; var obj): HResult;
function Release: Longint;
function SetClientSite(clientSite: IOleClientSite): HResult;
function SetColorScheme(var logpal: TLogPalette): HResult;
function SetExtent(dwDrawAspect: Longint; const size: TPoint): HResult;
function SetHostNames(szContainerApp: POleStr; szContainerObj: POleStr): HResult;
function SetMoniker(dwWhichMoniker: Longint; mk: IMoniker): HResult;
procedure Test;
function Unadvise(dwConnection: Longint): HResult;
function Update: HResult;
procedure ViewChanged(dwaspect:DWORD);non-IOleObject routines
function GetContainerControl:TWInControl;
function GetHasStorage:boolean;| Properties |
property ContainerControl : TWinControl
property hasStorage : boolean
property theObject : TDelphiOle| Events |
| Variables |
fDataObject : TMyDataObject;
ftheObject : TDelphiOle;
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;