
{*******************************************************}
{                                                       }
{       Delphi Visual Component Library                 }
{                                                       }
{       Copyright (c) 1995 Borland International        }
{                                                       }
{*******************************************************}

unit ToCtrl;

interface

uses Controls, Classes, Forms, Messages, WinTypes,
     Ole2, ToUnk, BCom, BoleDefs, BoleIntf, ToIntf, Menus,
     SysUtils, StdCtrls;

type

  TAutoActivate = (aaManual, aaGetFocus, aaDoubleClick);
  TZoomFactor   = (z025,z050,z100,z150,z200);

  TStatusLineEvent = procedure(Sender: TObject; Msg: String) of object;

  TOleContainer = class(TCustomControl)
  private
    FBorder: TBorderStyle;
    FMemHandle: THandle;
    FLockBytes: ILockBytes;
    FStorage: IStorage;
    FInfo: BoleInitInfo;
    FActive: Boolean;
    FInPlaceActive: Boolean;
    FAutoActivate: TAutoActivate;
    FAutoSize: Boolean;
    FCLSID: CLSID;
    FModified: Boolean;
    FInActivation: Boolean;
    FConvertDlgHelp: THelpContext;
    FPartRect: TRect;
    FPartCtrl: TControl;
    FZoom: TZoomFactor;
    FSite: TIBSite;
    FLink: InitHow;
    FObjClass: String;
    FDoc: String;
    FVerbs: TStrings;
    FVerbType: String;
    FAllowInPlace: Boolean;
    FOnActivate: TNotifyEvent;
    FOnStatusLine: TStatusLineEvent;
    function GetStorage: IStorage;
    function GetPart: IBPart;
    function GetInfo: Pointer;
    function GetObjClass: String;
    function GetObjDoc: String;
    function GetObjItem: String;
    function GetObjMenuItem: TMenuItem;
    procedure SetActive(NewActive: Boolean);
    procedure SetInPlaceActive(NewActive: Boolean);
    procedure SetPartRect(Value: TRect);
    procedure SetBorderStyle(Style: TBorderStyle);
    procedure SetZoomFactor(ZF: TZoomFactor);
    procedure SetInitInfo(Info: BoleInitInfo);
    procedure SetInfo(PInfo: Pointer);
    procedure SetObjClass(Str: String); 
    procedure SetObjDoc (Str: String); 
    procedure SetObjItem(Str: String); 
    procedure SetObjMenuItem;
    procedure ReadInitInfo(Reader: TReader);
    procedure WriteInitInfo(Writer: TWriter);
    procedure ReadData(Stream: TStream);
    procedure WriteData(Stream: TStream);
    procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); 
      message WM_WINDOWPOSCHANGED;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
    procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure WMNCDestroy(var Message: TWMNCDestroy); message WM_NCDESTROY;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus(var Message: TWMSetFocus); message WM_KILLFOCUS;
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure CMExit(var Message: TCMExit);   message CM_EXIT;
    procedure WMMove(var Message: TWMMove); message WM_MOVE;
  protected
    procedure CreateHandle; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Paint; override;
    procedure ResetObjMenuItem;
    procedure ObjMenuItemClick(Sender: TObject);
    procedure ConvertItemClick(Sender: TObject);
    procedure CheckLinkInfo(Update: Boolean);
    procedure CreateSite;
    procedure DefineProperties(Filer: TFiler); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure ActivateControl;    
    procedure DeactivateControl;  
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetContainer: TIBCont;
    function OleObjAllocated: Boolean;
    function GetObjectMenuItemCount: Integer; 
    function GetObjectMenuItem(Index: Integer): string; 
    procedure CopyToClipboard(Clear: Boolean);
    procedure LoadFromFile(const FileName: string);
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToFile(const FileName: string);
    procedure SaveToStream(Stream: TStream);
    procedure ObjectMenuAction(Index: Integer); 
    procedure DeleteSite;  
    procedure DeleteStorage;  
    procedure DoStatusLineMsg(Msg :String);
    procedure ActivateObjMenuItem(Activate: Boolean);
    property InPlaceActive: Boolean read FInPlaceActive write SetInPlaceActive;
    property Modified: Boolean read FModified write FModified;
    property PInitInfo: Pointer read GetInfo write SetInfo;
    property Active: Boolean read FActive write SetActive;
    property Storage: IStorage read GetStorage;
    property Site: TIBSite read FSite write FSite;
    property Part: IBPart read GetPart;
    property PartRect: TRect read FPartRect write SetPartRect;
    property InActivation: Boolean read FInActivation;
    property InitInfo: BoleInitInfo read FInfo write SetInitInfo;
  published
    property Align;
    property AllowInPlace: Boolean read FAllowInPlace write FAllowInPlace default True;
    property AutoSize: Boolean read FAutoSize write FAutoSize default False;
    property AutoActivate: TAutoActivate read FAutoActivate write FAutoActivate
      default aaDoubleClick;
    property BorderStyle: TBorderStyle read FBorder write SetBorderStyle
      default bsSingle;
    property ConvertDlgHelp: THelpContext read FConvertDlgHelp write FConvertDlgHelp default 0;
    property Ctl3D;
    property DragCursor;
    property DragMode;
    property Enabled;
    property ObjClass: String read GetObjClass write SetObjClass;
    property ObjDoc: String read GetObjDoc write SetObjDoc;
    property ObjItem: String read GetObjItem write SetObjItem;
    property ParentCtl3D;
    property ParentShowHint;
    property ShowHint;
    property TabOrder;
    property TabStop default True;
    property Visible;
    property Zoom: TZoomFactor read FZoom write SetZoomFactor default z100;
    property OnActivate: TNotifyEvent read FOnActivate write FOnActivate;
    property OnStatusLineEvent: TStatusLineEvent read FOnStatusLine write FOnStatusLine;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnDblClick;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
  end;

   { This is the object that comes in for an ole drop event }
  TOleDropNotify = class(TObject)
  private
    FDropForm: TForm;
    FDropRect: TRect;
    FInfo: BoleInitInfo;
    FDataFormat: Word;
    FDataHandle: THandle;
  protected
    function GetInfoPtr: Pointer;
  public
    procedure SetInfo(Form: TForm; Rect: TRect; Info: BoleInitInfo);
    property DropForm: TForm read FDropForm;
    property DropRect: TRect read FDropRect;
    property DataFormat: Word read FDataFormat;
    property DataHandle: THandle read FDataHandle;
    property PInitInfo: Pointer read GetInfoPtr;
  end;

  PBoleInitInfo = ^BoleInitInfo;

  procedure RegisterFormAsOleDropTarget(Form: TForm; 
    const Fmts: array of BOleFormat);
  procedure SetFormOleDropFormats(Form: TForm;
    const Fmts: array of BOleFormat);
  procedure ClearFormOleDropFormats(Form: TForm);
  function InsertOleObjectDlg(Form: TForm;  HelpContext: THelpContext;
    var PInitInfo: Pointer): Boolean;
  function PasteSpecialDlg(Form: TForm; const Fmts: array of BOleFormat;
    HelpContext: THelpContext; var Format: Word;  var Handle: THandle;
    var PInitInfo: Pointer ): Boolean;
  function PasteSpecialEnabled(Form: TForm; 
    const Fmts: array of BOleFormat): Boolean;
  procedure LinksDlg(Form: TForm; HelpContext: THelpContext);
  function LinksDlgEnabled(Form: TForm): Boolean;
  procedure RegisterFormAsOleDropTgt(Form: TForm);
  function PasteSpecialOleDlg(Form: TForm;  HelpContext: THelpContext;
    var PInitInfo: Pointer): Boolean;
  function PasteSpecialOleEnabled(Form: TForm): Boolean;
  procedure ReleaseOleInitInfo(PInitInfo: Pointer);
  function OleFormat(AFmtId: Word; AName, AResultName: String;
    AIsLinkable: Bool): BOleFormat;  { "constructor" for BOleFormat }               
  function BOleMediumCalc(fmtId: Word): BOleMedium;  

