olere.pas

是一个delphi的流程制作软件

    REObject.oleobj := LocalOleObject;
    REObject.stg := LocalStorage;
    REObject.olesite := MainSite;
    if CreateInfo.ShowAsIcon then
      REObject.dvaspect := dvaIcon
    else
      REObject.dvaspect := dvaContent;
    REObject.dwFlags := REO_RESIZABLE or REO_DYNAMICSIZE;
    if CreateType = ctNewObject then
      REObject.dwFlags := REObject.dwFlags or REO_BLANK;
// Try to get a CLSID
    if IsEqualCLSID (REObject.CLSID, CLSID_NULL) then
      REObject.CLSID := OleStdClassFile (Filename);
// Make Iconic?
    if CreateInfo.ShowAsIcon and Failed (OleStdSwitchDisplayAspect (LocalOleObject,
      REObject.dvaspect, dvaIcon, 0, false, false, nil, Update)) then
        Application.MessageBox ('Object couldn''t be displayed as an icon', 'Insert Object', mb_ok);
// now stuff it in
    FRichEditOle.InsertObject (REObject);
    LocalOleObject.Update;
// call the show verb for new objects
    if CreateType = ctNewObject  then
    begin
      R := Rect (0, 0 , 50, 50);
      OleCheck (LocalOleObject.DoVerb (OLEIVERB_SHOW, nil, ClientSite, 0, Application.Handle, R))
    end
  end
end;

procedure TOleRE.DoVerb (Verb: Integer);
var
  H: THandle;
  R: TRect;
  OleObject: IOleObject;
  OleClientSite : IOleClientSite;
  Verbs : TStringList;
begin
  OleObject := GetSelected;
  if Assigned (OleObject) then
  begin
    OleClientSite := GetClientSite;
    Verbs := GetObjectVerbs;
    try
      if Verb > 0 then
      begin
        if Verb >= Verbs.Count then
          raise Exception.Create('Invalid Verb');
        Verb := Smallint(integer(Verbs.Objects[Verb]) and $0000FFFF);
      end else
        if Verb = ovPrimary then
          Verb := 0;

      R := FRichEdit.ClientRect;
      H := FRichEdit.Handle;
      OleCheck(OleObject.DoVerb (Verb, nil, OleClientSite, 0, H, R))
    finally
      Verbs.Free
    end
  end
end;

function TOleRE.EditLinksDialog : boolean;
begin
  if Assigned (FEditLinks) then
  begin
    FEditLinks.EditLink := TOleUILinkContainer.Create (Self);
    Result := FEditLinks.Execute
  end else
    Result := false
end;

function TOleRE.EditLinkDialog : boolean;
var
  OleObject : IOleObject;
  OleLink : IOleLink;
begin
  Result := false;
  OleObject := Selected;
  if Assigned (OleObject) and Assigned (FEditLinks) then
  begin
    OleCheck (OleObject.QueryInterface (IOleLink, OleLink));
    if Assigned (OleLink) then
    begin
      FEditLinks.EditLink := TOleUILinkContainer1.Create (OleLink);
      Result := FEditLinks.Execute
    end
  end
end;

procedure TOleRE.FreeInterfaces;
begin
  FFrame := nil;
  if Assigned (FRichEditOle) then
    InPlaceDeactivate;
  FRichEditOleCallback := nil;
  FStorage := nil;
  FRichEditOle := nil;
end;

function TOleRE.GetAspect : integer;
var
  REObject : TREObject;
begin
  REObject := GetObject (SelIndex, SelFlags);
  Result := REObject.dvAspect
end;

function TOleRE.GetCanConvertOrActivateAs : boolean;
var
  Format : TClipFormat;
  CLSID : TCLSID;
  UserType,
  LabelStr : string;
  MetaPict : hGlobal;
begin
  ConvertInfo ([ciFormat], CLSID, Format, UserType, LabelStr, MetaPict);
  Result := OleUICanConvertOrActivateAs (CLSID, Linked, Format)
end;

  function CanPasteThis (DataObject : IDataObject) : boolean;
  begin
    Result := (OleQueryCreateFromData(DataObject) = ddOk) or (OleQueryLinkFromData(DataObject) = ddOk)
  end;

function TOleRE.GetCanPaste: boolean;
var
  DataObject: IDataObject;
