做COM 如何实现IOLEObject接口

Question

此接口方法太多。文档太少。
请高手提供源码，不胜感激。

Answer 1

把 IOleObject涉及的事件自己写个过程按参数回调
参考下比如
 TDataObject = class(TInterfacedObject,IDataObject)
  private
  public
   constructor Create;
   procedure Free;
   //IDataObject需要用到的接口
   function GetData(const formatetcIn: TFormatEtc; out medium: TStgMedium): HResult; stdcall;
   function GetDataHere(const formatetc: TFormatEtc; out medium: TStgMedium): HResult; stdcall;
   function QueryGetData(const formatetc: TFormatEtc): HResult; stdcall;
   function GetCanonicalFormatEtc(const formatetc: TFormatEtc; out formatetcOut: TFormatEtc): HResult;stdcall;
   function SetData(const formatetc: TFormatEtc; var medium: TStgMedium; fRelease: BOOL): HResult; stdcall;
   function EnumFormatEtc(dwDirection: Longint; out enumFormatEtc: IEnumFormatEtc): HResult; stdcall;
   function DAdvise(const formatetc: TFormatEtc; advf: Longint; const advSink: IAdviseSink; out dwConnection: Longint): HResult; stdcall;
   function DUnadvise(dwConnection: Longint): HResult; stdcall;
   function EnumDAdvise(out enumAdvise: IEnumStatData): HResult; stdcall;
 end;constructor TDataObject.Create;
begin
 inherited Create;
end;procedure TDataObject.free;
begin
end;//每个接口都要写...比较麻烦
function TDataObject.GetDataHere(const formatetc: TFormatEtc; out medium: TStgMedium): HResult; stdcall;
begin Result := E_NOTIMPL; end; //不支持的接口就返回E_NOTIMPL
function TDataObject.GetData(const formatetcIn: TFormatEtc; out medium: TStgMedium): HResult; stdcall;
begin
//成功返回Result := S_OK失败S_FALSE;
//按照out参数返回TStgMedium结构medium:=...
Result := S_OK;
end;//以此类推
...
...
...
...
//////////////////////////////////////////////////////
IOLEObject接口要完成
    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: Longint): HResult; stdcall;
    function SetMoniker(dwWhichMoniker: Longint; const mk: IMoniker): HResult;
      stdcall;
    function GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint;
      out mk: IMoniker): HResult; stdcall;
    function InitFromData(const dataObject: IDataObject; fCreation: BOOL;
      dwReserved: Longint): HResult; stdcall;
    function GetClipboardData(dwReserved: Longint;
      out dataObject: IDataObject): HResult; stdcall;
    function DoVerb(iVerb: Longint; msg: PMsg; const activeSite: IOleClientSite;
      lindex: Longint; hwndParent: HWND; const posRect: TRect): HResult;
      stdcall;
    function EnumVerbs(out enumOleVerb: IEnumOleVerb): HResult; stdcall;
    function Update: HResult; stdcall;
    function IsUpToDate: HResult; stdcall;
    function GetUserClassID(out clsid: TCLSID): HResult; stdcall;
    function GetUserType(dwFormOfType: Longint; out pszUserType: POleStr): HResult;
      stdcall;
    function SetExtent(dwDrawAspect: Longint; const size: TPoint): HResult;
      stdcall;
    function GetExtent(dwDrawAspect: Longint; out size: TPoint): HResult;
      stdcall;
    function Advise(const advSink: IAdviseSink; out dwConnection: Longint): HResult;
      stdcall;
    function Unadvise(dwConnection: Longint): HResult; stdcall;
    function EnumAdvise(out enumAdvise: IEnumStatData): HResult; stdcall;
    function GetMiscStatus(dwAspect: Longint; out dwStatus: Longint): HResult;
      stdcall;
    function SetColorScheme(const logpal: TLogPalette): HResult; stdcall;
具体你查查MSDN