const
  NibWidth = 6;


implementation

uses WinProcs, ToConsts, Dialogs, Graphics, ToHlpr;

procedure RegisterFormAsOleDropTarget(Form: TForm;
                        const Fmts: array of BOleFormat);
begin
  if (BoleroObj.AppInt = Nil) then  {bolero not initialized?}
    Exit;

  if (Form.Helper = Nil) or 
     (Form.Helper is TAppHelper) then   
  begin
    TIBCont.Create(Form); { this will add it also to the form }
  end;
  Form.DropTarget := True;
  TContHelper(Form.Helper).ContInt.DropDest.SetDropFmts(Fmts);
end;

procedure SetFormOleDropFormats(Form: TForm;
                        const Fmts: array of BOleFormat);
begin
  if Form.DropTarget then
  begin
    TContHelper(Form.Helper).ContInt.DropDest.SetDropFmts(Fmts);
  end;
end;

procedure ClearFormOleDropFormats(Form: TForm);
begin
  if Form.DropTarget then
  begin
    TContHelper(Form.Helper).ContInt.DropDest.ClearDropFmts;
  end;
end;

procedure RegisterFormAsOleDropTgt(Form: TForm);
begin
  if (BoleroObj.AppInt = Nil) then  {bolero not initialized?}
    Exit;

  if (Form.Helper = Nil) or 
     (Form.Helper is TAppHelper) then   
  begin
    TIBCont.Create(Form); { this will add it also to the form }
  end;
  Form.DropTarget := True;
end;

function InsertOleObjectDlg(Form: TForm; HelpContext: THelpContext;
                             var PInitInfo: Pointer): Boolean;
var
  sz: PChar;
  PInfo: PBoleInitInfo;
begin
  PInfo := Nil;
  Result := False;
  if (BoleroObj.AppInt = Nil) then Exit; {bolero not initialized?}
  if Form = Nil then Exit;

  BoleroObj.AppInt.Init(Form);    {ensures proper init}
  try
    PInfo := AllocMem(sizeof (BOleInitInfo));
    PInitInfo := PInfo;
    PInfo^.pContainer := Nil;
    if Form.Helper <> Nil then
      PInfo^.pContainer := TContHelper(Form.Helper).ContInt;

    if (BoleroObj.AppInt.InsertOleObjectDlg(PInfo^, HelpContext) = HRESULT(0)) then 
      Result := True;
  finally
    if (PInfo <> Nil) and (Result = False) then
    begin
      FreeMem(PInfo, sizeof(BOleInitInfo) );
      PInitInfo := Nil;
    end;
  end;
end;

function PasteSpecDlg(Form: TForm; 
                        HelpContext: THelpContext;
                        var PInitInfo: Pointer): Boolean;
var
  sz: PChar;
  PInit: PBoleInitInfo;
begin
  PInit := Nil;
  Result := False;
  if (BoleroObj.AppInt = Nil) then Exit; {bolero not initialized?}
  if Form = Nil then Exit;

  BoleroObj.AppInt.Init(Form);    {ensures proper init}
  try
    PInit := AllocMem(sizeof (BOleInitInfo));
    PInitInfo := PInit;
    PInit^.pContainer := Nil;
    if Form.Helper <> Nil then
      PInit^.pContainer := TContHelper(Form.Helper).ContInt;

    if (BoleroObj.AppInt.PasteSpecialDlg(PInit^, HelpContext) = HRESULT(0)) then 
      Result := True;
  finally
    if (PInit <> Nil) and (Result = False) then
    begin
      FreeMem(PInit, sizeof(BOleInitInfo) );
      PInitInfo := Nil;
    end;
    BoleroObj.AppInt.ClipBrowse := False;
  end;
end;

function PasteSpecEnabled(Form: TForm): Boolean;
begin
  Result := False;
  if (Form = Nil) or (Form.Helper = Nil) then
    Exit;

  BoleroObj.AppInt.Init(Form);    {ensures proper init}
  BoleroObj.AppInt.ClipBrowse := True;
  if (BoleroObj.AppInt.Service.EnableEditMenu(BOLE_ENABLE_BROWSECLIPBOARD,
                  TContHelper(Form.Helper).ContInt.DropDest) and 
                  BOLE_ENABLE_BROWSECLIPBOARD) <> 0 then 
    Result := True;
  BoleroObj.AppInt.ClipBrowse := False;
