axcard_tlb.pas

《Delphi开发人员指南》配书原码

    property DragMode: TxDragMode dispid 3;
    property FaceUp: WordBool dispid 4;
    property ParentColor: WordBool dispid 5;
    property Suit: TxCardSuit dispid 6;
    property Value: TxCardValue dispid 7;
    property DoubleBuffered: WordBool dispid 10;
    procedure FlipChildren(AllLevels: WordBool); dispid 11;
    function  DrawTextBiDiModeFlags(Flags: Integer): Integer; dispid 14;
    function  DrawTextBiDiModeFlagsReadingOnly: Integer; dispid 15;
    property Enabled: WordBool dispid -514;
    function  GetControlsAlignment: TxAlignment; dispid 16;
    procedure InitiateAction; dispid 18;
    function  IsRightToLeft: WordBool; dispid 19;
    function  UseRightToLeftAlignment: WordBool; dispid 24;
    function  UseRightToLeftReading: WordBool; dispid 25;
    function  UseRightToLeftScrollBar: WordBool; dispid 26;
    property BiDiMode: TxBiDiMode dispid 27;
    property Visible: WordBool dispid 28;
    property Cursor: Smallint dispid 29;
    function  ClassNameIs(const Name: WideString): WordBool; dispid 33;
    procedure AboutBox; dispid -552;
  end;

// *********************************************************************//
// DispIntf:  ICardXEvents
// Flags:     (4096) Dispatchable
// GUID:      {7B33D943-0A2C-11D2-AE5C-04640BC10000}
// *********************************************************************//
  ICardXEvents = dispinterface
    ['{7B33D943-0A2C-11D2-AE5C-04640BC10000}']
    procedure OnClick; dispid 1;
    procedure OnDblClick; dispid 2;
    procedure OnKeyPress(var Key: Smallint); dispid 7;
  end;


// *********************************************************************//
// OLE Control Proxy class declaration
// Control Name     : TCardX
// Help String      : CardX Control
// Default Interface: ICardX
// Def. Intf. DISP? : No
// Event   Interface: ICardXEvents
// TypeFlags        : (34) CanCreate Control
// *********************************************************************//
  TCardXOnKeyPress = procedure(Sender: TObject; var Key: Smallint) of object;

  TCardX = class(TOleControl)
  private
    FOnClick: TNotifyEvent;
    FOnDblClick: TNotifyEvent;
    FOnKeyPress: TCardXOnKeyPress;
    FIntf: ICardX;
    function  GetControlInterface: ICardX;
  protected
    procedure CreateControl;
    procedure InitControlData; override;
  public
    procedure FlipChildren(AllLevels: WordBool);
    function  DrawTextBiDiModeFlags(Flags: Integer): Integer;
    function  DrawTextBiDiModeFlagsReadingOnly: Integer;
    function  GetControlsAlignment: TxAlignment;
    procedure InitiateAction;
    function  IsRightToLeft: WordBool;
    function  UseRightToLeftAlignment: WordBool;
    function  UseRightToLeftReading: WordBool;
    function  UseRightToLeftScrollBar: WordBool;
    function  ClassNameIs(const Name: WideString): WordBool;
    procedure AboutBox;
    property  ControlInterface: ICardX read GetControlInterface;
    property  DefaultInterface: ICardX read GetControlInterface;
    property DoubleBuffered: WordBool index 10 read GetWordBoolProp write SetWordBoolProp;
    property Enabled: WordBool index -514 read GetWordBoolProp write SetWordBoolProp;
    property BiDiMode: TOleEnum index 27 read GetTOleEnumProp write SetTOleEnumProp;
    property Visible: WordBool index 28 read GetWordBoolProp write SetWordBoolProp;
  published
    property  TabStop;
    property  Align;
    property  ParentShowHint;
    property  PopupMenu;
    property  ShowHint;
    property  TabOrder;
    property  OnDragDrop;
    property  OnDragOver;
    property  OnEndDrag;
    property  OnEnter;
    property  OnExit;
    property  OnStartDrag;
    property BackColor: TColor index 1 read GetTColorProp write SetTColorProp stored False;
    property Color: TColor index -501 read GetTColorProp write SetTColorProp stored False;
    property DragCursor: Smallint index 2 read GetSmallintProp write SetSmallintProp stored False;
    property DragMode: TOleEnum index 3 read GetTOleEnumProp write SetTOleEnumProp stored False;
    property FaceUp: WordBool index 4 read GetWordBoolProp write SetWordBoolProp stored False;
    property ParentColor: WordBool index 5 read GetWordBoolProp write SetWordBoolProp stored False;
    property Suit: TOleEnum index 6 read GetTOleEnumProp write SetTOleEnumProp stored False;
    property Value: TOleEnum index 7 read GetTOleEnumProp write SetTOleEnumProp stored False;
    property Cursor: Smallint index 29 read GetSmallintProp write SetSmallintProp stored False;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
    property OnKeyPress: TCardXOnKeyPress read FOnKeyPress write FOnKeyPress;
  end;

