olecontainer.pas

是一个delphi的流程制作软件

  if dwAspect = FDrawAspect then
    UpdateView
end;

procedure TOle2Container.OnRename(const mk: IMoniker);
begin
end;

procedure TOle2Container.OnSave;
begin
end;

procedure TOle2Container.OnClose;
begin
end;

{ TOle2Container.IOleDocumentSite }

function TOle2Container.ActivateMe(View: IOleDocumentView): HRESULT;
var
  Doc: IOleDocument;
begin
  Result := E_FAIL;
  if View = nil then
  begin   // If we're given a nil view, try to get one from the document object.
    if FOleObject.QueryInterface(IOleDocument, Doc) <> 0 then Exit;
    if Doc = nil then Exit;
    Result := Doc.CreateView(Self, nil, 0, View);
    if Result <> 0 then Exit;
  end
  else
    View.SetInPlaceSite(Self);

  FDocObj := True;
  FDocView := View;
  View.UIActivate(TRUE);    //Set up toolbars and menus first
  UpdateObjectRect;         //Then set window size, after toolbars
  View.Show(TRUE);
  Result := NOERROR
end;



//--- TOle2Container -----------------------------------------------------------

constructor TOle2Container.Create(AOwner: TComponent);
const
  ContainerStyle = [csClickEvents, csSetCaption, csOpaque, csDoubleClicks];
begin
  inherited Create(AOwner);
  FRefCount := 1;
  if NewStyleControls then
    ControlStyle := ContainerStyle
  else
    ControlStyle := ContainerStyle + [csFramed];
  Width := 121;
  Height := 121;
  TabStop := true;
  ParentColor := false;
  FAllowInPlace := true;
  FAllowActiveDoc := true;
  FAutoActivate := aaDoubleClick;
  FAutoVerbMenu := true;
  FBorderStyle := bsSingle;
  FCopyOnSave := true;
  FDrawAspect := dvaContent;
  FScaleRelative := true;
  FCurrentScale := 100
end;

destructor TOle2Container.Destroy;
begin
  DestroyObject;
  inherited Destroy;
end;

function TOle2Container._AddRef: Integer;
begin
  Inc(FRefCount);
  Result := FRefCount;
end;

procedure TOle2Container.AdjustBounds;
var
  Size: TPoint;
  Extra: Integer;
begin
  if not (csReading in ComponentState) and (FSizeMode = smAutoSize) and
    (FOleObject <> nil) then
  begin
    XFormSizeInHimetricToPixels(0, FViewSize, Size);
    Extra := GetBorderWidth * 2;
    SetBounds(Left, Top, Size.X + Extra, Size.Y + Extra);
  end;
end;

procedure TOle2Container.Assign (Source : TPersistent);
var
  Container : TOle2Container;
  Stream : TMemoryStream;
begin
  if Source is TOle2Container then
  begin
    Container := Source as TOle2Container;
    Stream := TMemoryStream.Create;
    try
      Container.SaveToStream (Stream);
      Stream.Seek (0, 0);
      LoadFromStream (Stream)
    finally
      Stream.Free
    end
  end else
    inherited Assign (Source)
end;


function TOle2Container.ChangeIconDialog: Boolean;
var
  C : TCLSID;
begin
  CheckObject;
  Result := false;
  if Assigned (FOleChangeIconDialog) then
    with FOleChangeIconDialog do
    begin
      OleCheck (FOleObject.GetUserClassID(C));
      AsCLSID := C;
      Metafile.MetaPict := GetIconMetaPict;
      if Execute then
      begin
        SetDrawAspect (true, Metafile.MetaPict);
        Result := true
      end
    end
end;

function TOle2Container.ChangeSourceDialog : boolean;
var
  OleLink : IOleLink;
  ShowAsIcon: Boolean;
begin
  CheckObject;
  Result := false;
  if Assigned (FOleChangeSourceDialog) and Linked then
    with FOleChangeSourceDialog do
    begin
      FOleObject.QueryInterface (IOleLink, OleLink);
      Link := integer (pointer(OleLink));
      LinkContainer := TOleUILinkContainer.Create (Self);
      Result := Execute;
      if Result then
      begin
        case FDrawAspect of
          dvaContent : ShowAsIcon := false;
          dvaIcon    : ShowAsIcon := true
        else
          ShowAsIcon := Iconic
        end;
        FDrawAspect := -1;  // force redraw
        SetDrawAspect (ShowAsIcon, GetIconMetaPict)
      end
    end
end;

procedure TOle2Container.CheckObject;
begin
  if FOleObject = nil then
    raise EOleError.Create(SEmptyContainer);
end;

procedure TOle2Container.ClearDrawAspect;
begin
  FDrawAspect := -1
