home *** CD-ROM | disk | FTP | other *** search
/ DOS/V Power Report 1997 May / VPR9705A.ISO / VPR_DATA / PROGRAM / CBTRIAL / SETUP / DATA.Z / OLECTRLS.INT < prev    next >
Text File  |  1997-02-14  |  11KB  |  248 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {                                                       }
  6. {       Copyright (c) 1996 Borland International        }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit OleCtrls;
  11.  
  12. {$R-}
  13.  
  14. interface
  15.  
  16. uses Windows, Messages, Ole2, OleCtl, SysUtils, Classes, Controls, Forms,
  17.   Menus, Graphics, OleAuto;
  18.  
  19. type
  20.  
  21.   TOleControl = class;
  22.  
  23.   TOleClientSite = class(IOleClientSite)
  24.   public
  25.     constructor Create(Control: TOleControl);
  26.     function QueryInterface(const iid: TIID; var obj): HResult; override;
  27.     function AddRef: Longint; override;
  28.     function Release: Longint; override;
  29.     function SaveObject: HResult; override;
  30.     function GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint;
  31.       var mk: IMoniker): HResult; override;
  32.     function GetContainer(var container: IOleContainer): HResult; override;
  33.     function ShowObject: HResult; override;
  34.     function OnShowWindow(fShow: BOOL): HResult; override;
  35.     function RequestNewObjectLayout: HResult; override;
  36.   end;
  37.  
  38.   TOleControlSite = class(IOleControlSite)
  39.   public
  40.     constructor Create(Control: TOleControl);
  41.     function QueryInterface(const iid: TIID; var obj): HResult; override;
  42.     function AddRef: Longint; override;
  43.     function Release: Longint; override;
  44.     function OnControlInfoChanged: HResult; override;
  45.     function LockInPlaceActive(fLock: BOOL): HResult; override;
  46.     function GetExtendedControl(var disp: IDispatch): HResult; override;
  47.     function TransformCoords(var ptlHimetric: TPoint; var ptfContainer: TPointF;
  48.       flags: Longint): HResult; override;
  49.     function TranslateAccelerator(msg: PMsg; grfModifiers: Longint): HResult;
  50.        override;
  51.     function OnFocus(fGotFocus: BOOL): HResult; override;
  52.     function ShowPropertyFrame: HResult; override;
  53.   end;
  54.  
  55.   TOleInPlaceSite = class(IOleInPlaceSite)
  56.   public
  57.     constructor Create(Control: TOleControl);
  58.     function QueryInterface(const iid: TIID; var obj): HResult; override;
  59.     function AddRef: Longint; override;
  60.     function Release: Longint; override;
  61.     function GetWindow(var wnd: HWnd): HResult; override;
  62.     function ContextSensitiveHelp(fEnterMode: BOOL): HResult; override;
  63.     function CanInPlaceActivate: HResult; override;
  64.     function OnInPlaceActivate: HResult; override;
  65.     function OnUIActivate: HResult; override;
  66.     function GetWindowContext(var frame: IOleInPlaceFrame;
  67.       var doc: IOleInPlaceUIWindow; var rcPosRect: TRect;
  68.       var rcClipRect: TRect; var frameInfo: TOleInPlaceFrameInfo): HResult;
  69.       override;
  70.     function Scroll(const scrollExtent: TPoint): HResult; override;
  71.     function OnUIDeactivate(fUndoable: BOOL): HResult; override;
  72.     function OnInPlaceDeactivate: HResult; override;
  73.     function DiscardUndoState: HResult; override;
  74.     function DeactivateAndUndo: HResult; override;
  75.     function OnPosRectChange(const rcPosRect: TRect): HResult; override;
  76.   end;
  77.  
  78.   TOleInPlaceFrame = class(IOleInPlaceFrame)
  79.   public
  80.     constructor Create(Control: TOleControl);
  81.     function QueryInterface(const iid: TIID; var obj): HResult; override;
  82.     function AddRef: Longint; override;
  83.     function Release: Longint; override;
  84.     function GetWindow(var wnd: HWnd): HResult; override;
  85.     function ContextSensitiveHelp(fEnterMode: BOOL): HResult; override;
  86.     function GetBorder(var rectBorder: TRect): HResult; override;
  87.     function RequestBorderSpace(const borderwidths: TRect): HResult; override;
  88.     function SetBorderSpace(pborderwidths: PRect): HResult; override;
  89.     function SetActiveObject(activeObject: IOleInPlaceActiveObject;
  90.       pszObjName: POleStr): HResult; override;
  91.     function InsertMenus(hmenuShared: HMenu;
  92.       var menuWidths: TOleMenuGroupWidths): HResult; override;
  93.     function SetMenu(hmenuShared: HMenu; holemenu: HMenu;
  94.       hwndActiveObject: HWnd): HResult; override;
  95.     function RemoveMenus(hmenuShared: HMenu): HResult; override;
  96.     function SetStatusText(pszStatusText: POleStr): HResult; override;
  97.     function EnableModeless(fEnable: BOOL): HResult; override;
  98.     function TranslateAccelerator(var msg: TMsg; wID: Word): HResult; override;
  99.   end;
  100.  
  101.   TAmbientDispatch = class(IDispatch)
  102.   public
  103.     constructor Create(Control: TOleControl);
  104.     function QueryInterface(const iid: TIID; var obj): HResult; override;
  105.     function AddRef: Longint; override;
  106.     function Release: Longint; override;
  107.     function GetTypeInfoCount(var ctinfo: Integer): HResult; override;
  108.     function GetTypeInfo(itinfo: Integer; lcid: TLCID;
  109.       var tinfo: ITypeInfo): HResult; override;
  110.     function GetIDsOfNames(const iid: TIID; rgszNames: POleStrList;
  111.       cNames: Integer; lcid: TLCID; rgdispid: PDispIDList): HResult; override;
  112.     function Invoke(dispIDMember: TDispID; const iid: TIID; lcid: TLCID;
  113.       flags: Word; var dispParams: TDispParams; varResult: PVariant;
  114.       excepInfo: PExcepInfo; argErr: PInteger): HResult; override;
  115.   end;
  116.  
  117.   TEventDispatch = class(IDispatch)
  118.   public
  119.     constructor Create(Control: TOleControl);
  120.     function QueryInterface(const iid: TIID; var obj): HResult; override;
  121.     function AddRef: Longint; override;
  122.     function Release: Longint; override;
  123.     function GetTypeInfoCount(var ctinfo: Integer): HResult; override;
  124.     function GetTypeInfo(itinfo: Integer; lcid: TLCID;
  125.       var tinfo: ITypeInfo): HResult; override;
  126.     function GetIDsOfNames(const iid: TIID; rgszNames: POleStrList;
  127.       cNames: Integer; lcid: TLCID; rgdispid: PDispIDList): HResult; override;
  128.     function Invoke(dispIDMember: TDispID; const iid: TIID; lcid: TLCID;
  129.       flags: Word; var dispParams: TDispParams; varResult: PVariant;
  130.       excepInfo: PExcepInfo; argErr: PInteger): HResult; override;
  131.   end;
  132.  
  133.   TPropertyNotifySink = class(IPropertyNotifySink)
  134.   public
  135.     constructor Create(Control: TOleControl);
  136.     function QueryInterface(const iid: TIID; var obj): HResult; override;
  137.     function AddRef: Longint; override;
  138.     function Release: Longint; override;
  139.     function OnChanged(dispid: TDispID): HResult; override;
  140.     function OnRequestEdit(dispid: TDispID): HResult; override;
  141.   end;
  142.  
  143.   TSimpleFrameSite = class(ISimpleFrameSite)
  144.   public
  145.     constructor Create(Control: TOleControl);
  146.     function QueryInterface(const iid: TIID; var obj): HResult; override;
  147.     function AddRef: Longint; override;
  148.     function Release: Longint; override;
  149.     function PreMessageFilter(wnd: HWnd; msg, wp, lp: Integer;
  150.       var res: Integer; var Cookie: Longint): HResult; override;
  151.     function PostMessageFilter(wnd: HWnd; msg, wp, lp: Integer;
  152.       var res: Integer; Cookie: Longint): HResult; override;
  153.   end;
  154.  
  155.   TOleEnum = -32768..32767;
  156.  
  157.   TEnumValue = record
  158.     Value: Longint;
  159.     Ident: string;
  160.   end;
  161.  
  162.   PEnumValueList = ^TEnumValueList;
  163.   TEnumValueList = array[0..32767] of TEnumValue;
  164.  
  165.   TEnumPropDesc = class
  166.   public
  167.     constructor Create(DispID, ValueCount: Integer; TypeInfo: ITypeInfo);
  168.     destructor Destroy; override;
  169.     procedure GetStrings(Proc: TGetStrProc);
  170.     function StringToValue(const S: string): Integer;
  171.     function ValueToString(V: Integer): string;
  172.   end;
  173.  
  174.   PControlData = ^TControlData;
  175.   TControlData = record
  176.     ClassID: TCLSID;
  177.     EventIID: TIID;
  178.     EventCount: Longint;
  179.     EventDispIDs: Pointer;
  180.     LicenseKey: Pointer;
  181.     Flags: Integer;
  182.     InstanceCount: Integer;
  183.     EnumPropDescs: TList;
  184.   end;
  185.  
  186.   TOleControl = class(TWinControl)
  187.   protected
  188.     FEvents: Integer;
  189.     procedure CreateWnd; override;
  190.     procedure DefaultHandler(var Message); override;
  191.     procedure DefineProperties(Filer: TFiler); override;
  192.     procedure DestroyWindowHandle; override;
  193.     function GetColorProp(Index: Integer): TColor;
  194.     function GetCurrencyProp(Index: Integer): TCurrency;
  195.     function GetDoubleProp(Index: Integer): Double;
  196.     function GetIntegerProp(Index: Integer): Integer;
  197.     function GetOleBoolProp(Index: Integer): TOleBool;
  198.     function GetOleDateProp(Index: Integer): TOleDate;
  199.     function GetOleEnumProp(Index: Integer): TOleEnum;
  200.     procedure GetProperty(Index: Integer; var Value: TVarData);
  201.     function GetSingleProp(Index: Integer): Single;
  202.     function GetSmallintProp(Index: Integer): Smallint;
  203.     function GetStringProp(Index: Integer): string;
  204.     function GetVariantProp(Index: Integer): Variant;
  205.     procedure InitControlData; virtual; abstract;
  206.     procedure InvokeMethod(var DispInfo; Result: Pointer);
  207.     function PaletteChanged(Foreground: Boolean): Boolean; override;
  208.     procedure SetColorProp(Index: Integer; Value: TColor);
  209.     procedure SetCurrencyProp(Index: Integer; Value: TCurrency);
  210.     procedure SetDoubleProp(Index: Integer; Value: Double);
  211.     procedure SetIntegerProp(Index: Integer; Value: Integer);
  212.     procedure SetName(const Value: TComponentName); override;
  213.     procedure SetOleBoolProp(Index: Integer; Value: TOleBool);
  214.     procedure SetOleDateProp(Index: Integer; Value: TOleDate);
  215.     procedure SetOleEnumProp(Index: Integer; Value: TOleEnum);
  216.     procedure SetProperty(Index: Integer; const Value: TVarData);
  217.     procedure SetSingleProp(Index: Integer; Value: Single);
  218.     procedure SetSmallintProp(Index: Integer; Value: Smallint);
  219.     procedure SetStringProp(Index: Integer; const Value: string);
  220.     procedure SetVariantProp(Index: Integer; const Value: Variant);
  221.     procedure WndProc(var Message: TMessage); override;
  222.     property ControlData: PControlData;
  223.   public
  224.     constructor Create(AOwner: TComponent); override;
  225.     destructor Destroy; override;
  226.     procedure BrowseProperties;
  227.     procedure DoObjectVerb(Verb: Integer);
  228.     function GetEnumPropDesc(DispID: Integer): TEnumPropDesc;
  229.     function GetHelpContext(Member: string; var HelpCtx: Integer;
  230.       var HelpFile: string): Boolean;
  231.     procedure GetObjectVerbs(List: TStrings);
  232.     function GetPropDisplayString(DispID: Integer): string;
  233.     procedure GetPropDisplayStrings(DispID: Integer; List: TStrings);
  234.     function IsCustomProperty(DispID: Integer): Boolean;
  235.     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  236.     procedure SetPropDisplayString(DispID: Integer; const Value: string);
  237.     procedure ShowAboutBox;
  238.     property OleObject: Variant;
  239.     property TabStop default True;
  240.   end;
  241.  
  242.   EOleCtrlError = class(Exception);
  243.  
  244. function FontToOleFont(Font: TFont): Variant;
  245. procedure OleFontToFont(const OleFont: Variant; Font: TFont);
  246.  
  247. implementation
  248.