
{*******************************************************}
{                                                       }
{       Borland Delphi Visual Component Library         }
{       ActiveX Controls Unit                           }
{                                                       }
{  Copyright (c) 1995-2001 Borland Software Corporation }
{                                                       }
{*******************************************************}

unit AxCtrls;

{$WARN SYMBOL_PLATFORM OFF}

{$T-,H+,X+}

interface

(*$HPPEMIT '' *)
(*$HPPEMIT '#include <objsafe.h>' *)
(*$HPPEMIT '#include <ocidl.h>' *)
(*$HPPEMIT '' *)

uses
  Variants, Windows, Messages, ActiveX, SysUtils, {$IFDEF LINUX} WinUtils, {$ENDIF}
  ComObj, Classes, Graphics, Controls, Forms, ExtCtrls, StdVCL;

const
  { Delphi property page CLSIDs }
  Class_DColorPropPage: TGUID = '{5CFF5D59-5946-11D0-BDEF-00A024D1875C}';
  Class_DFontPropPage: TGUID = '{5CFF5D5B-5946-11D0-BDEF-00A024D1875C}';
  Class_DPicturePropPage: TGUID = '{5CFF5D5A-5946-11D0-BDEF-00A024D1875C}';
  Class_DStringPropPage: TGUID = '{F42D677E-754B-11D0-BDFB-00A024D1875C}';