end;

procedure TOle2Container.Close;
begin
  CheckObject;
  OleCheck(FOleObject.Close(OLECLOSE_SAVEIFDIRTY));
end;

procedure TOle2Container.Copy;
begin
  Close;
  OleCheck(OleSetClipboard(TDataObject.Create(Self)));
end;

// Helper function for ConvertObjectDialog to retrieve necessary information about the object.
// The Wanted parameter varies the data fetched.
procedure TOle2Container.ConvertInfo (Wanted : TConvertInfos; var CLSID : TCLSID; var Format : TClipFormat; var TypeStr, LabelStr : string; var Metafile : hGlobal);
var
  Buffer : POleStr;
begin
  CLSID := CLSID_NULL;
  Format := cfNull;
  TypeStr := '';
  LabelStr := '';
  Metafile := 0;
  if Assigned (FOleObject) then
  begin
// For embedded objects get the real CLSID of the object and
// its format string.  If this fails then we can try to ask
// the object, or we can look in the registry.
    if Failed (ReadClassStg (FStorage, CLSID)) then
      if Failed (FOleObject.GetUserClassID (CLSID)) then
        CLSID := CLSID_NULL;
    if ((ciFormat in Wanted) or (ciType in Wanted)) and
      Succeeded (ReadFmtUserTypeStg (FStorage, Format, Buffer)) then
    begin
      TypeStr := Buffer;
      OleStdFreeString (Buffer)
    end else begin
      Format := cfNull;
      TypeStr := OleStdUserTypeOfClass (CLSID, 0)
    end;
    if not (ciFormat in Wanted) then
      Format := cfNull;
    if not (ciType in Wanted) then
      TypeStr := '';
// Try to get the AuxUserType from the registry, using
// the short version (registered under AuxUserType\2).
// If that fails, just copy TypeStr.
    if ciLabel in Wanted then
    begin
      LabelStr := OleStdUserTypeOfClass (CLSID, 2);
      if LabelStr = '' then
        LabelStr := TypeStr
    end;

    if ciMetafile in Wanted then
      Metafile := GetIconMetaPict
  end;
end;

function TOle2Container.ConvertObjectDialog : boolean;
var
  CLSID : TCLSID;
  TypeStr,
  LabelStr : string;
  MetaPict : hGlobal;
  Format : TClipFormat;
  IconWanted : boolean;
begin
  Result := false;
  if Assigned (FOleObject) and Assigned (FOleConvertDialog) and CanConvertOrActivateAs then
  begin
// need to test if static already?
    FOleConvertDialog.IsLinked := Linked;
    FOleConvertDialog.Format.Aspect := XlatAspect (FDrawAspect);
    ConvertInfo ([ciFormat, ciType, ciLabel, ciMetafile], CLSID, Format, TypeStr, LabelStr, MetaPict);
    FOleConvertDialog.AsCLSID := CLSID;
    FOleConvertDialog.Format.Format := Format;
    FOleConvertDialog.UserType := TypeStr;
    FOleConvertDialog.IconLabel := LabelStr;
    FOleConvertDialog.Metafile.MetaPict := MetaPict;
    if FOleConvertDialog.Execute then
    begin
//Potentially a long operation...
      Screen.Cursor := crHourglass;
      try
// First, let's bother with the iconic aspect switch.
        MetaPict := 0;
        IconWanted := FOleConvertDialog.Format.Aspect = caIcon;
        if IconWanted then
          MetaPict := FOleConvertDialog.Metafile.MetaPict;
        SetDrawAspect (IconWanted, MetaPict);
// Now change types around, don't bother if CLSID the same
        if (FOleConvertDialog.Select = csConvertTo) and
          not IsEqualCLSID (FOleConvertDialog.AsCLSID, FOleConvertDialog.NewCLSID) then
        begin
// User selected convert, so:
// 1.  Unload the object
          OleCheck (FOleObject.Close (OLECLOSE_SAVEIFDIRTY));
          FOleObject := nil;
// 2.  Call OleStdDoConvert, which calls WriteClassStg,
//     WriteFmtUserTypeStg, and SetConvertStg.
          OleStdDoConvert (FStorage, FOleConvertDialog.NewCLSID);
          FStorage.Commit (STGC_DEFAULT);
// 3.  Reload the object and force an update.
          OleCheck (OleLoad (FStorage, IOleObject, Self, FOleObject));
          if IconWanted then
            FDrawAspect := dvaIcon
          else
            FDrawAspect := dvaContent;
          InitObject;
          UpdateVerbs;
          UpdateView
        end
      finally
        Screen.Cursor := crDefault
      end
    end
  end
end;