end;

function LinksDlgEnabled(Form: TForm): Boolean;
begin
  Result := False;
  if (Form = Nil) or (Form.Helper = Nil) then
    Exit;

  BoleroObj.AppInt.Init(Form);    {ensures proper init}
  if (BoleroObj.AppInt.Service.EnableEditMenu(BOLE_ENABLE_BROWSELINKS,
                  TContHelper(Form.Helper).ContInt.DropDest) and 
                  BOLE_ENABLE_BROWSELINKS) <> 0 then 
    Result := True;
end;

procedure LinksDlg(Form: TForm; HelpContext: THelpContext);
var
  I: Integer;
  OldLink: InitHow;
begin
  if (Form <> Nil) and (Form.Helper <> Nil) then
  begin
    with TContHelper(Form.Helper).ContInt do
    begin
      LinksDlg(HelpContext);
      for I := 0 to (SiteCount - 1) do
      begin
        with TOleContainer(Sites[I].Control) do
        begin
          OldLink := FLink;
          CheckLinkInfo(False);
          if OldLink <> FLink then 
          begin
            Invalidate;
            if Sites[I].Control = Form.ActiveControl then
              SetObjMenuItem;
          end;
        end;
      end;
    end;
  end;
end;

function PasteSpecialDlg(Form: TForm; 
                        const Fmts: array of BOleFormat;
                        HelpContext: THelpContext;
                        var Format: Word;  var Handle: THandle;
                        var PInitInfo: Pointer ): Boolean;
var
  PInit: PBoleInitInfo;
begin
  Result := False;
  Format := $ffff;
  PInitInfo := Nil;
  if (BoleroObj.AppInt = Nil) then  {bolero not initialized?}
    Exit;
  try
    ClipFmtListCreate(PasteFmts, Fmts);
    Result := PasteSpecDlg(Form, HelpContext, PInitInfo);
    PInit := PInitInfo;
    if Result and (PInit^.Where = BOLE_HANDLE) then
    begin
      Format := PInit^.DataFormat;
      Handle := PInit^.DataHandle;
    end;
  finally
    BoleroObj.AppInt.ClipBrowse := False;
    ClipFmtListFree(PasteFmts);
    if (Format <> $ffff)  and (PInitInfo <> Nil) then
    begin
      FreeMem(PInitInfo, sizeof(BOleInitInfo) );
      PInitInfo := Nil;
    end;
  end;
end;

function PasteSpecialEnabled(Form: TForm; 
                        const Fmts: array of BOleFormat): Boolean;
begin
  Result := False;
  if (BoleroObj.AppInt = Nil) then  {bolero not initialized?}
    Exit;

  try
    ClipFmtListCreate(PasteFmts, Fmts);
    Result := PasteSpecEnabled(Form);
  finally
    BoleroObj.AppInt.ClipBrowse := False;
    ClipFmtListFree(PasteFmts);
  end;
end;

function PasteSpecialOleDlg(Form: TForm; HelpContext: THelpContext; 
                             var PInitInfo: Pointer): Boolean;
begin
  PasteFmts := Nil;
  Result := PasteSpecDlg(Form, HelpContext, PInitInfo);
end;

function PasteSpecialOleEnabled(Form: TForm): Boolean;
begin
  PasteFmts := Nil;
  Result := PasteSpecEnabled(Form);
end;

procedure ReleaseOleInitInfo(PInitInfo: Pointer);
var
  PInfo: PBoleInitInfo;
begin
  if PInitInfo <> Nil then
  begin
    PInfo := PInitInfo;
    ReleaseDataObject(PInfo^); 
    FreeMem(PInitInfo, sizeof(BOleInitInfo) );
  end;
end;

 { "Constructor" for BOleFormat struct }
function OleFormat(AFmtId: Word; AName, AResultName: String;      
           AIsLinkable: Bool): BOleFormat;  
begin
  with Result do
  begin
    fmtId := AFmtId;
    fmtMedium := BOleMediumCalc(AFmtId);
    fmtIsLinkable := AIsLinkable;  
    StrPCopy(fmtName, AName);
    StrPCopy(fmtResultName, AResultName);
  end;
end;

function BOleMediumCalc(fmtId: Word): BOleMedium;
begin
  Result := BOLE_MED_HGLOBAL;
  if fmtId = cf_MetaFilePict then
    Result := BOLE_MED_MFPICT
  else if fmtId = BoleroObj.LinkClipFmt then
    Result := BOLE_MED_STREAM
  else if fmtId = BoleroObj.EmbedClipFmt then
    Result := BOLE_MED_STORAGE
  else if fmtId in [cf_Bitmap, cf_SYLK, cf_DIF, cf_TIFF, cf_DIB, cf_Palette, 
      cf_PenData, cf_RIFF, cf_Wave] then
    Result := BOLE_MED_GDI;
end;

{--------}
constructor TOleContainer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  TabStop := True;
  ControlStyle := ControlStyle + [csFramed];
  FAllowInPlace := True;
  FZoom := z100;
  FDoc := EmptyStr;
  FObjClass := EmptyStr;
  FMemHandle := 0;
  FStorage := Nil;
  FBorder := bsSingle;
  FActive := False;
  FVerbs := TStringList.Create;

  Width := 100;
  Height := 100;   {minimal default size}

  FAutoActivate := aaDoubleClick;
  FAutoSize := False;
  with FInfo do
  begin
    How := High(Integer);  { flag for uninitialized }
    Where := High(Integer);
  end;
  FLink := FInfo.How;
end;                


destructor TOleContainer.Destroy;
begin
  DeleteSite;
  DeleteStorage;
  FVerbs.Free;
  inherited Destroy;
end;

procedure TOleContainer.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('InitInfo', ReadInitInfo,  WriteInitInfo, Part <> nil);
  Filer.DefineBinaryProperty('Data', ReadData, WriteData, Part <> nil);
end;

procedure TOleContainer.ReadInitInfo(Reader: TReader);
var
  Value: String;
  Text: String;
  TopicId: LongInt;
  E: Integer;
  Temp: Integer;