begin
  Result := Succeeded(OleGetClipboard(DataObject));
  if Result then
  begin
    Result := CanPasteThis (DataObject);
    if not Result then
      with TEnumFormats.Create (DataObject) do
      try
        Result := HasText or HasRTF or HasDIB or HasBitmap or HasMetafile or HasEmbeddedObject
      finally
        Free
      end
  end
end;

function TOleRE.GetCanRevert : boolean;
begin
  Result := RichEdit.Modified and (FFilename <> '')
end;

function TOleRE.GetClientSite : IOleClientSite;
begin
  Result := FRichEditOle.GetClientSite
end;

function TOleRE.GetCLSID : TCLSID;
var
  OleObject : IOleObject;
begin
  OleObject := Selected;
  if Assigned (OleObject) then
    OleObject.GetUserClassID (Result)
  else
    Result := CLSID_NULL
end;

function TOleRE.GetClipboardData (Chrg : TCharRange; reco : TREFlag) : IDataObject;
begin
  Result := FRichEditOle.GetClipboardData (Chrg, reco)
end;

function TOleRE.GetFullName : string;
begin
  Result := OleStdFullNameStr (Selected)
end;

function TOleRE.GetIconic: Boolean;
begin
  Result := GetAspect = dvaIcon
end;

function TOleRE.GetIconMetaPict: HGlobal;
var
  DataObject: IDataObject;
  FormatEtc: TFormatEtc;
  Medium: TStgMedium;
  ClassID: TCLSID;
  OleObject : IOleObject;
begin
  Result := 0;
  OleObject := Selected;
  if Assigned (OleObject) then
  begin
    OleObject.QueryInterface (IDataObject, DataObject);
    if Assigned (DataObject) then
    begin
      FormatEtc := SetFormatEtc (cfMetafilePict, tsMetafilePict, nil, dvaIcon);
      if Succeeded (DataObject.GetData(FormatEtc, Medium)) then
        Result := Medium.hMetaFilePict;
    end;
    if Result = 0 then
    begin
      OleCheck (OleObject.GetUserClassID (ClassID));
      Result := OleGetIconOfClass (ClassID, nil, true)
    end
  end
end;

function TOleRE.GetLinkCount : integer;
begin
  Result := FRichEditOle.GetLinkCount
end;

function TOleRE.GetLinked: boolean;
var
  OleLink : IOleLink;
  OleObject : IOleObject;
begin
  Result := false;
  OleObject := Selected;
  if Assigned (OleObject) then
  begin
    OleObject.QueryInterface (IOleLink, OleLink);
    Result := Assigned (OleLink)
  end
end;

function TOleRE.GetMoniker : IMoniker;
var
  OleLink : IOleLink;
  OleObject : IOleObject;
begin
  Result := nil;
  OleObject := Selected;
  if Assigned (OleObject) then
  begin
    OleObject.QueryInterface (IOleLink, OleLink);
    OleLink.GetSourceMoniker (Result)
  end
end;

function TOleRE.GetMonikerDisplayName : string;
begin
  Result := OleStdMonikerDisplayName (GetMoniker);
end;

function TOleRE.GetObjectCount : integer;
begin
  Result := FRichEditOle.GetObjectCount
end;

function TOleRE.GetObjectDataSize: Integer;
var
  Storage : IStorage;
  Stat : TStatStg;
  Enum : IEnumStatStg;
begin
  if GetLinked then
    Result := -1
  else begin
    Result := 0;
    Storage := GetObjectStorage;
    if Assigned (Storage) then
    begin
      OleCheck (Storage.EnumElements (0, nil, 0, Enum));
      while Enum.Next (1, Stat, nil) = S_OK do
      begin
        inc (Result, Stat.cbSize);
        if Assigned (Stat.pwcsName) then
          OleStdFreeString (Stat.pwcsName)
      end
    end
  end
end;

function TOleRE.GetObjectStorage : IStorage;
var
  REObject : TREObject;
begin
  REObject := FRichEditOle.GetObject (FSelIndex, [reStorage] + FSelFlags);
  Result := REObject.stg
end;

function TOleRE.GetObjectSite : IOleClientSite;
var
  REObject : TREObject;
