home *** CD-ROM | disk | FTP | other *** search
-
- {*******************************************************}
- { }
- { Borland Delphi Visual Component Library }
- { }
- { Copyright (c) 1996,99 Inprise Corporation }
- { }
- {*******************************************************}
-
- unit OleCtrls;
-
- {$R-,T-,H+,X+}
-
- interface
-
- uses Windows, Messages, ActiveX, SysUtils, Classes, Controls, Forms,
- Menus, Graphics, ComObj, AxCtrls;
-
- type
-
- TOleControl = class;
-
- TEventDispatch = class(TObject, IUnknown, IDispatch)
- protected
- { IUnknown }
- function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
- function _AddRef: Integer; stdcall;
- function _Release: Integer; stdcall;
- { IDispatch }
- function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
- function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
- function GetIDsOfNames(const IID: TGUID; Names: Pointer;
- NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
- function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
- Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
- property Control: TOleControl;
- public
- constructor Create(Control: TOleControl);
- end;
-
- TOleEnum = ActiveX.TOleEnum;
- {$NODEFINE TOleEnum}
-
- TEnumValue = record
- Value: Longint;
- Ident: string;
- end;
-
- PEnumValueList = ^TEnumValueList;
- TEnumValueList = array[0..32767] of TEnumValue;
-
- TEnumPropDesc = class
- public
- constructor Create(DispID, ValueCount: Integer;
- const TypeInfo: ITypeInfo);
- destructor Destroy; override;
- procedure GetStrings(Proc: TGetStrProc);
- function StringToValue(const S: string): Integer;
- function ValueToString(V: Integer): string;
- end;
-
- PControlData = ^TControlData;
- TControlData = record
- ClassID: TGUID;
- EventIID: TGUID;
- EventCount: Longint;
- EventDispIDs: Pointer;
- LicenseKey: Pointer;
- Flags: DWORD;
- Version: Integer;
- FontCount: Integer;
- FontIDs: PDispIDList;
- PictureCount: Integer;
- PictureIDs: PDispIDList;
- Reserved: Integer;
- InstanceCount: Integer;
- EnumPropDescs: TList;
- end;
-
- PControlData2 = ^TControlData2;
- TControlData2 = record
- ClassID: TGUID;
- EventIID: TGUID;
- EventCount: Longint;
- EventDispIDs: Pointer;
- LicenseKey: Pointer;
- Flags: DWORD;
- Version: Integer;
- FontCount: Integer;
- FontIDs: PDispIDList;
- PictureCount: Integer;
- PictureIDs: PDispIDList;
- Reserved: Integer;
- InstanceCount: Integer;
- EnumPropDescs: TList;
- FirstEventOfs: Cardinal;
- end;
-
- TOleControl = class(TWinControl, IUnknown, IOleClientSite,
- IOleControlSite, IOleInPlaceSite, IOleInPlaceFrame, IDispatch,
- IPropertyNotifySink, ISimpleFrameSite)
- protected
- FEvents: Integer;
- { IUnknown }
- function QueryInterface(const IID: TGUID; out Obj): HResult; override;
- function _AddRef: Integer; stdcall;
- function _Release: Integer; stdcall;
- { IOleClientSite }
- function SaveObject: HResult; stdcall;
- function GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint;
- out mk: IMoniker): HResult; stdcall;
- function GetContainer(out container: IOleContainer): HResult; stdcall;
- function ShowObject: HResult; stdcall;
- function OnShowWindow(fShow: BOOL): HResult; stdcall;
- function RequestNewObjectLayout: HResult; stdcall;
- { IOleControlSite }
- function OnControlInfoChanged: HResult; stdcall;
- function LockInPlaceActive(fLock: BOOL): HResult; stdcall;
- function GetExtendedControl(out disp: IDispatch): HResult; stdcall;
- function TransformCoords(var ptlHimetric: TPoint; var ptfContainer: TPointF;
- flags: Longint): HResult; stdcall;
- function IOleControlSite.TranslateAccelerator = OleControlSite_TranslateAccelerator;
- function OleControlSite_TranslateAccelerator(msg: PMsg;
- grfModifiers: Longint): HResult; stdcall;
- function OnFocus(fGotFocus: BOOL): HResult; stdcall;
- function ShowPropertyFrame: HResult; stdcall;
- { IOleWindow }
- function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;
- { IOleInPlaceSite }
- function IOleInPlaceSite.GetWindow = OleInPlaceSite_GetWindow;
- function OleInPlaceSite_GetWindow(out wnd: HWnd): HResult; stdcall;
- function CanInPlaceActivate: HResult; stdcall;
- function OnInPlaceActivate: HResult; stdcall;
- function OnUIActivate: HResult; stdcall;
- function GetWindowContext(out frame: IOleInPlaceFrame;
- out doc: IOleInPlaceUIWindow; out rcPosRect: TRect;
- out rcClipRect: TRect; out frameInfo: TOleInPlaceFrameInfo): HResult;
- stdcall;
- function Scroll(scrollExtent: TPoint): HResult; stdcall;
- function OnUIDeactivate(fUndoable: BOOL): HResult; stdcall;
- function OnInPlaceDeactivate: HResult; stdcall;
- function DiscardUndoState: HResult; stdcall;
- function DeactivateAndUndo: HResult; stdcall;
- function OnPosRectChange(const rcPosRect: TRect): HResult; stdcall;
- { IOleInPlaceUIWindow }
- function GetBorder(out rectBorder: TRect): HResult; stdcall;
- function RequestBorderSpace(const borderwidths: TRect): HResult; stdcall;
- function SetBorderSpace(pborderwidths: PRect): HResult; stdcall;
- function SetActiveObject(const activeObject: IOleInPlaceActiveObject;
- pszObjName: POleStr): HResult; stdcall;
- { IOleInPlaceFrame }
- function IOleInPlaceFrame.GetWindow = OleInPlaceFrame_GetWindow;
- function OleInPlaceFrame_GetWindow(out wnd: HWnd): HResult; stdcall;
- function InsertMenus(hmenuShared: HMenu;
- var menuWidths: TOleMenuGroupWidths): HResult; stdcall;
- function SetMenu(hmenuShared: HMenu; holemenu: HMenu;
- hwndActiveObject: HWnd): HResult; stdcall;
- function RemoveMenus(hmenuShared: HMenu): HResult; stdcall;
- function SetStatusText(pszStatusText: POleStr): HResult; stdcall;
- function EnableModeless(fEnable: BOOL): HResult; stdcall;
- function IOleInPlaceFrame.TranslateAccelerator = OleInPlaceFrame_TranslateAccelerator;
- function OleInPlaceFrame_TranslateAccelerator(var msg: TMsg;
- wID: Word): HResult; stdcall;
- { IDispatch }
- function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
- function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
- function GetIDsOfNames(const IID: TGUID; Names: Pointer;
- NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
- function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
- Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): 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;
- { TOleControl }
- procedure CreateWnd; override;
- procedure DefineProperties(Filer: TFiler); override;
- procedure DestroyWindowHandle; override;
- function GetByteProp(Index: Integer): Byte;
- function GetColorProp(Index: Integer): TColor;
- function GetTColorProp(Index: Integer): TColor;
- function GetCompProp(Index: Integer): Comp;
- function GetCurrencyProp(Index: Integer): Currency;
- function GetDoubleProp(Index: Integer): Double;
- function GetIDispatchProp(Index: Integer): IDispatch;
- function GetIntegerProp(Index: Integer): Integer;
- function GetIUnknownProp(Index: Integer): IUnknown;
- function GetWordBoolProp(Index: Integer): WordBool;
- function GetTDateTimeProp(Index: Integer): TDateTime;
- function GetTFontProp(Index: Integer): TFont;
- function GetOleBoolProp(Index: Integer): TOleBool;
- function GetOleDateProp(Index: Integer): TOleDate;
- function GetOleEnumProp(Index: Integer): TOleEnum;
- function GetTOleEnumProp(Index: Integer): TOleEnum;
- function GetOleVariantProp(Index: Integer): OleVariant;
- function GetTPictureProp(Index: Integer): TPicture;
- procedure GetProperty(Index: Integer; var Value: TVarData);
- function GetShortIntProp(Index: Integer): ShortInt;
- function GetSingleProp(Index: Integer): Single;
- function GetSmallintProp(Index: Integer): Smallint;
- function GetStringProp(Index: Integer): string;
- function GetVariantProp(Index: Integer): Variant;
- function GetWideStringProp(Index: Integer): WideString;
- function GetWordProp(Index: Integer): Word;
- procedure InitControlData; virtual; abstract;
- procedure InitControlInterface(const Obj: IUnknown); virtual;
- procedure InvokeMethod(const DispInfo; Result: Pointer);
- function PaletteChanged(Foreground: Boolean): Boolean; override;
- procedure PictureChanged(Sender: TObject);
- procedure SetByteProp(Index: Integer; Value: Byte);
- procedure SetColorProp(Index: Integer; Value: TColor);
- procedure SetTColorProp(Index: Integer; Value: TColor);
- procedure SetCompProp(Index: Integer; const Value: Comp);
- procedure SetCurrencyProp(Index: Integer; const Value: Currency);
- procedure SetDoubleProp(Index: Integer; const Value: Double);
- procedure SetIDispatchProp(Index: Integer; const Value: IDispatch);
- procedure SetIntegerProp(Index: Integer; Value: Integer);
- procedure SetIUnknownProp(Index: Integer; const Value: IUnknown);
- procedure SetName(const Value: TComponentName); override;
- procedure SetWordBoolProp(Index: Integer; Value: WordBool);
- procedure SetTDateTimeProp(Index: Integer; const Value: TDateTime);
- procedure SetTFontProp(Index: Integer; Value: TFont);
- procedure SetOleBoolProp(Index: Integer; Value: TOleBool);
- procedure SetOleDateProp(Index: Integer; const Value: TOleDate);
- procedure SetOleEnumProp(Index: Integer; Value: TOleEnum);
- procedure SetTOleEnumProp(Index: Integer; Value: TOleEnum);
- procedure SetOleVariantProp(Index: Integer; const Value: OleVariant);
- procedure SetParent(AParent: TWinControl); override;
- procedure SetTPictureProp(Index: Integer; Value: TPicture);
- procedure SetProperty(Index: Integer; const Value: TVarData);
- procedure SetShortIntProp(Index: Integer; Value: Shortint);
- procedure SetSingleProp(Index: Integer; const Value: Single);
- procedure SetSmallintProp(Index: Integer; Value: Smallint);
- procedure SetStringProp(Index: Integer; const Value: string);
- procedure SetVariantProp(Index: Integer; const Value: Variant);
- procedure SetWideStringProp(Index: Integer; const Value: WideString);
- procedure SetWordProp(Index: Integer; Value: Word);
- procedure WndProc(var Message: TMessage); override;
- property ControlData: PControlData;
- { IPropertyNotifySink }
- function OnChanged(dispid: TDispID): HResult; virtual; stdcall;
- function OnRequestEdit(dispid: TDispID): HResult; virtual; stdcall;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure BrowseProperties;
- procedure DefaultHandler(var Message); override;
- procedure DoObjectVerb(Verb: Integer);
- function GetEnumPropDesc(DispID: Integer): TEnumPropDesc;
- function GetHelpContext(Member: string; var HelpCtx: Integer;
- var HelpFile: string): Boolean;
- procedure GetObjectVerbs(List: TStrings);
- function GetPropDisplayString(DispID: Integer): string;
- procedure GetPropDisplayStrings(DispID: Integer; List: TStrings);
- function IsCustomProperty(DispID: Integer): Boolean;
- function IsPropPageProperty(DispID: Integer): Boolean;
- procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
- procedure SetPropDisplayString(DispID: Integer; const Value: string);
- procedure ShowAboutBox;
- property OleObject: Variant;
- property PerPropBrowsing: IPerPropertyBrowsing;
- property DefaultDispatch: IDispatch;
- property TabStop default True;
- end;
-
- EOleCtrlError = class(Exception);
-
- function FontToOleFont(Font: TFont): Variant;
- procedure OleFontToFont(const OleFont: Variant; Font: TFont);
-
- implementation
-