Marco Web Center |
Home: Code Repository: Mastering Delphi 5Project XFORM1
Project StructureXFORM1.DPRlibrary Xform1; uses ComServ, XFORM1_TLB in 'XFORM1_TLB.pas', FormX1 in 'FormX1.pas' {FormX1: TActiveForm} {FormX1: CoClass}; {$E ocx} exports DllGetClassObject, DllCanUnloadNow, DllRegisterServer, DllUnregisterServer; {$R *.TLB} {$R *.RES} begin end. XFORM1_TLB.PASunit XFORM1_TLB; // ************************************************************************ // // WARNING // // ------- // // The types declared in this file were generated from data read from a // // Type Library. If this type library is explicitly or indirectly (via // // another type library referring to this type library) re-imported, or the // // 'Refresh' command of the Type Library Editor activated while editing the // // Type Library, the contents of this file will be regenerated and all // // manual modifications will be lost. // // ************************************************************************ // // PASTLWTR : $Revision: 1.11.1.63 $ // File generated on 6/27/98 12:21:09 AM from Type Library described below. // ************************************************************************ // // Type Lib: C:\md4code\Part5\23\XFORM1\XFORM1.tlb // IID\LCID: {DB9C325A-0D2A-11D2-B9F1-004845400FAA}\0 // Helpfile: // HelpString: XFORM1 Library // Version: 1.0 // ************************************************************************ // interface uses Windows, ActiveX, Classes, Graphics, OleCtrls, StdVCL; // *********************************************************************// // GUIDS declared in the TypeLibrary. Following prefixes are used: // // Type Libraries : LIBID_xxxx // // CoClasses : CLASS_xxxx // // DISPInterfaces : DIID_xxxx // // Non-DISP interfaces: IID_xxxx // // *********************************************************************// const LIBID_XFORM1: TGUID = '{DB9C325A-0D2A-11D2-B9F1-004845400FAA}'; IID_IFormX1: TGUID = '{DB9C325B-0D2A-11D2-B9F1-004845400FAA}'; DIID_IFormX1Events: TGUID = '{DB9C325D-0D2A-11D2-B9F1-004845400FAA}'; CLASS_FormX1: TGUID = '{DB9C325F-0D2A-11D2-B9F1-004845400FAA}'; // *********************************************************************// // Declaration of Enumerations defined in Type Library // // *********************************************************************// // TxActiveFormBorderStyle constants type TxActiveFormBorderStyle = TOleEnum; const afbNone = $00000000; afbSingle = $00000001; afbSunken = $00000002; afbRaised = $00000003; // TxPrintScale constants type TxPrintScale = TOleEnum; const poNone = $00000000; poProportional = $00000001; poPrintToFit = $00000002; // TxMouseButton constants type TxMouseButton = TOleEnum; const mbLeft = $00000000; mbRight = $00000001; mbMiddle = $00000002; // TxBiDiMode constants type TxBiDiMode = TOleEnum; const bdLeftToRight = $00000000; bdRightToLeft = $00000001; bdRightToLeftNoAlign = $00000002; bdRightToLeftReadingOnly = $00000003; type // *********************************************************************// // Forward declaration of interfaces defined in Type Library // // *********************************************************************// IFormX1 = interface; IFormX1Disp = dispinterface; IFormX1Events = dispinterface; // *********************************************************************// // Declaration of CoClasses defined in Type Library // // (NOTE: Here we map each CoClass to its Default Interface) // // *********************************************************************// FormX1 = IFormX1; // *********************************************************************// // Interface: IFormX1 // Flags: (4416) Dual OleAutomation Dispatchable // GUID: {DB9C325B-0D2A-11D2-B9F1-004845400FAA} // *********************************************************************// IFormX1 = interface(IDispatch) ['{DB9C325B-0D2A-11D2-B9F1-004845400FAA}'] function Get_Visible: WordBool; safecall; procedure Set_Visible(Value: WordBool); safecall; function Get_AutoScroll: WordBool; safecall; procedure Set_AutoScroll(Value: WordBool); safecall; function Get_AutoSize: WordBool; safecall; procedure Set_AutoSize(Value: WordBool); safecall; function Get_AxBorderStyle: TxActiveFormBorderStyle; safecall; procedure Set_AxBorderStyle(Value: TxActiveFormBorderStyle); safecall; function Get_Caption: WideString; safecall; procedure Set_Caption(const Value: WideString); safecall; function Get_Color: OLE_COLOR; safecall; procedure Set_Color(Value: OLE_COLOR); safecall; function Get_Font: IFontDisp; safecall; procedure _Set_Font(const Value: IFontDisp); safecall; procedure Set_Font(const Value: IFontDisp); safecall; function Get_KeyPreview: WordBool; safecall; procedure Set_KeyPreview(Value: WordBool); safecall; function Get_PixelsPerInch: Integer; safecall; procedure Set_PixelsPerInch(Value: Integer); safecall; function Get_PrintScale: TxPrintScale; safecall; procedure Set_PrintScale(Value: TxPrintScale); safecall; function Get_Scaled: WordBool; safecall; procedure Set_Scaled(Value: WordBool); safecall; function Get_Active: WordBool; safecall; function Get_DropTarget: WordBool; safecall; procedure Set_DropTarget(Value: WordBool); safecall; function Get_HelpFile: WideString; safecall; procedure Set_HelpFile(const Value: WideString); safecall; function Get_DoubleBuffered: WordBool; safecall; procedure Set_DoubleBuffered(Value: WordBool); safecall; function Get_Enabled: WordBool; safecall; procedure Set_Enabled(Value: WordBool); safecall; function Get_BiDiMode: TxBiDiMode; safecall; procedure Set_BiDiMode(Value: TxBiDiMode); safecall; function Get_Cursor: Smallint; safecall; procedure Set_Cursor(Value: Smallint); safecall; property Visible: WordBool read Get_Visible write Set_Visible; property AutoScroll: WordBool read Get_AutoScroll write Set_AutoScroll; property AutoSize: WordBool read Get_AutoSize write Set_AutoSize; property AxBorderStyle: TxActiveFormBorderStyle read Get_AxBorderStyle write Set_AxBorderStyle; property Caption: WideString read Get_Caption write Set_Caption; property Color: OLE_COLOR read Get_Color write Set_Color; property Font: IFontDisp read Get_Font write _Set_Font; property KeyPreview: WordBool read Get_KeyPreview write Set_KeyPreview; property PixelsPerInch: Integer read Get_PixelsPerInch write Set_PixelsPerInch; property PrintScale: TxPrintScale read Get_PrintScale write Set_PrintScale; property Scaled: WordBool read Get_Scaled write Set_Scaled; property Active: WordBool read Get_Active; property DropTarget: WordBool read Get_DropTarget write Set_DropTarget; property HelpFile: WideString read Get_HelpFile write Set_HelpFile; property DoubleBuffered: WordBool read Get_DoubleBuffered write Set_DoubleBuffered; property Enabled: WordBool read Get_Enabled write Set_Enabled; property BiDiMode: TxBiDiMode read Get_BiDiMode write Set_BiDiMode; property Cursor: Smallint read Get_Cursor write Set_Cursor; end; // *********************************************************************// // DispIntf: IFormX1Disp // Flags: (4416) Dual OleAutomation Dispatchable // GUID: {DB9C325B-0D2A-11D2-B9F1-004845400FAA} // *********************************************************************// IFormX1Disp = dispinterface ['{DB9C325B-0D2A-11D2-B9F1-004845400FAA}'] property Visible: WordBool dispid 1; property AutoScroll: WordBool dispid 2; property AutoSize: WordBool dispid 3; property AxBorderStyle: TxActiveFormBorderStyle dispid 4; property Caption: WideString dispid -518; property Color: OLE_COLOR dispid -501; property Font: IFontDisp dispid -512; property KeyPreview: WordBool dispid 5; property PixelsPerInch: Integer dispid 6; property PrintScale: TxPrintScale dispid 7; property Scaled: WordBool dispid 8; property Active: WordBool readonly dispid 9; property DropTarget: WordBool dispid 10; property HelpFile: WideString dispid 11; property DoubleBuffered: WordBool dispid 12; property Enabled: WordBool dispid -514; property BiDiMode: TxBiDiMode dispid 13; property Cursor: Smallint dispid 14; end; // *********************************************************************// // DispIntf: IFormX1Events // Flags: (0) // GUID: {DB9C325D-0D2A-11D2-B9F1-004845400FAA} // *********************************************************************// IFormX1Events = dispinterface ['{DB9C325D-0D2A-11D2-B9F1-004845400FAA}'] procedure OnActivate; dispid 1; procedure OnClick; dispid 2; procedure OnCreate; dispid 3; procedure OnDblClick; dispid 4; procedure OnDestroy; dispid 5; procedure OnDeactivate; dispid 6; procedure OnKeyPress(var Key: Smallint); dispid 10; procedure OnPaint; dispid 15; end; // *********************************************************************// // OLE Control Proxy class declaration // Control Name : TFormX1 // Help String : FormX1 Control // Default Interface: IFormX1 // Def. Intf. DISP? : No // Event Interface: IFormX1Events // TypeFlags : (34) CanCreate Control // *********************************************************************// TFormX1OnKeyPress = procedure(Sender: TObject; var Key: Smallint) of object; TFormX1 = class(TOleControl) private FOnActivate: TNotifyEvent; FOnClick: TNotifyEvent; FOnCreate: TNotifyEvent; FOnDblClick: TNotifyEvent; FOnDestroy: TNotifyEvent; FOnDeactivate: TNotifyEvent; FOnKeyPress: TFormX1OnKeyPress; FOnPaint: TNotifyEvent; FIntf: IFormX1; function GetControlInterface: IFormX1; protected procedure CreateControl; procedure InitControlData; override; public property ControlInterface: IFormX1 read GetControlInterface; property Visible: WordBool index 1 read GetWordBoolProp write SetWordBoolProp; property Active: WordBool index 9 read GetWordBoolProp; property DropTarget: WordBool index 10 read GetWordBoolProp write SetWordBoolProp; property HelpFile: WideString index 11 read GetWideStringProp write SetWideStringProp; property DoubleBuffered: WordBool index 12 read GetWordBoolProp write SetWordBoolProp; property Enabled: WordBool index -514 read GetWordBoolProp write SetWordBoolProp; property BiDiMode: TOleEnum index 13 read GetTOleEnumProp write SetTOleEnumProp; published property AutoScroll: WordBool index 2 read GetWordBoolProp write SetWordBoolProp stored False; property AutoSize: WordBool index 3 read GetWordBoolProp write SetWordBoolProp stored False; property AxBorderStyle: TOleEnum index 4 read GetTOleEnumProp write SetTOleEnumProp stored False; property Caption: WideString index -518 read GetWideStringProp write SetWideStringProp stored False; property Color: TColor index -501 read GetTColorProp write SetTColorProp stored False; property Font: TFont index -512 read GetTFontProp write SetTFontProp stored False; property KeyPreview: WordBool index 5 read GetWordBoolProp write SetWordBoolProp stored False; property PixelsPerInch: Integer index 6 read GetIntegerProp write SetIntegerProp stored False; property PrintScale: TOleEnum index 7 read GetTOleEnumProp write SetTOleEnumProp stored False; property Scaled: WordBool index 8 read GetWordBoolProp write SetWordBoolProp stored False; property Cursor: Smallint index 14 read GetSmallintProp write SetSmallintProp stored False; property OnActivate: TNotifyEvent read FOnActivate write FOnActivate; property OnClick: TNotifyEvent read FOnClick write FOnClick; property OnCreate: TNotifyEvent read FOnCreate write FOnCreate; property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick; property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy; property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate; property OnKeyPress: TFormX1OnKeyPress read FOnKeyPress write FOnKeyPress; property OnPaint: TNotifyEvent read FOnPaint write FOnPaint; end; procedure Register; implementation uses ComObj; procedure TFormX1.InitControlData; const CEventDispIDs: array [0..7] of DWORD = ( $00000001, $00000002, $00000003, $00000004, $00000005, $00000006, $0000000A, $0000000F); CTFontIDs: array [0..0] of DWORD = ( $FFFFFE00); CControlData: TControlData = ( ClassID: '{DB9C325F-0D2A-11D2-B9F1-004845400FAA}'; EventIID: '{DB9C325D-0D2A-11D2-B9F1-004845400FAA}'; EventCount: 8; EventDispIDs: @CEventDispIDs; LicenseKey: nil; Flags: $0000001D; Version: 300; FontCount: 1; FontIDs: @CTFontIDs); begin ControlData := @CControlData; end; procedure TFormX1.CreateControl; procedure DoCreate; begin FIntf := IUnknown(OleObject) as IFormX1; end; begin if FIntf = nil then DoCreate; end; function TFormX1.GetControlInterface: IFormX1; begin CreateControl; Result := FIntf; end; procedure Register; begin RegisterComponents('ActiveX',[TFormX1]); end; end. FORMX1.PASunit FormX1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ActiveX, AxCtrls, XFORM1_TLB, ExtCtrls; type TFormX1 = class(TActiveForm, IFormX1) PaintBox1: TPaintBox; procedure FormPaint(Sender: TObject); procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); private { Private declarations } FEvents: IFormX1Events; procedure ActivateEvent(Sender: TObject); procedure ClickEvent(Sender: TObject); procedure CreateEvent(Sender: TObject); procedure DblClickEvent(Sender: TObject); procedure DeactivateEvent(Sender: TObject); procedure DestroyEvent(Sender: TObject); procedure KeyPressEvent(Sender: TObject; var Key: Char); procedure PaintEvent(Sender: TObject); protected { Protected declarations } procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override; procedure EventSinkChanged(const EventSink: IUnknown); override; function Get_Active: WordBool; safecall; function Get_AutoScroll: WordBool; safecall; function Get_AutoSize: WordBool; safecall; function Get_AxBorderStyle: TxActiveFormBorderStyle; safecall; function Get_BiDiMode: TxBiDiMode; safecall; function Get_Caption: WideString; safecall; function Get_Color: OLE_COLOR; safecall; function Get_Cursor: Smallint; safecall; function Get_DoubleBuffered: WordBool; safecall; function Get_DropTarget: WordBool; safecall; function Get_Enabled: WordBool; safecall; function Get_Font: IFontDisp; safecall; function Get_HelpFile: WideString; safecall; function Get_KeyPreview: WordBool; safecall; function Get_PixelsPerInch: Integer; safecall; function Get_PrintScale: TxPrintScale; safecall; function Get_Scaled: WordBool; safecall; function Get_Visible: WordBool; safecall; procedure _Set_Font(const Value: IFontDisp); safecall; procedure Set_AutoScroll(Value: WordBool); safecall; procedure Set_AutoSize(Value: WordBool); safecall; procedure Set_AxBorderStyle(Value: TxActiveFormBorderStyle); safecall; procedure Set_BiDiMode(Value: TxBiDiMode); safecall; procedure Set_Caption(const Value: WideString); safecall; procedure Set_Color(Value: OLE_COLOR); safecall; procedure Set_Cursor(Value: Smallint); safecall; procedure Set_DoubleBuffered(Value: WordBool); safecall; procedure Set_DropTarget(Value: WordBool); safecall; procedure Set_Enabled(Value: WordBool); safecall; procedure Set_Font(const Value: IFontDisp); safecall; procedure Set_HelpFile(const Value: WideString); safecall; procedure Set_KeyPreview(Value: WordBool); safecall; procedure Set_PixelsPerInch(Value: Integer); safecall; procedure Set_PrintScale(Value: TxPrintScale); safecall; procedure Set_Scaled(Value: WordBool); safecall; procedure Set_Visible(Value: WordBool); safecall; public { Public declarations } procedure Initialize; override; end; implementation uses ComObj, ComServ; {$R *.DFM} { TFormX1 } procedure TFormX1.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); begin { Define property pages here. Property pages are defined by calling DefinePropertyPage with the class id of the page. For example, DefinePropertyPage(Class_FormX1Page); } end; procedure TFormX1.EventSinkChanged(const EventSink: IUnknown); begin FEvents := EventSink as IFormX1Events; end; procedure TFormX1.Initialize; begin inherited Initialize; OnActivate := ActivateEvent; OnClick := ClickEvent; OnCreate := CreateEvent; OnDblClick := DblClickEvent; OnDeactivate := DeactivateEvent; OnDestroy := DestroyEvent; OnKeyPress := KeyPressEvent; OnPaint := PaintEvent; end; function TFormX1.Get_Active: WordBool; begin Result := Active; end; function TFormX1.Get_AutoScroll: WordBool; begin Result := AutoScroll; end; function TFormX1.Get_AutoSize: WordBool; begin Result := AutoSize; end; function TFormX1.Get_AxBorderStyle: TxActiveFormBorderStyle; begin Result := Ord(AxBorderStyle); end; function TFormX1.Get_BiDiMode: TxBiDiMode; begin Result := Ord(BiDiMode); end; function TFormX1.Get_Caption: WideString; begin Result := WideString(Caption); end; function TFormX1.Get_Color: OLE_COLOR; begin Result := OLE_COLOR(Color); end; function TFormX1.Get_Cursor: Smallint; begin Result := Smallint(Cursor); end; function TFormX1.Get_DoubleBuffered: WordBool; begin Result := DoubleBuffered; end; function TFormX1.Get_DropTarget: WordBool; begin Result := DropTarget; end; function TFormX1.Get_Enabled: WordBool; begin Result := Enabled; end; function TFormX1.Get_Font: IFontDisp; begin GetOleFont(Font, Result); end; function TFormX1.Get_HelpFile: WideString; begin Result := WideString(HelpFile); end; function TFormX1.Get_KeyPreview: WordBool; begin Result := KeyPreview; end; function TFormX1.Get_PixelsPerInch: Integer; begin Result := PixelsPerInch; end; function TFormX1.Get_PrintScale: TxPrintScale; begin Result := Ord(PrintScale); end; function TFormX1.Get_Scaled: WordBool; begin Result := Scaled; end; function TFormX1.Get_Visible: WordBool; begin Result := Visible; end; procedure TFormX1._Set_Font(const Value: IFontDisp); begin SetOleFont(Font, Value); end; procedure TFormX1.Set_AutoScroll(Value: WordBool); begin AutoScroll := Value; end; procedure TFormX1.Set_AutoSize(Value: WordBool); begin AutoSize := Value; end; procedure TFormX1.Set_AxBorderStyle(Value: TxActiveFormBorderStyle); begin AxBorderStyle := TActiveFormBorderStyle(Value); end; procedure TFormX1.Set_BiDiMode(Value: TxBiDiMode); begin BiDiMode := TBiDiMode(Value); end; procedure TFormX1.Set_Caption(const Value: WideString); begin Caption := TCaption(Value); end; procedure TFormX1.Set_Color(Value: OLE_COLOR); begin Color := TColor(Value); end; procedure TFormX1.Set_Cursor(Value: Smallint); begin Cursor := TCursor(Value); end; procedure TFormX1.Set_DoubleBuffered(Value: WordBool); begin DoubleBuffered := Value; end; procedure TFormX1.Set_DropTarget(Value: WordBool); begin DropTarget := Value; end; procedure TFormX1.Set_Enabled(Value: WordBool); begin Enabled := Value; end; procedure TFormX1.Set_Font(const Value: IFontDisp); begin SetOleFont(Font, Value); end; procedure TFormX1.Set_HelpFile(const Value: WideString); begin HelpFile := String(Value); end; procedure TFormX1.Set_KeyPreview(Value: WordBool); begin KeyPreview := Value; end; procedure TFormX1.Set_PixelsPerInch(Value: Integer); begin PixelsPerInch := Value; end; procedure TFormX1.Set_PrintScale(Value: TxPrintScale); begin PrintScale := TPrintScale(Value); end; procedure TFormX1.Set_Scaled(Value: WordBool); begin Scaled := Value; end; procedure TFormX1.Set_Visible(Value: WordBool); begin Visible := Value; end; procedure TFormX1.ActivateEvent(Sender: TObject); begin if FEvents <> nil then FEvents.OnActivate; end; procedure TFormX1.ClickEvent(Sender: TObject); begin if FEvents <> nil then FEvents.OnClick; end; procedure TFormX1.CreateEvent(Sender: TObject); begin if FEvents <> nil then FEvents.OnCreate; end; procedure TFormX1.DblClickEvent(Sender: TObject); begin if FEvents <> nil then FEvents.OnDblClick; end; procedure TFormX1.DeactivateEvent(Sender: TObject); begin if FEvents <> nil then FEvents.OnDeactivate; end; procedure TFormX1.DestroyEvent(Sender: TObject); begin if FEvents <> nil then FEvents.OnDestroy; end; procedure TFormX1.KeyPressEvent(Sender: TObject; var Key: Char); var TempKey: Smallint; begin TempKey := Smallint(Key); if FEvents <> nil then FEvents.OnKeyPress(TempKey); Key := Char(TempKey); end; procedure TFormX1.PaintEvent(Sender: TObject); begin Canvas.Brush.Color := clBlue; Canvas.Rectangle (20, 20, ClientWidth - 20, ClientHeight - 20); if FEvents <> nil then FEvents.OnPaint; end; procedure TFormX1.FormPaint(Sender: TObject); begin Canvas.Brush.Color := clYellow; Canvas.Ellipse(0, 0, Width, Height); end; procedure TFormX1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin PaintBox1.Canvas.Ellipse (X-10, Y-10, X+10, Y+10); end; initialization TActiveFormFactory.Create( ComServer, TActiveFormControl, TFormX1, Class_FormX1, 1, '', OLEMISC_SIMPLEFRAME or OLEMISC_ACTSLIKELABEL, tmApartment); end. FORMX1.DFMobject FormX1: TFormX1 Left = 192 Top = 108 Width = 413 Height = 278 Caption = 'FormX1' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = False OnPaint = FormPaint PixelsPerInch = 96 TextHeight = 13 object PaintBox1: TPaintBox Left = 56 Top = 56 Width = 289 Height = 129 Color = clFuchsia ParentColor = False OnMouseDown = PaintBox1MouseDown end end
|
||
© Copyright Marco Cantù, 1995-2020, All rights reserved |