(*
        if (CF_SELECTACTIVATEAS & ct.dwFlags)
            {
            /*
             * User selected Activate As, so:
             *  1.  Add the TreatAs entry in the registry
             *      through CoTreatAsClass
             *  2.  Unload all objects of the old CLSID that you
             *      have loaded.
             *  3.  Reload objects as desired
             *  4.  Activate the current object.
             */

            hr=CoTreatAsClass(ct.clsid, ct.clsidNew);

            if (SUCCEEDED(hr))
                {
                PCTenant    pTenant;
                UINT        i;

                for (i=0; i < m_cTenants; i++)
                    {
                    if (TenantGet(i, &pTenant, FALSE))
                        {
                        pTenant->GetInfo(&ti);
                        pTenant->Close(FALSE);
                        pTenant->Load(m_pIStorage, &ti);
                        }
                    }

                fActivate=TRUE;
                }
            }

        //These two steps insure the object knows of the size.
        m_pTenantCur->SizeGet(&szl, FALSE);
        m_pTenantCur->SizeSet(&szl, FALSE, TRUE);

        m_pTenantCur->EnableRepaint(TRUE);
        m_pTenantCur->Repaint();

        if (fActivate)
            m_pTenantCur->Activate(OLEIVERB_SHOW, NULL);

        SetCursor(hCur);
        }

    CoTaskMemFree((void* )ct.lpszUserType);
    INOLE_MetafilePictIconFree(ct.hMetaPict);

    return TRUE;
    }
*)

procedure TOle2Container.CreateAccelTable;
var
  Menu: TMainMenu;
begin
  if FAccelTable = 0 then
  begin
    Menu := FFrameForm.Form.Menu;
    if Menu <> nil then
      Menu.GetOle2AcceleratorTable(FAccelTable, FAccelCount, [0, 2, 4]);
  end;
end;

procedure TOle2Container.CreateLinkToFile(const FileName: string;
  Iconic: Boolean);
var
  CreateInfo: TCreateInfo;
begin
  CreateInfo.CreateType := ctLinkToFile;
  CreateInfo.ShowAsIcon := Iconic;
  CreateInfo.IconMetaPict := 0;
  CreateInfo.FileName := FileName;
  CreateObjectFromInfo(CreateInfo);
end;

procedure TOle2Container.CreateObject(const OleClassName: string;
  Iconic: Boolean);
var
  CreateInfo: TCreateInfo;
begin
  CreateInfo.CreateType := ctNewObject;
  CreateInfo.ShowAsIcon := Iconic;
  CreateInfo.IconMetaPict := 0;
  CreateInfo.ClassID := ProgIDToClassID(OleClassName);
  CreateObjectFromInfo(CreateInfo);
end;

procedure TOle2Container.CreateObjectFromFile (const FileName: string; Iconic: Boolean);
var
  CreateInfo: TCreateInfo;
begin
  CreateInfo.CreateType := ctFromFile;
  CreateInfo.ShowAsIcon := Iconic;
  CreateInfo.IconMetaPict := 0;
  CreateInfo.FileName := FileName;
  CreateObjectFromInfo(CreateInfo)
end;

procedure TOle2Container.CreateObjectFromInfo(const CreateInfo: TCreateInfo);
var
  Size : TPoint;
begin
  DestroyObject;
  try
    CreateStorage;
    with CreateInfo do
    begin
      case CreateType of
        ctNewObject    : OleCheck(OleCreate(ClassID, IOleObject, OLERENDER_DRAW, nil, Self, FStorage, FOleObject));
        ctFromFile     : OleCheck(OleCreateFromFile(GUID_NULL, PWideChar(FileName), IOleObject, OLERENDER_DRAW, nil, Self, FStorage, FOleObject));
        ctLinkToFile   : OleCheck(OleCreateLinkToFile(PWideChar(FileName), IOleObject, OLERENDER_DRAW, nil, Self, FStorage, FOleObject));
        ctFromData     : OleCheck(OleCreateFromData(DataObject, IOleObject, OLERENDER_DRAW, nil, Self, FStorage, FOleObject));
        ctLinkFromData : OleCheck(OleCreateLinkFromData(DataObject, IOleObject, OLERENDER_DRAW, nil, Self, FStorage, FOleObject));
      end;
      FDrawAspect := DVASPECT_CONTENT;
      InitObject;
      XFormSizeInPixelsToHimetric(0, Point (ClientWidth, ClientHeight), Size);
      FOleObject.SetExtent (DVASPECT_CONTENT, Size);
      SetDrawAspect(ShowAsIcon, IconMetaPict);
      UpdateView;
      FOleObject.GetExtent (dvaContent, FOrgSize)
    end;
  except
    DestroyObject;
    raise
  end
end;