oleinterface.pas

是一个delphi的流程制作软件

    FDataObject := nil
  end
end;

// This interface method is called if the object is dropped in the target.
function TBaseDropTarget.Drop (const DataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult;
begin
  Result := ddOk;
  try
    try
      dwEffect := deNone;
      Drop (DataObj, KeysToShiftState (grfKeyState), Pt, dwEffect, integer(Result))
    except
      Result := ddUnexpected;
      raise
    end
  finally
    FDataObject := nil
  end
end;


//=== BASE DROP SOURCE CLASS ===================================================

function TBaseDropSource.QueryContinueDrag(fEscapePressed: BOOL; grfKeyState: Longint): HResult;
begin
  Result := ddOk;
  try
    QueryContinueDrag (fEscapePressed, KeysToShiftState (grfKeyState), integer(Result))
  except
    Result := ddUnexpected;
    raise
  end
end;

function TBaseDropSource.GiveFeedback(dwEffect: Longint): HResult;
begin
  Result := ddDefault;
  try
    GiveFeedback (dwEffect, integer(Result))
  except
    Result := ddUnexpected;
    raise
  end
end;

//=== BASE DATA OBJECT CLASS ===================================================

function TBaseDataObject.GetData (const formatetcIn: TFormatEtc; out medium: TStgMedium): HResult;
begin
  Result := ddNotImplemented;
  try
    GetData (formatetcIn, medium, integer(Result))
  except
    Result := ddUnexpected;
    raise
  end
end;

function TBaseDataObject.GetDataHere (const formatetc: TFormatEtc; out medium: TStgMedium): HResult;
begin
  Result := ddNotImplemented;
  try
    GetDataHere (formatetc, medium, integer (Result))
  except
    Result := ddUnexpected;
    raise
  end
end;

function TBaseDataObject.QueryGetData (const formatetc: TFormatEtc): HResult;
begin
  Result := ddNotImplemented;
  try
    QueryGetData (formatetc, integer (Result))
  except
    Result := ddUnexpected;
    raise
  end
end;

function TBaseDataObject.GetCanonicalFormatEtc (const formatetc: TFormatEtc; out formatetcOut: TFormatEtc): HResult;
begin
  FormatEtcOut.ptd := nil;
  Result := ddSameFormatEtc;
  try
    GetCanonicalFormatEtc (formatetc, formatetcOut, integer (Result))
  except
    Result := ddUnexpected;
    raise
  end
end;

function TBaseDataObject.SetData (const formatetc: TFormatEtc; var medium: TStgMedium; fRelease: BOOL): HResult;
begin
  Result := ddNotImplemented;
  try
    SetData (formatetc, medium, fRelease, integer (Result))
  except
    Result := ddUnexpected;
    raise
  end
end;

function TBaseDataObject.EnumFormatEtc (dwDirection: Longint; out enumFormatEtc_: IEnumFormatEtc): HResult;
begin
  Result := ddNotImplemented;
  try
    EnumFormatEtc (dwDirection, enumFormatEtc_, integer (Result))
  except
    Result := ddUnexpected;
    raise
  end
end;

function TBaseDataObject.DAdvise (const formatetc: TFormatEtc; advf: Longint; const advSink: IAdviseSink; out dwConnection: Longint): HResult;
begin
  Result := ddNoAdvise;
  try
    DAdvise (formatetc, advf, advSink, dwConnection, integer (Result))
  except
    Result := ddUnexpected;
    raise
  end
end;

function TBaseDataObject.DUnadvise (dwConnection: Longint): HResult;
begin
  Result := ddNoAdvise;
  try
    DUnadvise (dwConnection, integer (Result))
  except
    Result := ddUnexpected;
    raise
  end
end;

function TBaseDataObject.EnumDAdvise (out enumAdvise: IEnumStatData): HResult;
begin
  Result := ddNoAdvise;
  try
    EnumDAdvise (EnumAdvise, integer (Result))
  except
    Result := ddUnexpected;
    raise
  end
end;

function TObjectBaseDataObject.GetData (const formatetcIn: TFormatEtc; out medium: TStgMedium): HResult;
begin
  Result := ddNotImplemented;
  try
    GetData (formatetcIn, medium, integer(Result))
  except
    Result := ddUnexpected;
    raise
  end
end;

function TObjectBaseDataObject.GetDataHere (const formatetc: TFormatEtc; out medium: TStgMedium): HResult;
begin
  Result := ddNotImplemented;
  try
    GetDataHere (formatetc, medium, integer (Result))
  except
    Result := ddUnexpected;
    raise
  end
end;

function TObjectBaseDataObject.QueryGetData (const formatetc: TFormatEtc): HResult;
begin
  Result := ddNotImplemented;
  try
    QueryGetData (formatetc, integer (Result))
  except
    Result := ddUnexpected;
    raise
  end
end;

function TObjectBaseDataObject.GetCanonicalFormatEtc (const formatetc: TFormatEtc; out formatetcOut: TFormatEtc): HResult;
begin
  FormatEtcOut.ptd := nil;
  Result := ddSameFormatEtc;
  try
    GetCanonicalFormatEtc (formatetc, formatetcOut, integer (Result))
  except
    Result := ddUnexpected;
    raise
  end
end;

function TObjectBaseDataObject.SetData (const formatetc: TFormatEtc; var medium: TStgMedium; fRelease: BOOL): HResult;
begin
  Result := ddNotImplemented;
  try
    SetData (formatetc, medium, fRelease, integer (Result))
  except
    Result := ddUnexpected;
    raise
  end
end;

function TObjectBaseDataObject.EnumFormatEtc (dwDirection: Longint; out enumFormatEtc_: IEnumFormatEtc): HResult;
begin
  Result := ddNotImplemented;
  try
    EnumFormatEtc (dwDirection, enumFormatEtc_, integer (Result))
  except
    Result := ddUnexpected;
    raise
  end
end;

function TObjectBaseDataObject.DAdvise (const formatetc: TFormatEtc; advf: Longint; const advSink: IAdviseSink; out dwConnection: Longint): HResult;
begin
  Result := ddNoAdvise;
  try
    DAdvise (formatetc, advf, advSink, dwConnection, integer (Result))
  except
    Result := ddUnexpected;
    raise
  end
end;

function TObjectBaseDataObject.DUnadvise (dwConnection: Longint): HResult;
begin
  Result := ddNoAdvise;
  try
    DUnadvise (dwConnection, integer (Result))
  except
    Result := ddUnexpected;
    raise
  end
end;

function TObjectBaseDataObject.EnumDAdvise (out enumAdvise: IEnumStatData): HResult;
begin
  Result := ddNoAdvise;
  try
    EnumDAdvise (EnumAdvise, integer (Result))
  except
    Result := ddUnexpected;
    raise
  end
end;


//=== BASE ENUM FORMATETC CLASS ================================================

function TBaseEnumFormatEtc.Next (celt: Longint; out elt; pceltFetched: PLongint): HResult;
begin
  Result := ddOk;
  try
    Next (celt, TFormatEtc(elt), integer (pceltFetched), integer (Result))
  except
    Result := ddUnexpected;
    raise
  end
end;

function TBaseEnumFormatEtc.Skip (celt: Longint): HResult;
begin
  Result := ddOk;
  try
    Skip (celt, integer (Result))
  except
    Result := ddUnexpected;
    raise
  end
end;

function TBaseEnumFormatEtc.Reset : HResult;
begin
  Result := ddOk;
  try
    Reset (integer (Result))
  except
    Result := ddUnexpected;
    raise
  end
end;

function TBaseEnumFormatEtc.Clone (out Enum: IEnumFormatEtc): HResult;
begin
  Result := ddOk;
  try
    Clone (Enum, integer (Result))
  except
    Result := ddUnexpected;
    raise
  end
end;

procedure TBaseAdviseSink.OnDataChange (const formatetc: TFormatEtc; const stgmed: TStgMedium);
var
  Result : integer;
begin
  Result := ddOk;
  OnDataChange (FormatEtc, stgmed, Result)
end;

procedure TBaseAdviseSink.OnViewChange (dwAspect : longint; lindex: longint);
var
  Result : integer;
begin
  Result := ddOk;
  OnViewChange (dwAspect, lindex, Result)
end;

procedure TBaseAdviseSink.OnRename (const mk: IMoniker);
var
  Result : integer;
begin
  Result := ddOk;
  OnRename (Mk, Result)
end;

procedure TBaseAdviseSink.OnSave;
var
  Result : integer;
begin
  Result := ddOk;
  OnSave (Result)
end;

procedure TBaseAdviseSink.OnClose;
var
  Result : integer;
begin
  Result := ddOk;
  OnClose (Result)
end;

//=== IMessageFilter ===========================================================

function TBaseMessageFilter.HandleInComingCall(dwCallType: Longint; htaskCaller: HTask;
  dwTickCount: Longint; lpInterfaceInfo: PInterfaceInfo): Longint;
var
  R : TServerCall;
begin
  R := scIsHandled;
  HandleInComingCall (TCallType(dwCallType), htaskCaller, integer(dwTickCount), lpInterfaceInfo^, R);
  Result := ord (R);
end;

function TBaseMessageFilter.RetryRejectedCall(htaskCallee: HTask; dwTickCount: Longint; dwRejectType: Longint): Longint;
begin
  Result := 0;
  RetryRejectedCall (htaskCallee, dwTickCount, TServerCall (dwRejectType), Result)
end;

function TBaseMessageFilter.MessagePending (htaskCallee: HTask; dwTickCount: Longint; dwPendingType: Longint): Longint;
var
  R : TPendingMsg;
begin
  R := pmWaitDefProcess;
  MessagePending (htaskCallee, dwTickCount, TPendingType (dwPendingType), R);
  Result := ord (R)
end;

//=== RichEdit Ole Callback ====================================================

function TBaseREOleCallback.GetNewStorage (out stg: IStorage): HRESULT;
begin
  Result:=  ddNotImplemented;
  Stg := nil;
  try
    GetNewStorage (Stg, integer(Result))
  except
    Result := ddUnexpected;
    raise
  end
end;

function TBaseREOleCallback.GetInPlaceContext (out Frame: IOleInPlaceFrame; out Doc: IOleInPlaceUIWindow; var FrameInfo: TOleInPlaceFrameInfo): HRESULT;
begin
  Result:=  ddNotImplemented;
  Frame := nil;
  Doc := nil;
  try
    GetInPlaceContext (Frame, Doc, FrameInfo, integer(Result))
  except
    Result := ddUnexpected;
    raise
  end
end;

function TBaseREOleCallback.ShowContainerUI (fShow: BOOL): HRESULT;
begin
  Result:=  ddNotImplemented;
  try
    ShowContainerUI (fShow, integer(Result))