type
  TOleStream = class(TStream)
  protected
    function GetIStream: IStream;
  public
    constructor Create(const Stream: IStream);
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
  end;

  TConnectionPoints = class;

  TConnectionKind = (ckSingle, ckMulti);
  {$EXTERNALSYM TConnectionKind}

  TConnectionPoint = class(TContainedObject, IConnectionPoint)
  protected
    { IConnectionPoint }
    function GetConnectionInterface(out iid: TIID): HResult; stdcall;
    function GetConnectionPointContainer(
      out cpc: IConnectionPointContainer): HResult; stdcall;
    function Advise(const unkSink: IUnknown; out dwCookie: Longint): HResult; stdcall;
    function Unadvise(dwCookie: Longint): HResult; stdcall;
    function EnumConnections(out enumconn: IEnumConnections): HResult; stdcall;
  public
    constructor Create(Container: TConnectionPoints;
      const IID: TGUID; Kind: TConnectionKind; OnConnect: TConnectEvent);
    property SinkList : TList;
    destructor Destroy; override;
  end;
  {$EXTERNALSYM TConnectionPoint}

  TConnectionPoints = class{IConnectionPointContainer}
  protected
    { IConnectionPointContainer }
    function EnumConnectionPoints(
      out enumconn: IEnumConnectionPoints): HResult; stdcall;
    function FindConnectionPoint(const iid: TIID;
      out cp: IConnectionPoint): HResult; stdcall;
  public
    constructor Create(const AController: IUnknown);
    destructor Destroy; override;
    function CreateConnectionPoint(const IID: TGUID; Kind: TConnectionKind;
      OnConnect: TConnectEvent): TConnectionPoint;
    property Controller: IUnknown;
  end;
  {$EXTERNALSYM TConnectionPoints}

  TDefinePropertyPage = procedure(const GUID: TGUID) of object;

  TActiveXControlFactory = class;
  {$EXTERNALSYM TActiveXControlFactory}

  IAmbientDispatch = dispinterface
    ['{00020400-0000-0000-C000-000000000046}']
    property BackColor: Integer dispid DISPID_AMBIENT_BACKCOLOR;
    property DisplayName: WideString dispid DISPID_AMBIENT_DISPLAYNAME;
    property Font: IFontDisp dispid DISPID_AMBIENT_FONT;
    property ForeColor: Integer dispid DISPID_AMBIENT_FORECOLOR;
    property LocaleID: Integer dispid DISPID_AMBIENT_LOCALEID;
    property MessageReflect: WordBool dispid DISPID_AMBIENT_MESSAGEREFLECT;
    property ScaleUnits: WideString dispid DISPID_AMBIENT_SCALEUNITS;
    property TextAlign: Smallint dispid DISPID_AMBIENT_TEXTALIGN;
    property UserMode: WordBool dispid DISPID_AMBIENT_USERMODE;
    property UIDead: WordBool dispid DISPID_AMBIENT_UIDEAD;
    property ShowGrabHandles: WordBool dispid DISPID_AMBIENT_SHOWGRABHANDLES;
    property ShowHatching: WordBool dispid DISPID_AMBIENT_SHOWHATCHING;
    property DisplayAsDefault: WordBool dispid DISPID_AMBIENT_DISPLAYASDEFAULT;
    property SupportsMnemonics: WordBool dispid DISPID_AMBIENT_SUPPORTSMNEMONICS;
    property AutoClip: WordBool dispid DISPID_AMBIENT_AUTOCLIP;
  end;

  TActiveXControl = class(TAutoObject,
    IConnectionPointContainer,
    IDataObject,
    IObjectSafety,
    IOleControl,
    IOleInPlaceActiveObject,
    IOleInPlaceObject,
    IOleObject,
    IPerPropertyBrowsing,
    IPersistPropertyBag,
    IPersistStorage,
    IPersistStreamInit,
    IQuickActivate,
    ISimpleFrameSite,
    ISpecifyPropertyPages,
    IViewObject,
    IViewObject2)

  protected
    { Renamed methods }
    function IPersistPropertyBag.InitNew = PersistPropBagInitNew;
    function IPersistPropertyBag.Load = PersistPropBagLoad;
    function IPersistPropertyBag.Save = PersistPropBagSave;
    function IPersistStreamInit.Load = PersistStreamLoad;
    function IPersistStreamInit.Save = PersistStreamSave;
    function IPersistStorage.InitNew = PersistStorageInitNew;
    function IPersistStorage.Load = PersistStorageLoad;
    function IPersistStorage.Save = PersistStorageSave;
    function IViewObject2.GetExtent = ViewObjectGetExtent;
    { IPersist }
    function GetClassID(out classID: TCLSID): HResult; stdcall;
    { IPersistPropertyBag }
    function PersistPropBagInitNew: HResult; stdcall;
    function PersistPropBagLoad(const pPropBag: IPropertyBag;
      const pErrorLog: IErrorLog): HResult; stdcall;
    function PersistPropBagSave(const pPropBag: IPropertyBag; fClearDirty: BOOL;
      fSaveAllProperties: BOOL): HResult; stdcall;
    { IPersistStreamInit }
    function IsDirty: HResult; stdcall;
    function PersistStreamLoad(const stm: IStream): HResult; stdcall;
    function PersistStreamSave(const stm: IStream;
      fClearDirty: BOOL): HResult; stdcall;
    function GetSizeMax(out cbSize: Largeint): HResult; stdcall;
    function InitNew: HResult; stdcall;
    { IPersistStorage }
    function PersistStorageInitNew(const stg: IStorage): HResult; stdcall;
    function PersistStorageLoad(const stg: IStorage): HResult; stdcall;
    function PersistStorageSave(const stgSave: IStorage;
      fSameAsLoad: BOOL): HResult; stdcall;
    function SaveCompleted(const stgNew: IStorage): HResult; stdcall;
    function HandsOffStorage: HResult; stdcall;
    { IObjectSafety }
    function GetInterfaceSafetyOptions(const IID: TIID; pdwSupportedOptions,
      pdwEnabledOptions: PDWORD): HResult; virtual; stdcall;
    function SetInterfaceSafetyOptions(const IID: TIID; dwOptionSetMask,
      dwEnabledOptions: DWORD): HResult; virtual; stdcall;
    { 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;
    { IOleControl }
    function GetControlInfo(var ci: TControlInfo): HResult; stdcall;
    function OnMnemonic(msg: PMsg): HResult; stdcall;
    function OnAmbientPropertyChange(dispid: TDispID): HResult; stdcall;
    function FreezeEvents(bFreeze: BOOL): HResult; stdcall;
    { IOleWindow }
    function GetWindow(out wnd: HWnd): HResult; stdcall;
    function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;
    { IOleInPlaceObject }
    function InPlaceDeactivate: HResult; stdcall;
    function UIDeactivate: HResult; stdcall;
    function SetObjectRects(const rcPosRect: TRect;
      const rcClipRect: TRect): HResult; stdcall;
    function ReactivateAndUndo: HResult; stdcall;
    { IOleInPlaceActiveObject }
    function TranslateAccelerator(var msg: TMsg): HResult; stdcall;
    function OnFrameWindowActivate(fActivate: BOOL): HResult; stdcall;
    function OnDocWindowActivate(fActivate: BOOL): HResult; stdcall;
    function ResizeBorder(const rcBorder: TRect; const uiWindow: IOleInPlaceUIWindow;
      fFrameWindow: BOOL): HResult; stdcall;
    function EnableModeless(fEnable: BOOL): HResult; stdcall;
    { IViewObject }
    function Draw(dwDrawAspect: Longint; lindex: Longint; pvAspect: Pointer;
      ptd: PDVTargetDevice; hicTargetDev: HDC; hdcDraw: HDC;
      prcBounds: PRect; prcWBounds: PRect; fnContinue: TContinueFunc;
      dwContinue: Longint): HResult; stdcall;
    function GetColorSet(dwDrawAspect: Longint; lindex: Longint;
      pvAspect: Pointer; ptd: PDVTargetDevice; hicTargetDev: HDC;
      out colorSet: PLogPalette): HResult; stdcall;
    function Freeze(dwDrawAspect: Longint; lindex: Longint; pvAspect: Pointer;
      out dwFreeze: Longint): HResult; stdcall;
    function Unfreeze(dwFreeze: Longint): HResult; stdcall;
    function SetAdvise(aspects: Longint; advf: Longint;
      const advSink: IAdviseSink): HResult; stdcall;
    function GetAdvise(pAspects: PLongint; pAdvf: PLONGINT;
      out advSink: IAdviseSink): HResult; stdcall;
    { IViewObject2 }
    function ViewObjectGetExtent(dwDrawAspect: Longint; lindex: Longint;
      ptd: PDVTargetDevice; out size: TPoint): HResult; stdcall;
    { IPerPropertyBrowsing }
    function GetDisplayString(dispid: TDispID; out bstr: WideString): HResult; stdcall;
    function MapPropertyToPage(dispid: TDispID; out clsid: TCLSID): HResult; stdcall;
    function GetPredefinedStrings(dispid: TDispID; out caStringsOut: TCAPOleStr;
      out caCookiesOut: TCALongint): HResult; stdcall;
    function GetPredefinedValue(dispid: TDispID; dwCookie: Longint;
      out varOut: OleVariant): HResult; stdcall;
    { ISpecifyPropertyPages }
    function GetPages(out pages: TCAGUID): HResult; stdcall;
    { ISimpleFrameSite }
    function PreMessageFilter(wnd: HWnd; msg, wp, lp: Integer;
      out res: Integer; out Cookie: Longint): HResult; stdcall;
    function PostMessageFilter(wnd: HWnd; msg, wp, lp: Integer;
      out res: Integer; Cookie: Longint): HResult; stdcall;
    { IQuickActivate }
    function QuickActivate(var qaCont: tagQACONTAINER; var qaCtrl: tagQACONTROL): HResult; stdcall;
    function SetContentExtent(const sizel: TPoint): HResult; stdcall;
    function GetContentExtent(out sizel: TPoint): HResult; stdcall;
    { 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;
    { Standard properties }
    function Get_BackColor: Integer; safecall;
    function Get_Caption: WideString; safecall;
    function Get_Enabled: WordBool; safecall;
    function Get_Font: Font; safecall;
    function Get_ForeColor: Integer; safecall;
    function Get_HWnd: Integer; safecall;
    function Get_TabStop: WordBool; safecall;
    function Get_Text: WideString; safecall;
    procedure Set_BackColor(Value: Integer); safecall;
    procedure Set_Caption(const Value: WideString); safecall;
    procedure Set_Enabled(Value: WordBool); safecall;
    procedure Set_Font(const Value: Font); safecall;
    procedure Set_ForeColor(Value: Integer); safecall;
    procedure Set_TabStop(Value: WordBool); safecall;
    procedure Set_Text(const Value: WideString); safecall;
    { Standard event handlers }
    procedure StdClickEvent(Sender: TObject);
    procedure StdDblClickEvent(Sender: TObject);
    procedure StdKeyDownEvent(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure StdKeyPressEvent(Sender: TObject; var Key: Char);
    procedure StdKeyUpEvent(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure StdMouseDownEvent(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure StdMouseMoveEvent(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure StdMouseUpEvent(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    { Helper methods }
    function InPlaceActivate(ActivateUI: Boolean): HResult;
    procedure ShowPropertyDialog;
    procedure SetInPlaceSite(const NewInPlaceSite: IOleInPlaceSite);
    { Overrideable methods }
    procedure DefinePropertyPages(
      DefinePropertyPage: TDefinePropertyPage); virtual;
    function GetPropertyString(DispID: Integer;
      var S: string): Boolean; virtual;
    function GetPropertyStrings(DispID: Integer;
      Strings: TStrings): Boolean; virtual;
    procedure GetPropertyValue(DispID, Cookie: Integer;
      var Value: OleVariant); virtual;
    procedure GetPropFromBag(const PropName: WideString; DispatchID: Integer;
      PropBag: IPropertyBag; ErrorLog: IErrorLog); virtual;
    procedure InitializeControl; virtual;
    procedure LoadFromStream(const Stream: IStream); virtual;
    procedure PerformVerb(Verb: Integer); virtual;
    procedure PutPropInBag(const PropName: WideString; DispatchID: Integer;
      PropBag: IPropertyBag); virtual;
    procedure SaveToStream(const Stream: IStream); virtual;
    procedure WndProc(var Message: TMessage); virtual;
    property ConnectionPoints: TConnectionPoints;
  public
    destructor Destroy; override;
    procedure Initialize; override;
    function ObjQueryInterface(const IID: TGUID; out Obj): HResult; override;
    procedure PropChanged(const PropertyName: WideString); overload;
    procedure PropChanged(DispID: TDispID); overload;
    function PropRequestEdit(const PropertyName: WideString): Boolean; overload;
    function PropRequestEdit(DispID: TDispID): Boolean; overload;
    property ClientSite: IOleClientSite;
    property InPlaceSite: IOleInPlaceSite;
    property Control: TWinControl;
  end;
  {$EXTERNALSYM TActiveXControl}

  TActiveXControlClass = class of TActiveXControl;
  {$EXTERNALSYM TActiveXControlClass}

  TActiveXControlFactory = class(TAutoObjectFactory)
  protected
    function GetLicenseFileName: string; virtual;
    function HasMachineLicense: Boolean; override;
  public
    constructor Create(ComServer: TComServerObject;
      ActiveXControlClass: TActiveXControlClass;
      WinControlClass: TWinControlClass; const ClassID: TGUID;
      ToolboxBitmapID: Integer; const LicStr: string; MiscStatus: Integer;
      ThreadingModel: TThreadingModel = tmSingle);
    destructor Destroy; override;
    procedure AddVerb(Verb: Integer; const VerbName: string);
    procedure UpdateRegistry(Register: Boolean); override;
    property MiscStatus: Integer;
    property ToolboxBitmapID: Integer;
    property WinControlClass: TWinControlClass;
  end;
  {$EXTERNALSYM TActiveXControlFactory}

  { ActiveFormControl }

  TActiveFormControl = class(TActiveXControl, IVCLComObject)
  protected
    procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
    procedure EventSinkChanged(const EventSink: IUnknown); override;
  public
    procedure FreeOnRelease;
    procedure InitializeControl; override;
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
      override;
    function ObjQueryInterface(const IID: TGUID; out Obj): HResult; override;
  end;
  {$EXTERNALSYM TActiveFormControl}

  { ActiveForm }

  TActiveForm = class(TCustomActiveForm)
  protected
    procedure DoDestroy; override;
    procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); virtual;
    procedure EventSinkChanged(const EventSink: IUnknown); virtual;
    procedure Initialize; virtual;
  public
    property ActiveFormControl: TActiveFormControl;
  end;
  {$EXTERNALSYM TActiveForm}

  TActiveFormClass = class of TActiveForm;
  {$EXTERNALSYM TActiveFormClass}

  { ActiveFormFactory }

  TActiveFormFactory = class(TActiveXControlFactory)
  public
    function GetIntfEntry(Guid: TGUID): PInterfaceEntry; override;
  end;
  {$EXTERNALSYM TActiveFormFactory}

  { Property Page support }

  TPropertyPageImpl = class;

  TPropertyPage = class(TCustomForm)
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Modified;
    procedure UpdateObject; virtual;
    procedure UpdatePropertyPage; virtual;
    property OleObject: OleVariant;
    property OleObjects: TInterfaceList;
    procedure EnumCtlProps(PropType: TGUID; PropNames: TStrings);
  published
    property ActiveControl;
    property AutoScroll;
    property Caption;
    property ClientHeight;
    property ClientWidth;
    property Ctl3D;
    property Color;
    property Enabled;
    property Font;
    property Height;
    property HorzScrollBar;
    property OldCreateOrder;
    property KeyPreview;
    property PixelsPerInch;
    property ParentFont;
    property PopupMenu;
    property PrintScale;
    property Scaled;
    property ShowHint;
    property VertScrollBar;
    property Visible;
    property Width;
    property OnActivate;
    property OnClick;
    property OnClose;
    property OnContextPopup;
    property OnCreate;
    property OnDblClick;
    property OnDestroy;
    property OnDeactivate;
    property OnDragDrop;
    property OnDragOver;
    property OnHide;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnPaint;
    property OnResize;
    property OnShow;
  end;

  TPropertyPageClass = class of TPropertyPage;

  TPropertyPageImpl = class(TAggregatedObject, IUnknown, IPropertyPage, IPropertyPage2)
  protected
    { IPropertyPage }
    function SetPageSite(const pageSite: IPropertyPageSite): HResult; stdcall;
    function Activate(hwndParent: HWnd; const rc: TRect; bModal: BOOL): HResult;
      stdcall;
    function Deactivate: HResult; stdcall;
    function GetPageInfo(out pageInfo: TPropPageInfo): HResult; stdcall;
    function SetObjects(cObjects: Longint; pUnkList: PUnknownList): HResult; stdcall;
    function Show(nCmdShow: Integer): HResult; stdcall;
    function Move(const rect: TRect): HResult; stdcall;
    function IsPageDirty: HResult; stdcall;
    function Apply: HResult; stdcall;
    function Help(pszHelpDir: POleStr): HResult; stdcall;
    function TranslateAccelerator(msg: PMsg): HResult; stdcall;
    { IPropertyPage2 }
    function EditProperty(dispid: TDispID): HResult; stdcall;
  public
    procedure InitPropertyPage; virtual;
    property PropertyPage: TPropertyPage;
  end;

  TActiveXPropertyPage = class(TComObject, IPropertyPage, IPropertyPage2)
  public
    destructor Destroy; override;
    procedure Initialize; override;
    property PropertyPageImpl: TPropertyPageImpl;
  end;
  {$EXTERNALSYM TActiveXPropertyPage}

  TActiveXPropertyPageFactory = class(TComObjectFactory)
  public
    constructor Create(ComServer: TComServerObject;
      PropertyPageClass: TPropertyPageClass; const ClassID: TGUID);
    function CreateComObject(const Controller: IUnknown): TComObject; override;
  end;
  {$EXTERNALSYM TActiveXPropertyPageFactory}

  { Type adapter support }

  TCustomAdapter = class(TInterfacedObject)
  protected
    Updating: Boolean;
    procedure Changed; virtual;
    procedure ConnectOleObject(OleObject: IUnknown);
    procedure ReleaseOleObject;
    procedure Update; virtual; abstract;
  public
    constructor Create;
    destructor Destroy; override;
  end;

  TAdapterNotifier = class(TInterfacedObject,
    IPropertyNotifySink)
  protected
    { IPropertyNotifySink }
    function OnChanged(dispid: TDispID): HResult; stdcall;
    function OnRequestEdit(dispid: TDispID): HResult; stdcall;
  public
    constructor Create(Adapter: TCustomAdapter);
  end;

  IFontAccess = interface
    ['{CBA55CA0-0E57-11D0-BD2F-0020AF0E5B81}']
    procedure GetOleFont(var OleFont: IFontDisp);
    procedure SetOleFont(const OleFont: IFontDisp);
  end;

  TFontAdapter = class(TCustomAdapter,
    IChangeNotifier,
    IFontAccess)
  protected
    { IFontAccess }
    procedure GetOleFont(var OleFont: IFontDisp);
    procedure SetOleFont(const OleFont: IFontDisp);
    procedure Changed; override;
    procedure Update; override;
  public
    constructor Create(Font: TFont);
  end;

  IPictureAccess = interface
    ['{795D4D31-43D7-11D0-9E92-0020AF3D82DA}']
    procedure GetOlePicture(var OlePicture: IPictureDisp);
    procedure SetOlePicture(const OlePicture: IPictureDisp);
  end;

  TPictureAdapter = class(TCustomAdapter,
    IChangeNotifier,
    IPictureAccess)
  protected
    { IPictureAccess }
    procedure GetOlePicture(var OlePicture: IPictureDisp);
    procedure SetOlePicture(const OlePicture: IPictureDisp);
    procedure Update; override;
  public
    constructor Create(Picture: TPicture);
  end;

  TOleGraphic = class(TGraphic)
  protected
    procedure Changed(Sender: TObject); override;
    procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
    function GetEmpty: Boolean; override;
    function GetHeight: Integer; override;
    function GetPalette: HPALETTE; override;
    function GetTransparent: Boolean; override;
    function GetWidth: Integer; override;
    procedure SetHeight(Value: Integer); override;
    procedure SetPalette(Value: HPALETTE); override;
    procedure SetWidth(Value: Integer); override;
  public
    procedure Assign(Source: TPersistent); override;
    procedure LoadFromFile(const Filename: string); override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
      APalette: HPALETTE); override;
    procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
      var APalette: HPALETTE); override;
    property MMHeight: Integer;      // in .01 mm units
    property MMWidth: Integer;
    property Picture: IPicture;
  end;

  TStringsAdapter = class(TAutoIntfObject, IStrings, IStringsAdapter)
  protected
    { IStringsAdapter }
    procedure ReferenceStrings(S: TStrings);
    procedure ReleaseStrings;
    { IStrings }
    function Get_ControlDefault(Index: Integer): OleVariant; safecall;
    procedure Set_ControlDefault(Index: Integer; Value: OleVariant); safecall;
    function Count: Integer; safecall;
    function Get_Item(Index: Integer): OleVariant; safecall;
    procedure Set_Item(Index: Integer; Value: OleVariant); safecall;
    procedure Remove(Index: Integer); safecall;
    procedure Clear; safecall;
    function Add(Item: OleVariant): Integer; safecall;
    function _NewEnum: IUnknown; safecall;
  public
    constructor Create(Strings: TStrings);
  end;

  TReflectorWindow = class(TWinControl)
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  public
    constructor Create(ParentWindow: HWND; Control: TControl); reintroduce;
  end;

procedure EnumDispatchProperties(Dispatch: IDispatch; PropType: TGUID;
  VTCode: Integer; PropList: TStrings);

procedure GetOleFont(Font: TFont; var OleFont: IFontDisp);
procedure SetOleFont(Font: TFont; OleFont: IFontDisp);
procedure GetOlePicture(Picture: TPicture; var OlePicture: IPictureDisp);
procedure SetOlePicture(Picture: TPicture; OlePicture: IPictureDisp);
procedure GetOleStrings(Strings: TStrings; var OleStrings: IStrings);
procedure SetOleStrings(Strings: TStrings; OleStrings: IStrings);

function ParkingWindow: HWND;

implementation