begin
  FPartRect := BoundsRect;  { reset part size initially }
  Reader.ReadListBegin;
  while not Reader.EndOfList do 
  begin
    Value := Reader.ReadString;
    Temp := Pos(' ', Value);
    Text := Copy(Value, Temp + 1, Length(Value) - Temp);

    case Value[1] of
      'F': Val(Text, FLink, E);   {'FLink'}
      'I': Val(Text, Temp, E);    {'Iconic'}
      'P':    {'Path'}
        begin
          if FLink = BOLE_LINK then
            FDoc := Text;   
        end;

        { init for FPartRect }
      'L': Val(Text, FPartRect.Left, E);     {'Left'}  
      'R': Val(Text, FPartRect.Right, E);    {'Right'} 
      'T': Val(Text, FPartRect.Top, E);      {'Top'}   
      'B': Val(Text, FPartRect.Bottom, E);   {'Bottom'}
    end;
  end;
  Reader.ReadListEnd;

  FInfo.How := FLink;
  if FLink = BOLE_EMBED then
    FInfo.Where := BOLE_STORAGE
  else if FLink = BOLE_LINK then
    FInfo.Where := BOLE_STORAGE;
  FPartRect.Right := Left + FPartRect.Right - FPartRect.Left;
  FPartRect.Bottom := Top + FPartRect.Bottom - FPartRect.Top;
  FPartRect.Top := Top;
  FPartRect.Left := Left;
end;

procedure TOleContainer.WriteInitInfo(Writer: TWriter);
var
  Value: String;
  Path: String;
  IntVal: Integer;
begin
  Writer.WriteListBegin;
  Value := Format('FLink %d', [FLink]);
  Writer.WriteString(Value);   {Count := 0}

  IntVal := FInfo.Where;
  Value := Format('Where %d', [IntVal]);
  Writer.WriteString(Value);   {Count := 1}

  IntVal := Integer(FInfo.hIcon <> 0);
  Value := Format('Iconic %d', [IntVal]);
  Writer.WriteString(Value);   {Count := 2}

  if FLink = BOLE_LINK then
  begin
    Value := Format('Path %s', [FDoc]);
    Writer.WriteString(Value);   {Count := 3}
  end;

  IntVal := FPartRect.Left;
  Value := Format('Left %d', [IntVal]);
  Writer.WriteString(Value);   {Count := 2}

  IntVal := FPartRect.Top;
  Value := Format('Top %d', [IntVal]);
  Writer.WriteString(Value);   {Count := 2}

  IntVal := FPartRect.Right;
  Value := Format('Right %d', [IntVal]);
  Writer.WriteString(Value);   {Count := 2}

  IntVal := FPartRect.Bottom;
  Value := Format('Bottom %d', [IntVal]);
  Writer.WriteString(Value);   {Count := 2}

  Writer.WriteListEnd;
end;

procedure TOleContainer.ReadData(Stream: TStream);
var
  Size: LongInt;
  Buf: Pointer;
begin
  Stream.Read(Size, SizeOf(Size));
  if Size > 0 then
  begin
    FMemHandle := GlobalAlloc(GMEM_MOVEABLE, Size);
    if FMemHandle = 0 then
      raise EOutOfMemory.Create( LoadStr(SOutOfMemory));
    Buf := GlobalLock(FMemHandle);
    Stream.Read(Buf^, Size);
    GlobalUnlock(FMemHandle);
  end;
end;

procedure TOleContainer.WriteData(Stream: TStream);
var
  Size: Longint;
  Buf: Pointer;

  MemHdl: THandle;
  Stat: TStatStg;
  temp: Longint;
  BufOffset: ULargeint;
  LockSize: ULargeint;
  herr: HRESULT;
  ok: Boolean;
begin
  if Part <> Nil then
  begin
    if not (Part.Save(FStorage, True, False) = HRESULT(0)) then
      raise EBolero.Create(LoadStr(SPartSave));
    begin
      GlobalUnlock(FMemHandle);
      herr := FLockBytes.Stat(Stat, 0);
      Size := Trunc(Stat.cbSize);
      Stream.Write(Size, SizeOf(Size));

      Size := $4000;
      MemHdl := GlobalAlloc(GMEM_MOVEABLE, Size);
      if MemHdl = 0 then
        raise EOutOfMemory.Create( LoadStr(SOutOfMemory));
      Buf := GlobalLock(MemHdl);
      LockSize := Size;
      BufOffset := 0;
      while BufOffset < Stat.cbSize do
      begin
        herr := FLockBytes.LockRegion(BufOffset, LockSize, 1);
        herr := FLockBytes.ReadAt(BufOffset, Buf, Size, Temp);
        Temp := Size;
        if (Stat.cbSize - BufOffset) < Size then
          Temp := Trunc(Stat.cbSize - BufOffset);
        Stream.Write(Buf^, Temp);
        herr := FLockBytes.UnlockRegion(BufOffset, LockSize, 1);
        BufOffset := BufOffset + Size;
      end;
      GlobalUnlock(MemHdl);
      GlobalFree(MemHdl);
    end;
  end
  else
  begin
    Size := 0;
    Stream.Write(Size, SizeOf(Size));
  end;
end;

procedure TOleContainer.LoadFromFile(const FileName: string);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TOleContainer.LoadFromStream(Stream: TStream);
begin
  DeleteSite;
  DeleteStorage;
  Stream.Read(FPartRect, SizeOf(FPartRect));
  ReadData(Stream);
  if FMemHandle <> 0 then
  begin
    FInfo.How := BOLE_EMBED;  {in storage case, this field is ignored}
    FInfo.Where := BOLE_STORAGE;
    CreateSite;
  end;
end;

procedure TOleContainer.SaveToFile(const FileName: string);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  try
    SaveToStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TOleContainer.SaveToStream(Stream: TStream);
begin
  Stream.Write(FPartRect, SizeOf(FPartRect));
  WriteData(Stream);
end;

procedure TOleContainer.CreateHandle;
var
  Ctrl: TControl;
  SelfIndex: Integer;
begin
  inherited CreateHandle;
  DeleteSite;   {ensures that if for some reason one exists, we clean it}
  CreateSite;
