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