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