end;

procedure TOleContainer.WMNCDestroy(var Message: TWMNCDestroy);
begin
  DeleteSite;   
  inherited;
end;

procedure TOleContainer.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  if FBorder  = bsSingle then
    Params.Style := Params.Style or (WS_BORDER);  
end;

function TOleContainer.GetContainer: TIBCont;
begin
  Result := Nil;
  if GetParentForm(Self)  <> Nil then
    if GetParentForm(Self).Helper <> Nil then
      Result := TContHelper(GetParentForm(Self).Helper).ContInt;
end;

function TOleContainer.GetPart: IBPart;
begin
  Result := Nil;
  if FSite <> Nil then
    Result := FSite.Part
end;                

function TOleContainer.GetStorage: IStorage;
begin
  Result := Nil;
  if Part <> Nil then
  begin
    if not (Part.Save(FStorage, True, False) = HRESULT(0)) then
      raise EBolero.Create(LoadStr(SPartSave));
    Result := FStorage;
  end;
end;                

procedure TOleContainer.DeleteSite;
begin
  if FSite <> Nil then 
  begin
    SetActive(False);
    if Part <> Nil then
      Part.Close;
    FSite.Release;
    FSite := Nil;
    FVerbs.Clear;
    if (GetParentForm(Self) <> nil) and 
        (Self = GetParentForm(Self).ActiveControl) then
      ResetObjMenuItem;
    if BoleroObj.AppInt.ActiveControl = Self then
      BoleroObj.AppInt.ActiveControl := nil;
  end;
end;

procedure TOleContainer.DeleteStorage;
begin
  if FStorage <> Nil then 
    FStorage.Release;
  if FLockBytes <> Nil then 
    FLockBytes.Release;
  if FMemHandle <> 0 then 
    GlobalFree(FMemHandle);

  FStorage := Nil;
  FLockBytes := Nil;
  FMemHandle := 0;
end;

procedure TOleContainer.CreateSite;
var
  Form: TForm;
  pName: PCharOle;
  ContInt: IBContainer;
  PartInt: IBPart;
  PartObj: IUnknown;
begin
  Form := GetParentForm(Self);
     {wait for CreateWnd to initialize, make sure bolero initialized OK}
  if (Form = Nil) or Not (HandleAllocated) or (BoleroObj.AppInt = Nil) then
    Exit;

    { ensure application and container initialized before going too far }
  BoleroObj.AppInt.Init(Form);
  if (Form.Helper = Nil) or 
     (Form.Helper is TAppHelper) then   
    TIBCont.Create(Form);  {this sets up form helper object properly}

  ContInt := GetContainer;
  if FInfo.How <> High(Integer) then
  begin
      { ensures that we have an Storage in ISite }
    if FStorage = Nil then
    begin
      if FMemHandle = 0 then
      begin
        FMemHandle := GlobalAlloc(GMEM_MOVEABLE, $100);
        if FMemHandle = 0 then 
          raise EBolero.Create(LoadStr(SOutOfMemory));
      end;

      if (CreateILockBytesOnHGlobal(FMemHandle, False, FLockBytes) 
                   <> Nil) then
        raise EBolero.Create(LoadStr(SCreateStorage));
      if FInfo.Where = BOLE_STORAGE then
      begin
        pName := nil;
        if (StgOpenStorageOnILockBytes(FLockBytes, Nil, 
                   (STGM_READWRITE or STGM_DIRECT or STGM_SHARE_EXCLUSIVE), 
                   pName, 0, FStorage) <> Nil) then
          raise EBolero.Create(LoadStr(SCreateStorage));
      end
      else
      begin
        if (StgCreateDocfileOnILockBytes(FLockBytes,  
             STGM_READWRITE or STGM_DIRECT or 
                               STGM_SHARE_EXCLUSIVE or STGM_CREATE, 
             0, FStorage) <> Nil ) then
          raise EBolero.Create(LoadStr(SCreateStorage));
      end;
      FLockBytes.AddRef;
      FStorage.AddRef;
    end;
    FInfo.Storage := FStorage;

       { ensures that we get an ISite }
    FSite := nil;
    FInfo.pContainer := ContInt;
    try
      FInActivation := True;
      BoleroObj.AppInt.ActiveControl := Self;
      FSite := TIBSite.Create(Self, FInfo);
    finally
      FInActivation := False;
    end;
    if Part = nil then
    begin
      MessageDlg(LoadStr(SBoleCreateErr), mtError, [mbOK], 0); 
      if FSite <> nil then
        FSite.Release;
      FSite := nil;
      Exit;
    end;

    FDoc := EmptyStr;
    FObjClass := EmptyStr;
    pName := Part.GetName(BOLE_NAME_SHORT);
    if pName <> Nil then
      FObjClass := StrPas(pName);
    CheckLinkInfo(True);
    if Self = Form.ActiveControl then
      SetObjMenuItem;
  end;
end;

procedure TOleContainer.CheckLinkInfo(Update: Boolean);
var
  LinkInfo: IBLinkInfo;
  Text: array[0..255] of Char;         
begin
  FLink := BOLE_EMBED;
  if Part.QueryInterface(IID_IBLinkInfo, LinkInfo) = HRESULT(0) then
  begin
    FLink := BOLE_LINK;
    LinkInfo.SourceGet(@Text, 255);
    FDoc := StrPas(Text);
    LinkInfo.Release;
    if Update then
      FSite.ContInt.DocInt.UpdateLinks;
  end;
end;

procedure TOleContainer.SetInPlaceActive(NewActive: Boolean);
var
  Rect: TRect;
begin
  if Not FInActivation and (Part <> nil) and not Site.InSiteShow then
    SetActive(NewActive)
  else if Site.InSiteShow then
  begin
    FInPlaceActive := NewActive;
    SetObjMenuItem;  
    if not FInActivation then FActive := NewActive;
    if not NewActive then WinProcs.SetFocus(Handle);
    if NewActive then
    begin  {create an invisible part ctrl to keep scroll bounds honest}
      if FPartCtrl = nil then
        FPartCtrl := TControl.Create(Self);
      Rect := FPartRect;
      Rect.Bottom := Rect.Bottom + 20;  {allow for sizing borders, scrollbars, etc}
      Rect.Right := Rect.Right + 20;  {allow for sizing borders, scrollbars, etc}
      FPartCtrl.BoundsRect := Rect;
      FPartCtrl.Parent := Parent;
      FPartCtrl.Visible := True;
    end
    else if not NewActive and (FPartCtrl <> nil) then
    begin
      FPartCtrl.Visible := False;
      FPartCtrl.BoundsRect := BoundsRect;
      FPartCtrl.Parent := nil;
    end;
  end;