procedure Register;

implementation

uses ComObj;

procedure TCardX.InitControlData;
const
  CEventDispIDs: array [0..2] of DWORD = (
    $00000001, $00000002, $00000007);
  CControlData: TControlData2 = (
    ClassID: '{7B33D945-0A2C-11D2-AE5C-04640BC10000}';
    EventIID: '{7B33D943-0A2C-11D2-AE5C-04640BC10000}';
    EventCount: 3;
    EventDispIDs: @CEventDispIDs;
    LicenseKey: nil (*HR:$00000000*);
    Flags: $00000009;
    Version: 401);
begin
  ControlData := @CControlData;
  TControlData2(CControlData).FirstEventOfs := Cardinal(@@FOnClick) - Cardinal(Self);
end;

procedure TCardX.CreateControl;

  procedure DoCreate;
  begin
    FIntf := IUnknown(OleObject) as ICardX;
  end;

begin
  if FIntf = nil then DoCreate;
end;

function TCardX.GetControlInterface: ICardX;
begin
  CreateControl;
  Result := FIntf;
end;

procedure TCardX.FlipChildren(AllLevels: WordBool);
begin
  DefaultInterface.FlipChildren(AllLevels);
end;

function  TCardX.DrawTextBiDiModeFlags(Flags: Integer): Integer;
begin
  Result := DefaultInterface.DrawTextBiDiModeFlags(Flags);
end;

function  TCardX.DrawTextBiDiModeFlagsReadingOnly: Integer;
begin
  Result := DefaultInterface.DrawTextBiDiModeFlagsReadingOnly;
end;

function  TCardX.GetControlsAlignment: TxAlignment;
begin
  Result := DefaultInterface.GetControlsAlignment;
end;

procedure TCardX.InitiateAction;
begin
  DefaultInterface.InitiateAction;
end;

function  TCardX.IsRightToLeft: WordBool;
begin
  Result := DefaultInterface.IsRightToLeft;
end;

function  TCardX.UseRightToLeftAlignment: WordBool;
begin
  Result := DefaultInterface.UseRightToLeftAlignment;
end;

function  TCardX.UseRightToLeftReading: WordBool;
begin
  Result := DefaultInterface.UseRightToLeftReading;
end;

function  TCardX.UseRightToLeftScrollBar: WordBool;
begin
  Result := DefaultInterface.UseRightToLeftScrollBar;
end;

function  TCardX.ClassNameIs(const Name: WideString): WordBool;
begin
  Result := DefaultInterface.ClassNameIs(Name);
end;

procedure TCardX.AboutBox;
begin
  DefaultInterface.AboutBox;
end;

procedure Register;
begin
  RegisterComponents('ActiveX',[TCardX]);
end;

end.