home *** CD-ROM | disk | FTP | other *** search
/ Australian Personal Computer 2000 October / tst.iso / programs / borland / RUNIMAGE / DELPHI40 / DOC / AXCTRLS.INT < prev    next >
Encoding:
Text File  |  1998-06-17  |  25.0 KB  |  614 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Borland Delphi Visual Component Library         }
  5. {       ActiveX Controls Unit                           }
  6. {                                                       }
  7. {       Copyright (c) 1995,98 Inprise Corporation       }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit AxCtrls;
  12.  
  13. interface
  14.  
  15. (*$HPPEMIT '' *)
  16. (*$HPPEMIT '#include <objsafe.h>' *)
  17. (*$HPPEMIT '#include <ocidl.h>' *)
  18. (*$HPPEMIT '' *)
  19.  
  20. uses
  21.   Windows, Messages, ActiveX, SysUtils, ComObj, Classes, Graphics,
  22.   Controls, Forms, ExtCtrls, StdVcl;
  23.  
  24. const
  25.   { Delphi property page CLSIDs }
  26.   Class_DColorPropPage: TGUID = '{5CFF5D59-5946-11D0-BDEF-00A024D1875C}';
  27.   Class_DFontPropPage: TGUID = '{5CFF5D5B-5946-11D0-BDEF-00A024D1875C}';
  28.   Class_DPicturePropPage: TGUID = '{5CFF5D5A-5946-11D0-BDEF-00A024D1875C}';
  29.   Class_DStringPropPage: TGUID = '{F42D677E-754B-11D0-BDFB-00A024D1875C}';
  30.  
  31. type
  32.   TOleStream = class(TStream)
  33.   protected
  34.     function GetIStream: IStream;
  35.   public
  36.     constructor Create(const Stream: IStream);
  37.     function Read(var Buffer; Count: Longint): Longint; override;
  38.     function Write(const Buffer; Count: Longint): Longint; override;
  39.     function Seek(Offset: Longint; Origin: Word): Longint; override;
  40.   end;
  41.  
  42.   TConnectionPoints = class;
  43.  
  44.   TConnectionKind = (ckSingle, ckMulti);
  45.  
  46.   TConnectionPoint = class(TContainedObject, IConnectionPoint)
  47.   protected
  48.     { IConnectionPoint }
  49.     function GetConnectionInterface(out iid: TIID): HResult; stdcall;
  50.     function GetConnectionPointContainer(
  51.       out cpc: IConnectionPointContainer): HResult; stdcall;
  52.     function Advise(const unkSink: IUnknown; out dwCookie: Longint): HResult; stdcall;
  53.     function Unadvise(dwCookie: Longint): HResult; stdcall;
  54.     function EnumConnections(out enumconn: IEnumConnections): HResult; stdcall;
  55.   public
  56.     constructor Create(Container: TConnectionPoints;
  57.       const IID: TGUID; Kind: TConnectionKind; OnConnect: TConnectEvent);
  58.     destructor Destroy; override;
  59.   end;
  60.  
  61.   TConnectionPoints = class{IConnectionPointContainer}
  62.   protected
  63.     { IConnectionPointContainer }
  64.     function EnumConnectionPoints(
  65.       out enumconn: IEnumConnectionPoints): HResult; stdcall;
  66.     function FindConnectionPoint(const iid: TIID;
  67.       out cp: IConnectionPoint): HResult; stdcall;
  68.   public
  69.     constructor Create(const AController: IUnknown);
  70.     destructor Destroy; override;
  71.     function CreateConnectionPoint(const IID: TGUID; Kind: TConnectionKind;
  72.       OnConnect: TConnectEvent): TConnectionPoint;
  73.     property Controller: IUnknown;
  74.   end;
  75.  
  76.   TDefinePropertyPage = procedure(const GUID: TGUID) of object;
  77.  
  78.   TActiveXControlFactory = class;
  79.  
  80.   IAmbientDispatch = dispinterface
  81.     ['{00020400-0000-0000-C000-000000000046}']
  82.     property BackColor: Integer dispid DISPID_AMBIENT_BACKCOLOR;
  83.     property DisplayName: WideString dispid DISPID_AMBIENT_DISPLAYNAME;
  84.     property Font: IFontDisp dispid DISPID_AMBIENT_FONT;
  85.     property ForeColor: Integer dispid DISPID_AMBIENT_FORECOLOR;
  86.     property LocaleID: Integer dispid DISPID_AMBIENT_LOCALEID;
  87.     property MessageReflect: WordBool dispid DISPID_AMBIENT_MESSAGEREFLECT;
  88.     property ScaleUnits: WideString dispid DISPID_AMBIENT_SCALEUNITS;
  89.     property TextAlign: Smallint dispid DISPID_AMBIENT_TEXTALIGN;
  90.     property UserMode: WordBool dispid DISPID_AMBIENT_USERMODE;
  91.     property UIDead: WordBool dispid DISPID_AMBIENT_UIDEAD;
  92.     property ShowGrabHandles: WordBool dispid DISPID_AMBIENT_SHOWGRABHANDLES;
  93.     property ShowHatching: WordBool dispid DISPID_AMBIENT_SHOWHATCHING;
  94.     property DisplayAsDefault: WordBool dispid DISPID_AMBIENT_DISPLAYASDEFAULT;
  95.     property SupportsMnemonics: WordBool dispid DISPID_AMBIENT_SUPPORTSMNEMONICS;
  96.     property AutoClip: WordBool dispid DISPID_AMBIENT_AUTOCLIP;
  97.   end;
  98.  
  99.   TActiveXControl = class(TAutoObject,
  100.     IConnectionPointContainer,
  101.     IDataObject,
  102.     IObjectSafety,
  103.     IOleControl,
  104.     IOleInPlaceActiveObject,
  105.     IOleInPlaceObject,
  106.     IOleObject,
  107.     IPerPropertyBrowsing,
  108.     IPersistPropertyBag,
  109.     IPersistStorage,
  110.     IPersistStreamInit,
  111.     IQuickActivate,
  112.     ISimpleFrameSite,
  113.     ISpecifyPropertyPages,
  114.     IViewObject,
  115.     IViewObject2)
  116.  
  117.   protected
  118.     { Renamed methods }
  119.     function IPersistPropertyBag.InitNew = PersistPropBagInitNew;
  120.     function IPersistPropertyBag.Load = PersistPropBagLoad;
  121.     function IPersistPropertyBag.Save = PersistPropBagSave;
  122.     function IPersistStreamInit.Load = PersistStreamLoad;
  123.     function IPersistStreamInit.Save = PersistStreamSave;
  124.     function IPersistStorage.InitNew = PersistStorageInitNew;
  125.     function IPersistStorage.Load = PersistStorageLoad;
  126.     function IPersistStorage.Save = PersistStorageSave;
  127.     function IViewObject2.GetExtent = ViewObjectGetExtent;
  128.     { IPersist }
  129.     function GetClassID(out classID: TCLSID): HResult; stdcall;
  130.     { IPersistPropertyBag }
  131.     function PersistPropBagInitNew: HResult; stdcall;
  132.     function PersistPropBagLoad(const pPropBag: IPropertyBag;
  133.       const pErrorLog: IErrorLog): HResult; stdcall;
  134.     function PersistPropBagSave(const pPropBag: IPropertyBag; fClearDirty: BOOL;
  135.       fSaveAllProperties: BOOL): HResult; stdcall;
  136.     { IPersistStreamInit }
  137.     function IsDirty: HResult; stdcall;
  138.     function PersistStreamLoad(const stm: IStream): HResult; stdcall;
  139.     function PersistStreamSave(const stm: IStream;
  140.       fClearDirty: BOOL): HResult; stdcall;
  141.     function GetSizeMax(out cbSize: Largeint): HResult; stdcall;
  142.     function InitNew: HResult; stdcall;
  143.     { IPersistStorage }
  144.     function PersistStorageInitNew(const stg: IStorage): HResult; stdcall;
  145.     function PersistStorageLoad(const stg: IStorage): HResult; stdcall;
  146.     function PersistStorageSave(const stgSave: IStorage;
  147.       fSameAsLoad: BOOL): HResult; stdcall;
  148.     function SaveCompleted(const stgNew: IStorage): HResult; stdcall;
  149.     function HandsOffStorage: HResult; stdcall;
  150.     { IObjectSafety }
  151.     function GetInterfaceSafetyOptions(const IID: TIID; pdwSupportedOptions,
  152.       pdwEnabledOptions: PDWORD): HResult; virtual; stdcall;
  153.     function SetInterfaceSafetyOptions(const IID: TIID; dwOptionSetMask,
  154.       dwEnabledOptions: DWORD): HResult; virtual; stdcall;
  155.     { IOleObject }
  156.     function SetClientSite(const clientSite: IOleClientSite): HResult;
  157.       stdcall;
  158.     function GetClientSite(out clientSite: IOleClientSite): HResult;
  159.       stdcall;
  160.     function SetHostNames(szContainerApp: POleStr;
  161.       szContainerObj: POleStr): HResult; stdcall;
  162.     function Close(dwSaveOption: Longint): HResult; stdcall;
  163.     function SetMoniker(dwWhichMoniker: Longint; const mk: IMoniker): HResult;
  164.       stdcall;
  165.     function GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint;
  166.       out mk: IMoniker): HResult; stdcall;
  167.     function InitFromData(const dataObject: IDataObject; fCreation: BOOL;
  168.       dwReserved: Longint): HResult; stdcall;
  169.     function GetClipboardData(dwReserved: Longint;
  170.       out dataObject: IDataObject): HResult; stdcall;
  171.     function DoVerb(iVerb: Longint; msg: PMsg; const activeSite: IOleClientSite;
  172.       lindex: Longint; hwndParent: HWND; const posRect: TRect): HResult;
  173.       stdcall;
  174.     function EnumVerbs(out enumOleVerb: IEnumOleVerb): HResult; stdcall;
  175.     function Update: HResult; stdcall;
  176.     function IsUpToDate: HResult; stdcall;
  177.     function GetUserClassID(out clsid: TCLSID): HResult; stdcall;
  178.     function GetUserType(dwFormOfType: Longint; out pszUserType: POleStr): HResult;
  179.       stdcall;
  180.     function SetExtent(dwDrawAspect: Longint; const size: TPoint): HResult;
  181.       stdcall;
  182.     function GetExtent(dwDrawAspect: Longint; out size: TPoint): HResult;
  183.       stdcall;
  184.     function Advise(const advSink: IAdviseSink; out dwConnection: Longint): HResult;
  185.       stdcall;
  186.     function Unadvise(dwConnection: Longint): HResult; stdcall;
  187.     function EnumAdvise(out enumAdvise: IEnumStatData): HResult; stdcall;
  188.     function GetMiscStatus(dwAspect: Longint; out dwStatus: Longint): HResult;
  189.       stdcall;
  190.     function SetColorScheme(const logpal: TLogPalette): HResult; stdcall;
  191.     { IOleControl }
  192.     function GetControlInfo(var ci: TControlInfo): HResult; stdcall;
  193.     function OnMnemonic(msg: PMsg): HResult; stdcall;
  194.     function OnAmbientPropertyChange(dispid: TDispID): HResult; stdcall;
  195.     function FreezeEvents(bFreeze: BOOL): HResult; stdcall;
  196.     { IOleWindow }
  197.     function GetWindow(out wnd: HWnd): HResult; stdcall;
  198.     function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;
  199.     { IOleInPlaceObject }
  200.     function InPlaceDeactivate: HResult; stdcall;
  201.     function UIDeactivate: HResult; stdcall;
  202.     function SetObjectRects(const rcPosRect: TRect;
  203.       const rcClipRect: TRect): HResult; stdcall;
  204.     function ReactivateAndUndo: HResult; stdcall;
  205.     { IOleInPlaceActiveObject }
  206.     function TranslateAccelerator(var msg: TMsg): HResult; stdcall;
  207.     function OnFrameWindowActivate(fActivate: BOOL): HResult; stdcall;
  208.     function OnDocWindowActivate(fActivate: BOOL): HResult; stdcall;
  209.     function ResizeBorder(const rcBorder: TRect; const uiWindow: IOleInPlaceUIWindow;
  210.       fFrameWindow: BOOL): HResult; stdcall;
  211.     function EnableModeless(fEnable: BOOL): HResult; stdcall;
  212.     { IViewObject }
  213.     function Draw(dwDrawAspect: Longint; lindex: Longint; pvAspect: Pointer;
  214.       ptd: PDVTargetDevice; hicTargetDev: HDC; hdcDraw: HDC;
  215.       prcBounds: PRect; prcWBounds: PRect; fnContinue: TContinueFunc;
  216.       dwContinue: Longint): HResult; stdcall;
  217.     function GetColorSet(dwDrawAspect: Longint; lindex: Longint;
  218.       pvAspect: Pointer; ptd: PDVTargetDevice; hicTargetDev: HDC;
  219.       out colorSet: PLogPalette): HResult; stdcall;
  220.     function Freeze(dwDrawAspect: Longint; lindex: Longint; pvAspect: Pointer;
  221.       out dwFreeze: Longint): HResult; stdcall;
  222.     function Unfreeze(dwFreeze: Longint): HResult; stdcall;
  223.     function SetAdvise(aspects: Longint; advf: Longint;
  224.       const advSink: IAdviseSink): HResult; stdcall;
  225.     function GetAdvise(pAspects: PLongint; pAdvf: PLONGINT;
  226.       out advSink: IAdviseSink): HResult; stdcall;
  227.     { IViewObject2 }
  228.     function ViewObjectGetExtent(dwDrawAspect: Longint; lindex: Longint;
  229.       ptd: PDVTargetDevice; out size: TPoint): HResult; stdcall;
  230.     { IPerPropertyBrowsing }
  231.     function GetDisplayString(dispid: TDispID; out bstr: WideString): HResult; stdcall;
  232.     function MapPropertyToPage(dispid: TDispID; out clsid: TCLSID): HResult; stdcall;
  233.     function GetPredefinedStrings(dispid: TDispID; out caStringsOut: TCAPOleStr;
  234.       out caCookiesOut: TCALongint): HResult; stdcall;
  235.     function GetPredefinedValue(dispid: TDispID; dwCookie: Longint;
  236.       out varOut: OleVariant): HResult; stdcall;
  237.     { ISpecifyPropertyPages }
  238.     function GetPages(out pages: TCAGUID): HResult; stdcall;
  239.     { ISimpleFrameSite }
  240.     function PreMessageFilter(wnd: HWnd; msg, wp, lp: Integer;
  241.       out res: Integer; out Cookie: Longint): HResult; stdcall;
  242.     function PostMessageFilter(wnd: HWnd; msg, wp, lp: Integer;
  243.       out res: Integer; Cookie: Longint): HResult; stdcall;
  244.     { IQuickActivate }
  245.     function QuickActivate(var qaCont: tagQACONTAINER; var qaCtrl: tagQACONTROL): HResult; stdcall;
  246.     function SetContentExtent(const sizel: TPoint): HResult; stdcall;
  247.     function GetContentExtent(out sizel: TPoint): HResult; stdcall;
  248.     { IDataObject }
  249.     function GetData(const formatetcIn: TFormatEtc; out medium: TStgMedium):
  250.       HResult; stdcall;
  251.     function GetDataHere(const formatetc: TFormatEtc; out medium: TStgMedium):
  252.       HResult; stdcall;
  253.     function QueryGetData(const formatetc: TFormatEtc): HResult;
  254.       stdcall;
  255.     function GetCanonicalFormatEtc(const formatetc: TFormatEtc;
  256.       out formatetcOut: TFormatEtc): HResult; stdcall;
  257.     function SetData(const formatetc: TFormatEtc; var medium: TStgMedium;
  258.       fRelease: BOOL): HResult; stdcall;
  259.     function EnumFormatEtc(dwDirection: Longint; out enumFormatEtc:
  260.       IEnumFormatEtc): HResult; stdcall;
  261.     function DAdvise(const formatetc: TFormatEtc; advf: Longint;
  262.       const advSink: IAdviseSink; out dwConnection: Longint): HResult; stdcall;
  263.     function DUnadvise(dwConnection: Longint): HResult; stdcall;
  264.     function EnumDAdvise(out enumAdvise: IEnumStatData): HResult;
  265.       stdcall;
  266.     { Standard properties }
  267.     function Get_BackColor: Integer; safecall;
  268.     function Get_Caption: WideString; safecall;
  269.     function Get_Enabled: WordBool; safecall;
  270.     function Get_Font: Font; safecall;
  271.     function Get_ForeColor: Integer; safecall;
  272.     function Get_HWnd: Integer; safecall;
  273.     function Get_TabStop: WordBool; safecall;
  274.     function Get_Text: WideString; safecall;
  275.     procedure Set_BackColor(Value: Integer); safecall;
  276.     procedure Set_Caption(const Value: WideString); safecall;
  277.     procedure Set_Enabled(Value: WordBool); safecall;
  278.     procedure Set_Font(const Value: Font); safecall;
  279.     procedure Set_ForeColor(Value: Integer); safecall;
  280.     procedure Set_TabStop(Value: WordBool); safecall;
  281.     procedure Set_Text(const Value: WideString); safecall;
  282.     { Standard event handlers }
  283.     procedure StdClickEvent(Sender: TObject);
  284.     procedure StdDblClickEvent(Sender: TObject);
  285.     procedure StdKeyDownEvent(Sender: TObject; var Key: Word;
  286.       Shift: TShiftState);
  287.     procedure StdKeyPressEvent(Sender: TObject; var Key: Char);
  288.     procedure StdKeyUpEvent(Sender: TObject; var Key: Word;
  289.       Shift: TShiftState);
  290.     procedure StdMouseDownEvent(Sender: TObject; Button: TMouseButton;
  291.       Shift: TShiftState; X, Y: Integer);
  292.     procedure StdMouseMoveEvent(Sender: TObject; Shift: TShiftState;
  293.       X, Y: Integer);
  294.     procedure StdMouseUpEvent(Sender: TObject; Button: TMouseButton;
  295.       Shift: TShiftState; X, Y: Integer);
  296.     { Helper methods }
  297.     function InPlaceActivate(ActivateUI: Boolean): HResult;
  298.     procedure ShowPropertyDialog;
  299.     { Overrideable methods }
  300.     procedure DefinePropertyPages(
  301.       DefinePropertyPage: TDefinePropertyPage); virtual;
  302.     function GetPropertyString(DispID: Integer;
  303.       var S: string): Boolean; virtual;
  304.     function GetPropertyStrings(DispID: Integer;
  305.       Strings: TStrings): Boolean; virtual;
  306.     procedure GetPropertyValue(DispID, Cookie: Integer;
  307.       var Value: OleVariant); virtual;
  308.     procedure GetPropFromBag(const PropName: WideString; DispatchID: Integer;
  309.       PropBag: IPropertyBag; ErrorLog: IErrorLog); virtual;
  310.     procedure InitializeControl; virtual;
  311.     procedure LoadFromStream(const Stream: IStream); virtual;
  312.     procedure PerformVerb(Verb: Integer); virtual;
  313.     procedure PutPropInBag(const PropName: WideString; DispatchID: Integer;
  314.       PropBag: IPropertyBag); virtual;
  315.     procedure SaveToStream(const Stream: IStream); virtual;
  316.     procedure WndProc(var Message: TMessage); virtual;
  317.     property ConnectionPoints: TConnectionPoints;
  318.   public
  319.     destructor Destroy; override;
  320.     procedure Initialize; override;
  321.     function ObjQueryInterface(const IID: TGUID; out Obj): HResult; override;
  322.     procedure PropChanged(const PropertyName: WideString); overload;
  323.     procedure PropChanged(DispID: TDispID); overload;
  324.     function PropRequestEdit(const PropertyName: WideString): Boolean; overload;
  325.     function PropRequestEdit(DispID: TDispID): Boolean; overload;
  326.     property ClientSite: IOleClientSite;
  327.     property Control: TWinControl;
  328.   end;
  329.  
  330.   TActiveXControlClass = class of TActiveXControl;
  331.  
  332.   TActiveXControlFactory = class(TAutoObjectFactory)
  333.   protected
  334.     function GetLicenseFileName: string; virtual;
  335.     function HasMachineLicense: Boolean; override;
  336.   public
  337.     constructor Create(ComServer: TComServerObject;
  338.       ActiveXControlClass: TActiveXControlClass;
  339.       WinControlClass: TWinControlClass; const ClassID: TGUID;
  340.       ToolboxBitmapID: Integer; const LicStr: string; MiscStatus: Integer;
  341.       ThreadingModel: TThreadingModel = tmSingle);
  342.     destructor Destroy; override;
  343.     procedure AddVerb(Verb: Integer; const VerbName: string);
  344.     procedure UpdateRegistry(Register: Boolean); override;
  345.     property MiscStatus: Integer;
  346.     property ToolboxBitmapID: Integer;
  347.     property WinControlClass: TWinControlClass;
  348.   end;
  349.  
  350.   { ActiveFormControl }
  351.  
  352.   {$EXTERNALSYM TActiveFormControl}
  353.   TActiveFormControl = class(TActiveXControl, IVCLComObject)
  354.   protected
  355.     procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
  356.     procedure EventSinkChanged(const EventSink: IUnknown); override;
  357.   public
  358.     procedure FreeOnRelease;
  359.     procedure InitializeControl; override;
  360.     function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  361.       Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
  362.       override;
  363.     function ObjQueryInterface(const IID: TGUID; out Obj): HResult; override;
  364.   end;
  365.  
  366.   { ActiveForm }
  367.  
  368.   {$EXTERNALSYM TActiveForm}
  369.   TActiveForm = class(TCustomActiveForm)
  370.   protected
  371.     procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); virtual;
  372.     procedure EventSinkChanged(const EventSink: IUnknown); virtual;
  373.     procedure Initialize; virtual;
  374.   public
  375.     property ActiveFormControl: TActiveFormControl;
  376.   end;
  377.  
  378.   {$EXTERNALSYM TActiveFormClass}
  379.   TActiveFormClass = class of TActiveForm;
  380.  
  381.   { ActiveFormFactory }
  382.  
  383.   {$EXTERNALSYM TActiveFormFactory}
  384.   TActiveFormFactory = class(TActiveXControlFactory)
  385.   public
  386.     function GetIntfEntry(Guid: TGUID): PInterfaceEntry; override;
  387.   end;
  388.  
  389.   { Property Page support }
  390.  
  391.   TPropertyPageImpl = class;
  392.  
  393.   TPropertyPage = class(TCustomForm)
  394.   public
  395.     constructor Create(AOwner: TComponent); override;
  396.     destructor Destroy; override;
  397.     procedure Modified;
  398.     procedure UpdateObject; virtual;
  399.     procedure UpdatePropertyPage; virtual;
  400.     property OleObject: OleVariant;
  401.     property OleObjects: TInterfaceList;
  402.     procedure EnumCtlProps(PropType: TGUID; PropNames: TStrings);
  403.   published
  404.     property ActiveControl;
  405.     property AutoScroll;
  406.     property Caption;
  407.     property ClientHeight;
  408.     property ClientWidth;
  409.     property Ctl3D;
  410.     property Color;
  411.     property Enabled;
  412.     property Font;
  413.     property Height;
  414.     property HorzScrollBar;
  415.     property OldCreateOrder;
  416.     property KeyPreview;
  417.     property PixelsPerInch;
  418.     property ParentFont;
  419.     property PopupMenu;
  420.     property PrintScale;
  421.     property Scaled;
  422.     property ShowHint;
  423.     property VertScrollBar;
  424.     property Visible;
  425.     property Width;
  426.     property OnActivate;
  427.     property OnClick;
  428.     property OnClose;
  429.     property OnCreate;
  430.     property OnDblClick;
  431.     property OnDestroy;
  432.     property OnDeactivate;
  433.     property OnDragDrop;
  434.     property OnDragOver;
  435.     property OnHide;
  436.     property OnKeyDown;
  437.     property OnKeyPress;
  438.     property OnKeyUp;
  439.     property OnMouseDown;
  440.     property OnMouseMove;
  441.     property OnMouseUp;
  442.     property OnPaint;
  443.     property OnResize;
  444.     property OnShow;
  445.   end;
  446.  
  447.   TPropertyPageClass = class of TPropertyPage;
  448.  
  449.   TPropertyPageImpl = class(TAggregatedObject, IUnknown, IPropertyPage, IPropertyPage2)
  450.   protected
  451.     { IPropertyPage }
  452.     function SetPageSite(const pageSite: IPropertyPageSite): HResult; stdcall;
  453.     function Activate(hwndParent: HWnd; const rc: TRect; bModal: BOOL): HResult;
  454.       stdcall;
  455.     function Deactivate: HResult; stdcall;
  456.     function GetPageInfo(out pageInfo: TPropPageInfo): HResult; stdcall;
  457.     function SetObjects(cObjects: Longint; pUnkList: PUnknownList): HResult; stdcall;
  458.     function Show(nCmdShow: Integer): HResult; stdcall;
  459.     function Move(const rect: TRect): HResult; stdcall;
  460.     function IsPageDirty: HResult; stdcall;
  461.     function Apply: HResult; stdcall;
  462.     function Help(pszHelpDir: POleStr): HResult; stdcall;
  463.     function TranslateAccelerator(msg: PMsg): HResult; stdcall;
  464.     { IPropertyPage2 }
  465.     function EditProperty(dispid: TDispID): HResult; stdcall;
  466.   public
  467.     procedure InitPropertyPage; virtual;
  468.     property PropertyPage: TPropertyPage;
  469.   end;
  470.  
  471.   {$EXTERNALSYM TActiveXPropertyPage}
  472.   TActiveXPropertyPage = class(TComObject, IPropertyPage, IPropertyPage2)
  473.   public
  474.     destructor Destroy; override;
  475.     procedure Initialize; override;
  476.     property PropertyPageImpl: TPropertyPageImpl;
  477.   end;
  478.  
  479.   {$EXTERNALSYM TActiveXPropertyPageFactory}
  480.   TActiveXPropertyPageFactory = class(TComObjectFactory)
  481.   public
  482.     constructor Create(ComServer: TComServerObject;
  483.       PropertyPageClass: TPropertyPageClass; const ClassID: TGUID);
  484.     function CreateComObject(const Controller: IUnknown): TComObject; override;
  485.   end;
  486.  
  487.   { Type adapter support }
  488.  
  489.   TCustomAdapter = class(TInterfacedObject)
  490.   protected
  491.     Updating: Boolean;
  492.     procedure Changed; virtual;
  493.     procedure ConnectOleObject(OleObject: IUnknown);
  494.     procedure ReleaseOleObject;
  495.     procedure Update; virtual; abstract;
  496.   public
  497.     constructor Create;
  498.     destructor Destroy; override;
  499.   end;
  500.  
  501.   TAdapterNotifier = class(TInterfacedObject,
  502.     IPropertyNotifySink)
  503.   protected
  504.     { IPropertyNotifySink }
  505.     function OnChanged(dispid: TDispID): HResult; stdcall;
  506.     function OnRequestEdit(dispid: TDispID): HResult; stdcall;
  507.   public
  508.     constructor Create(Adapter: TCustomAdapter);
  509.   end;
  510.  
  511.   IFontAccess = interface
  512.     ['{CBA55CA0-0E57-11D0-BD2F-0020AF0E5B81}']
  513.     procedure GetOleFont(var OleFont: IFontDisp);
  514.     procedure SetOleFont(const OleFont: IFontDisp);
  515.   end;
  516.  
  517.   TFontAdapter = class(TCustomAdapter,
  518.     IChangeNotifier,
  519.     IFontAccess)
  520.   protected
  521.     { IFontAccess }
  522.     procedure GetOleFont(var OleFont: IFontDisp);
  523.     procedure SetOleFont(const OleFont: IFontDisp);
  524.     procedure Changed; override;
  525.     procedure Update; override;
  526.   public
  527.     constructor Create(Font: TFont);
  528.   end;
  529.  
  530.   IPictureAccess = interface
  531.     ['{795D4D31-43D7-11D0-9E92-0020AF3D82DA}']
  532.     procedure GetOlePicture(var OlePicture: IPictureDisp);
  533.     procedure SetOlePicture(const OlePicture: IPictureDisp);
  534.   end;
  535.  
  536.   TPictureAdapter = class(TCustomAdapter,
  537.     IChangeNotifier,
  538.     IPictureAccess)
  539.   protected
  540.     { IPictureAccess }
  541.     procedure GetOlePicture(var OlePicture: IPictureDisp);
  542.     procedure SetOlePicture(const OlePicture: IPictureDisp);
  543.     procedure Update; override;
  544.   public
  545.     constructor Create(Picture: TPicture);
  546.   end;
  547.  
  548.   TOleGraphic = class(TGraphic)
  549.   protected
  550.     procedure Changed(Sender: TObject); override;
  551.     procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
  552.     function GetEmpty: Boolean; override;
  553.     function GetHeight: Integer; override;
  554.     function GetPalette: HPALETTE; override;
  555.     function GetTransparent: Boolean; override;
  556.     function GetWidth: Integer; override;
  557.     procedure SetHeight(Value: Integer); override;
  558.     procedure SetPalette(Value: HPALETTE); override;
  559.     procedure SetWidth(Value: Integer); override;
  560.   public
  561.     procedure Assign(Source: TPersistent); override;
  562.     procedure LoadFromFile(const Filename: string); override;
  563.     procedure LoadFromStream(Stream: TStream); override;
  564.     procedure SaveToStream(Stream: TStream); override;
  565.     procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
  566.       APalette: HPALETTE); override;
  567.     procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
  568.       var APalette: HPALETTE); override;
  569.     property MMHeight: Integer;      // in .01 mm units
  570.     property MMWidth: Integer;
  571.     property Picture: IPicture;
  572.   end;
  573.  
  574.   TStringsAdapter = class(TAutoIntfObject, IStrings, IStringsAdapter)
  575.   protected
  576.     { IStringsAdapter }
  577.     procedure ReferenceStrings(S: TStrings);
  578.     procedure ReleaseStrings;
  579.     { IStrings }
  580.     function Get_ControlDefault(Index: Integer): OleVariant; safecall;
  581.     procedure Set_ControlDefault(Index: Integer; Value: OleVariant); safecall;
  582.     function Count: Integer; safecall;
  583.     function Get_Item(Index: Integer): OleVariant; safecall;
  584.     procedure Set_Item(Index: Integer; Value: OleVariant); safecall;
  585.     procedure Remove(Index: Integer); safecall;
  586.     procedure Clear; safecall;
  587.     function Add(Item: OleVariant): Integer; safecall;
  588.     function _NewEnum: IUnknown; safecall;
  589.   public
  590.     constructor Create(Strings: TStrings);
  591.   end;
  592.   
  593.   TReflectorWindow = class(TWinControl)
  594.   public
  595.     constructor Create(ParentWindow: HWND; Control: TControl); reintroduce;
  596.   end;
  597.  
  598. function GetDispatchPropValue(Disp: IDispatch; DispID: Integer): OleVariant;
  599. procedure SetDispatchPropValue(Disp: IDispatch; DispID: Integer;
  600.   const Value: OleVariant);
  601. procedure EnumDispatchProperties(Dispatch: IDispatch; PropType: TGUID;
  602.   VTCode: Integer; PropList: TStrings);
  603.  
  604. procedure GetOleFont(Font: TFont; var OleFont: IFontDisp);
  605. procedure SetOleFont(Font: TFont; OleFont: IFontDisp);
  606. procedure GetOlePicture(Picture: TPicture; var OlePicture: IPictureDisp);
  607. procedure SetOlePicture(Picture: TPicture; OlePicture: IPictureDisp);
  608. procedure GetOleStrings(Strings: TStrings; var OleStrings: IStrings);
  609. procedure SetOleStrings(Strings: TStrings; OleStrings: IStrings);
  610.  
  611. function ParkingWindow: HWND;
  612.  
  613. implementation
  614.