end; 

procedure TOleContainer.SetPartRect(Value: TRect);
var 
  Rect: TRect;
begin
  FPartRect := Value;
  if AutoSize then BoundsRect := Value;
  if FPartCtrl <> nil then 
  begin
    Rect := FPartRect;
    Rect.Bottom := Rect.Bottom + 20;  {allow for sizing borders, scrollbars, etc}
    Rect.Right := Rect.Right + 20;  {allow for sizing borders, scrollbars, etc}
    FPartCtrl.BoundsRect := Rect;
  end;
end;

procedure TOleContainer.SetActive(NewActive: Boolean);
var
  err: HRESULT;
  ErrStr: string;
begin
  if Part <> Nil then
  begin
    if NewActive and FInPlaceActive then Exit;
    try
      FInActivation := True;
      BoleroObj.AppInt.ActiveControl := Self;
      err := Part.Activate(NewActive);
    finally
      FInActivation := False;
    end;
    if err = HRESULT(0) then 
    begin
      FActive := NewActive;
      if FActive then 
      begin
        FModified := True;
        if Assigned(FOnActivate) then FOnActivate(Self);
      end
      else
        GetContainer.FreeAccelerators;
    end
    else if NewActive then
    begin
      ErrStr := LoadStr(SBoleActivateErr);
      MessageDlg(ErrStr, mtError, [mbOK], 0); 
    end;
  end; 
end; 

procedure TOleContainer.SetBorderStyle(Style: TBorderStyle);
begin
  if Style <> FBorder then
  begin
    FBorder := Style;
    if HandleAllocated then
      RecreateWnd
  end;
end;

procedure TOleContainer.SetZoomFactor(ZF: TZoomFactor);
begin
  if ZF <> FZoom then
  begin
    FZoom := ZF;
    if HandleAllocated then Invalidate; {just redraw the win}
  end;
end;

procedure TOleContainer.SetInfo(PInfo: Pointer);
var
  PInitInfo: PBoleInitInfo;
begin
  PInitInfo := PInfo;
  SetInitInfo(PInitInfo^);
end;

function TOleContainer.GetInfo: Pointer;
begin
  Result := @FInfo;
end;

procedure TOleContainer.SetInitInfo(Info: BoleInitInfo);
begin
  SetActive(False);
  DeleteSite;
  DeleteStorage;
  FInfo.How := Info.How;
  FInfo.Where := Info.Where;
  FInfo.hIcon := Info.hIcon;
  FInfo.pContainer := nil;
  FInfo.Storage := nil;
  FInfo.DataHandle := Info.DataHandle;
  FInfo.DataFormat := Info.DataFormat;

  FPartRect := BoundsRect;  { reset part size initially }
  FLink := High(Integer);  { flag for uninitialized }

  if HandleAllocated = True then
    RecreateWnd;
end;
    
procedure TOleContainer.WMWindowPosChanged(var Message: TWMWindowPosChanged);
var
  Rect: TRect;
  Ctrl: TWinControl;
begin
  inherited;
end;

procedure TOleContainer.WMLButtonDown(var Message: TWMLButtonDown);
begin
  SetFocus;
  inherited;
end;

procedure TOleContainer.WMLButtonDblClk(var Message: TWMLButtonDblClk);
var
  CStyle: TControlStyle;
  CStyleSave: TControlStyle;
begin
  if (FAutoActivate = aaDoubleClick) 
     or (csDesigning in ComponentState) then
  begin
    CStyleSave := ControlStyle;
    CStyle := CStyleSave;
    Exclude(CStyle, csCaptureMouse);
    ControlStyle := CStyle;
    inherited;
    ControlStyle := CStyleSave;
    SetActive(True);
  end
  else
    inherited;
end;

procedure TOleContainer.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  if (FAutoActivate = aaDoubleClick) and (Key = VK_RETURN) and not FActive then
    SetActive(True);
end;

procedure TOleContainer.CMVisibleChanged(var Message: TMessage);
begin
  if HandleAllocated and not Visible then
    SetActive(False);
  inherited;
end;

procedure TOleContainer.CMShowingChanged(var Message: TMessage);
begin
  if HandleAllocated and not Visible then
    SetActive(False);
  inherited;
end;

procedure TOleContainer.CMEnabledChanged(var Message: TMessage);
begin
  if HandleAllocated and not Enabled then
    SetActive(False);
  inherited;
end;

procedure TOleContainer.CMEnter(var Message: TCMEnter);
begin
  inherited;
  ActivateControl;
end;

procedure TOleContainer.CMExit(var Message: TCMExit);
begin
  inherited;
  DeactivateControl;
end;

procedure TOleContainer.WMMove(var Message: TWMMove);
var
  OldX, OldY: Integer;
begin
    { the window may have scrolled.  Make sure that the part position keeps
      in sync }
  OldX := Left;
  OldY := Top;
  inherited;
  FPartRect.Left := FPartRect.Left + (Left - OldX);
  FPartRect.Right := FPartRect.Right + (Left - OldX);
  FPartRect.Top := FPartRect.Top + (Top - OldY);
  FPartRect.Bottom := FPartRect.Bottom + (Top - OldY);
  if (Part <> Nil) and FInPlaceActive then
    Part.SetPartPos(FPartRect);  
end;

procedure TOleContainer.Paint;
var
  PrevMapMode: Integer;
  PrevViewport: TPoint;
  PrevWindowExt: TPoint;
  PixPerInch: TPoint;
  Scale: TPoint;
  Rect: TRect;
  RectHM: TRectl;
  DC: HDC;