begin
  REObject := FRichEditOle.GetObject (FSelIndex, [reSite] + FSelFlags);
  Result := REObject.OleSite
end;

function TOleRE.GetObject (Index : integer; Flags : TREObjectFlags) : TREObject;
begin
  Result := FRichEditOle.GetObject (Index, Flags)
end;

function TOleRE.GetObjectVerbs: TStringList;
var
  EnumOleVerb : IEnumOleVerb;
  OleVerb     : TOleVerb;
  VerbInfo    : TVerbInfo;
  OleObject   : IOleObject;
begin
  Result := TStringList.Create;
  OleObject := Selected;
  if Assigned (OleObject) then
    if OleObject.EnumVerbs (EnumOleVerb) = S_OK then
      while (EnumOleVerb.Next (1, OleVerb, nil) = S_OK) and (OleVerb.lVerb >= 0) and
        (OleVerb.grfAttribs and OLEVERBATTRIB_ONCONTAINERMENU <> 0) do
      begin
        VerbInfo.Verb := OleVerb.lVerb;
        VerbInfo.Flags := OleVerb.fuFlags;
        Result.AddObject (OleVerb.lpszVerbName, TObject(VerbInfo))
      end
end;

function TOleRE.GetProgID: string;
begin
  try
    Result := OleStdCLSIDToProgID (GetCLSID)
  except
    Result := ''
  end
end;

function TOleRE.GetOleObject: Variant;
var
  OleObject : IOleObject;
begin
  OleObject := Selected;
  if Assigned (OleObject) then
    Result := Variant (OleObject as IDispatch)
  else
    Result := Null
end;

function TOleRE.GetPrimaryVerb : integer;
var
  Verbs : TStringList;
begin
  Verbs := GetObjectVerbs;
  try
    for Result := 0 to Verbs.Count - 1 do
      if integer (Verbs.Objects[Result]) and $0000FFFF = 0 then
        exit;
    Result := 0
  finally
    Verbs.Free
  end
end;

function TOleRE.GetSelected : IOleObject;
var
  REObject : TREObject;
begin
  REObject := FRichEditOle.GetObject (FSelIndex, FSelFlags + [reOleObject]);
  Result := REObject.OleObj
end;

function TOleRE.GetShortName : string;
begin
  Result := OleStdShortNameStr (Selected)
end;

function TOleRE.GetSourceDoc: string;
var
  OleLink: IOleLink;
  OleObject : IOleObject;
begin
  Result := '';
  OleObject := Selected;
  if Assigned (OleObject) then
  begin
    OleCheck (OleObject.QueryInterface(IOleLink, OleLink));
    if Assigned (OleLink) then
      Result := OleStdDisplayNameStr (OleLink)
  end
end;

function TOleRE.GetState: TObjectState;
var
  REObject : TREObject;
begin
  Result := osEmpty;
  REObject := FRichEditOle.GetObject (FSelIndex, FSelFlags);
  if Assigned (REObject.OleObj) then
    if REObject.dwFlags and REO_OPEN <> 0 then
      Result := osOpen
    else
      if REObject.dwFlags and REO_INPLACEACTIVE <> 0 then
        Result := osUIActive
      else
        if REObject.dwFlags and REO_HILITED <> 0 then
          Result := osHighlighted
        else
          if REObject.dwFlags and REO_SELECTED <> 0 then
            Result := osSelected
end;

function TOleRE.GetViewSize : TPoint;
var
  REObject : TREObject;
begin
  REObject := FRichEditOle.GetObject (FSelIndex, FSelFlags);
  Result := Point (REObject.Sizel.cx, REObject.Sizel.cy)
end;

procedure TOleRE.HandsoffStorage;
begin
  FRichEditOle.HandsOffStorage (FSelIndex)
end;

procedure TOleRE.ImportDataObject (DataObj : IDataObject; Format : TClipFormat; MetaPict : hGlobal);
begin
  FRichEditOle.ImportDataObject (DataObj, Format, MetaPict)
end;

procedure TOleRE.InPlaceDeactivate;
begin
  FRichEditOle.InPlaceDeactivate
end;

procedure TOleRE.Insert (REObject : TREObject);
begin
  FRichEditOle.InsertObject (REObject)
end;

function TOleRE.InsertObjectDialog : boolean;
var
  LocalClientSite : IOleClientSite;