begin
  if Part <> Nil then
  begin
    Rect := BoundsRect;
    PixPerInch := BoleroObj.AppInt.PixPerInch;
    DC := Canvas.Handle;
    PrevMapMode := SetMapMode(DC, MM_ANISOTROPIC);
    Longint(PrevWindowExt) := SetWindowExt(DC, 
                              HIMETRIC_PER_INCH, HIMETRIC_PER_INCH);
    Longint(PrevViewport) := SetViewportExt(DC, PixPerInch.x, PixPerInch.y);
    {RectHM.left := MulDiv(HIMETRIC_PER_INCH, 0, PixPerInch.x);
    RectHM.top := MulDiv(HIMETRIC_PER_INCH, 0, PixPerInch.y);}
    RectHM.left := 0;
    RECTHM.top := 0;
    RectHM.right := MulDiv(HIMETRIC_PER_INCH, Rect.right - Rect.left, 
                                                      PixPerInch.x);
    RectHM.bottom := MulDiv(HIMETRIC_PER_INCH, Rect.bottom - Rect.top, 
                                                      PixPerInch.y);
    Part.Draw(DC, RectHM, RectHM, BOLE_DEFAULT or BOLE_CLIP, BOLE_DRAW_NONE);
    with PrevWindowExt do SetWindowExt(DC, X, Y);
    with PrevViewport do SetViewportExt(DC, X, Y);
    SetMapMode(DC, PrevMapMode);
  end;

  Rect := GetClientRect;
  if (Self = GetParentForm(Self).ActiveControl) and
     not (csDesigning in ComponentState)  then
  begin
    Canvas.Brush.Style := bsSolid;
    Canvas.Pen.Style := psSolid;
    Canvas.MoveTo(0, 0);
    Canvas.LineTo(0, Rect.Bottom-1);
    Canvas.LineTo(Rect.Right-1, Rect.Bottom-1);
    Canvas.LineTo(Rect.Right-1, 0);
    Canvas.LineTo(0, 0);
    Dec(Rect.Bottom);
    Dec(Rect.Right);
    Inc(Rect.Top);
    Inc(Rect.Left);
  end;

  if Part <> Nil then
  begin
    if FLink = BOLE_LINK then
    begin
      Canvas.Brush.Style := bsClear;
      Canvas.Pen.Style := psDash;
      Canvas.MoveTo(Rect.Left, Rect.Top);
      Canvas.LineTo(Rect.Left, Rect.Bottom-1);
      Canvas.LineTo(Rect.Right-1, Rect.Bottom-1);
      Canvas.LineTo(Rect.Right-1, Rect.Top);
      Canvas.LineTo(Rect.Left, Rect.Top);
    end;
  end;

end;

function TOleContainer.GetObjClass: String;
begin
  Result := FObjClass;
end;

procedure TOleContainer.SetObjClass(Str: String); 
begin
  FObjClass := Str;
end;

function TOleContainer.GetObjDoc: String;
var
  Temp: Integer;
begin
  Result := EmptyStr;
  if (FLink = BOLE_LINK) then
  begin
    Temp := Pos('!', FDoc);
    if Temp > 0 then
      Result := Copy(FDoc, 1, Temp - 1)
    else
      Result := FDoc;
  end;
end;

procedure TOleContainer.SetObjDoc(Str: String); 
begin
end;

function TOleContainer.GetObjItem: String;
var
  Temp: Integer;
begin
  Result := EmptyStr;
  if (FLink = BOLE_LINK) then
  begin
    Temp := Pos('!', FDoc);
    if Temp > 0 then
    begin
      Result := Copy(FDoc, Temp + 1, Length(FDoc) - Temp);
    end;
  end;
end;

procedure TOleContainer.SetObjItem(Str: String); 
begin
end;

function TOleContainer.OleObjAllocated: Boolean;
begin
  Result := Part <> Nil;
end;

procedure TOleContainer.DoStatusLineMsg(Msg :String);
begin
  if Assigned(FOnStatusLine) then
    FOnStatusLine(Self, Msg);
end;

function TOleContainer.GetObjMenuItem: TMenuItem;
var
  Frm: TForm;
begin
  Result := Nil;
  Frm := GetParentForm(Self);
  if Frm <> Nil then
  begin
    Result := Frm.ObjectMenuItem;
    if (Result = Nil) and 
       (Application.MainForm <> Nil) and
       (Application.MainForm.FormStyle = fsMDIForm) then
      Result := Application.MainForm.ObjectMenuItem;
  end;
end;

function TOleContainer.GetObjectMenuItemCount: Integer; 
var
  Verb: BOleVerb;
  res: HRESULT;
  MyPart: IBPart;
begin
  Result := 0;
  MyPart := GetPart;
  if (MyPart = Nil) then
    Exit;

  if FVerbs.Count > 0 then
  begin
    Result := FVerbs.Count + 2;
    Exit;
  end;

  FVerbs.Clear;
  Verb.verbName := nil;
  Verb.typeName := nil;
  res := MyPart.EnumVerbs(Verb);
  while res = HRESULT(0) do
  begin
    FVerbType := StrPas(Verb.typeName);
    FVerbs.Add( StrPas(Verb.verbName));
    res := MyPart.EnumVerbs(Verb);
  end;
  if FVerbs.Count > 0 then
    Result := FVerbs.Count + 2;
end;

function TOleContainer.GetObjectMenuItem(Index: Integer): string; 
var
  MyPart: IBPart;
begin
  MyPart := GetPart;
  if (FVerbs.Count = 0) and (MyPart <> Nil) then
    GetObjectMenuItemCount;

  if (Index < 0) or (FVerbs.Count = 0) or (Index > (FVerbs.Count + 2)) then
  begin
    Result := LoadStr(SObjItem);
    if MyPart <> Nil then
    begin
      if FLink = BOLE_LINK then
        Result := Format(LoadStr(SLinkedObjItem), [FVerbType])
      else
        Result := Format(LoadStr(SActiveObjItem), [FVerbType]);
    end;
  end
  else if Index = FVerbs.Count then 
    Result := '-'  {spacer object}
  else if (Index = (FVerbs.Count + 1)) then 
  	Result := LoadStr(SConvertItem)
  else 
  begin
    Result := FVerbs[Index];
  end;
end;

procedure TOleContainer.ObjectMenuAction(Index: Integer); 
var
  MyPart: IBPart;
begin
  MyPart := GetPart;
  if (FVerbs.Count = 0) and (MyPart <> Nil) then
    GetObjectMenuItemCount;

  if (Index < 0) or (FVerbs.Count = 0) or (Index > (FVerbs.Count + 2)) then
    Exit;
  if (Index < FVerbs.Count) then
  begin
    try
      FInActivation := True;
      BoleroObj.AppInt.ActiveControl := Self;
      Part.DoVerb(Index);
    finally
      FInActivation := False;
    end;
    FActive := True;  { assume this results in some type of activation}
  end
  else if Index = (FVerbs.Count + 1) then
  begin
    ConvertItemClick(Nil);
  end;
end;

procedure TOleContainer.ActivateObjMenuItem(Activate: Boolean);
begin
  if Activate then SetObjMenuItem
  else ResetObjMenuItem;
end;

procedure TOleContainer.SetObjMenuItem;
var
  ObjItem: TMenuItem;
  NuItem: TMenuItem;
  Count: Integer;
  I: Integer;
begin
  ObjItem := GetObjMenuItem;
  if (ObjItem = Nil) or (GetPart = Nil) or FInPlaceActive or
      (GetParentForm(Self).ActiveControl <> Self) then 
    Exit;

  ResetObjMenuItem;
  Count := GetObjectMenuItemCount;
  if Count > 0 then
    ObjItem.Enabled := True;

  ObjItem.Caption := GetObjectMenuItem(-1);
  for I := 0 to Count - 1 do
  begin
    NuItem := TMenuItem.Create(GetParentForm(Self));
  	NuItem.Caption := GetObjectMenuItem(I);
  	if NuItem.Caption <> '-' then
    	NuItem.OnClick := ObjMenuItemClick;
    ObjItem.Add(NuItem);
  end;
end;

procedure TOleContainer.ResetObjMenuItem;
var
  ObjItem: TMenuItem;
begin
  ObjItem := GetObjMenuItem;
  if ObjItem = Nil then
    Exit;

  If FInPlaceActive <> False then Exit;   {wait for object to deactivate}

  while ObjItem.Count > 0 do
    ObjItem.Items[0].Free;

  ObjItem.Caption := LoadStr(SObjItem);
  ObjItem.Enabled := False;
end;

procedure TOleContainer.ObjMenuItemClick(Sender: TObject);
var
  ObjItem: TMenuItem;
  Idx: Integer;
begin
  ObjItem := GetObjMenuItem;
  if ObjItem = Nil then
    Exit;

  Idx := ObjItem.IndexOf(TMenuItem(Sender));
  ObjectMenuAction(Idx);
end;

procedure TOleContainer.ConvertItemClick(Sender: TObject);
var
  WindowList: Pointer;
  ActiveWindow: HWnd;
  Info: BOleConvertInfo;
begin
  if not (csDesigning in ComponentState) then
    BoleroObj.AppInt.HelpButton.DlgHelpContext := FConvertDlgHelp
  else
    BoleroObj.AppInt.HelpButton.DlgHelpContext := 27090; {hcOleConvert}
  ActiveWindow := GetActiveWindow;
  WindowList := DisableTaskWindows(0); 
  try
  begin
    BoleroObj.AppInt.Service.ConvertUI(Part, False, Info);
    BoleroObj.AppInt.Service.ConvertGuts(Part, False, Info);
  end;
  finally
    EnableTaskWindows(WindowList);
    SetActiveWindow(ActiveWindow);
    BoleroObj.AppInt.HelpButton.DlgHelpContext := 0;
  end;
end;

procedure TOleContainer.ActivateControl;
begin
  if Part <> nil then BoleroObj.AppInt.ActiveControl := Self;
  if (FAutoActivate = aaGetFocus)
     and not (csDesigning in ComponentState) 
     and Not FInActivation then
    SetActive(True);
  If FActive = False then Invalidate;            {draw the focus marker}
  SetObjMenuItem;
end;

procedure TOleContainer.DeactivateControl;
begin
  if HandleAllocated then
  begin
    ResetObjMenuItem;
    Invalidate; {repaint without focus marker}
    if Not FInActivation then
      SetActive(False);
  end;
end;

procedure TOleContainer.WMSetFocus(var Message: TWMSetFocus);
var
  Frm: TForm;
begin
  inherited;
  Frm := GetParentForm(Self);
  if (Frm <> Nil) and (Frm.Helper <> Nil) then
    Frm.Helper.OnSetFocus(True);
end;

procedure TOleContainer.WMKillFocus(var Message: TWMSetFocus);
var
  Frm: TForm;
begin
  inherited;
  Frm := GetParentForm(Self);
  if (Frm <> Nil) and (Frm.Helper <> Nil) then
    Frm.Helper.OnSetFocus(False);
end;

procedure TOleContainer.CopyToClipboard(Clear: Boolean);
begin
  if Clear then
  	BoleroObj.AppInt.Service.Clip(Nil,  False, False, False);
	BoleroObj.AppInt.Service.Clip(Part, False, True,  True);
end;

{-------------------------------------------------------------}

procedure TOleDropNotify.SetInfo(Form: TForm; Rect: TRect; Info: BoleInitInfo);
begin
  FDropForm := Form;
  FDropRect := Rect;
  FInfo.How := Info.How;
  FInfo.Where := Info.Where;
  FInfo.hIcon := Info.hIcon;
  FInfo.pContainer := nil;
  FInfo.Storage := nil;
  FInfo.DataHandle := Info.DataHandle;
  FInfo.DataFormat := Info.DataFormat;

  FDataFormat := $FFFF;
  if FInfo.Where = BOLE_HANDLE then
  begin
    FDataFormat := FInfo.DataFormat;
    FDataHandle := FInfo.DataHandle;
  end;
end;
 

function TOleDropNotify.GetInfoPtr: Pointer;
begin
  if FDataFormat = $FFFF then
    Result := @FInfo
  else
    Result := Nil;
end;

begin
  RegisterClasses([TOleContainer]);
end.
