memo_tlb.pas

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

    property OEMConvert: WordBool dispid 11;
    property ParentColor: WordBool dispid 12;
    property ParentCtl3D: WordBool dispid 13;
    property ParentFont: WordBool dispid 14;
    property ReadOnly: WordBool dispid 15;
    property ScrollBars: TxScrollStyle dispid 16;
    property Visible: WordBool dispid 17;
    property WantReturns: WordBool dispid 18;
    property WantTabs: WordBool dispid 19;
    property WordWrap: WordBool dispid 20;
    function  GetControlsAlignment: TxAlignment; dispid 21;
    procedure Clear; dispid 22;
    procedure ClearSelection; dispid 23;
    procedure CopyToClipboard; dispid 24;
    procedure CutToClipboard; dispid 25;
    procedure PasteFromClipboard; dispid 27;
    procedure Undo; dispid 28;
    procedure ClearUndo; dispid 29;
    procedure SelectAll; dispid 31;
    property CanUndo: WordBool readonly dispid 33;
    property Modified: WordBool dispid 34;
    property SelLength: Integer dispid 35;
    property SelStart: Integer dispid 36;
    property SelText: WideString dispid 37;
    property Text: WideString dispid -517;
    property DoubleBuffered: WordBool dispid 39;
    procedure FlipChildren(AllLevels: WordBool); dispid 40;
    function  DrawTextBiDiModeFlags(Flags: Integer): Integer; dispid 43;
    function  DrawTextBiDiModeFlagsReadingOnly: Integer; dispid 44;
    procedure InitiateAction; dispid 46;
    function  IsRightToLeft: WordBool; dispid 47;
    function  UseRightToLeftAlignment: WordBool; dispid 52;
    function  UseRightToLeftReading: WordBool; dispid 53;
    function  UseRightToLeftScrollBar: WordBool; dispid 54;
    property Cursor: Smallint dispid 55;
    function  ClassNameIs(const Name: WideString): WordBool; dispid 59;
    procedure AboutBox; dispid -552;
  end;

// *********************************************************************//
// DispIntf:  IMemoXEvents
// Flags:     (4096) Dispatchable
// GUID:      {0DB46872-09C5-11D2-AE5C-00A024E3867F}
// *********************************************************************//
  IMemoXEvents = dispinterface
    ['{0DB46872-09C5-11D2-AE5C-00A024E3867F}']
    procedure OnChange; dispid 1;
    procedure OnClick; dispid 2;
    procedure OnDblClick; dispid 3;
    procedure OnKeyPress(var Key: Smallint); dispid 9;
  end;


// *********************************************************************//
// OLE Control Proxy class declaration
// Control Name     : TMemoX
// Help String      : MemoX Control
// Default Interface: IMemoX
// Def. Intf. DISP? : No
// Event   Interface: IMemoXEvents
// TypeFlags        : (34) CanCreate Control
// *********************************************************************//
  TMemoXOnKeyPress = procedure(Sender: TObject; var Key: Smallint) of object;

  TMemoX = class(TOleControl)
  private
    FOnChange: TNotifyEvent;
    FOnClick: TNotifyEvent;
    FOnDblClick: TNotifyEvent;
    FOnKeyPress: TMemoXOnKeyPress;
    FIntf: IMemoX;
    function  GetControlInterface: IMemoX;
  protected
    procedure CreateControl;
    procedure InitControlData; override;
  public
    function  GetControlsAlignment: TxAlignment;
    procedure Clear;
    procedure ClearSelection;
    procedure CopyToClipboard;
    procedure CutToClipboard;
    procedure PasteFromClipboard;
    procedure Undo;
    procedure ClearUndo;
    procedure SelectAll;
    procedure FlipChildren(AllLevels: WordBool);
    function  DrawTextBiDiModeFlags(Flags: Integer): Integer;
    function  DrawTextBiDiModeFlagsReadingOnly: Integer;
    procedure InitiateAction;
    function  IsRightToLeft: WordBool;
    function  UseRightToLeftAlignment: WordBool;
    function  UseRightToLeftReading: WordBool;
    function  UseRightToLeftScrollBar: WordBool;
    function  ClassNameIs(const Name: WideString): WordBool;
    procedure AboutBox;
    property  ControlInterface: IMemoX read GetControlInterface;
    property  DefaultInterface: IMemoX read GetControlInterface;
    property CanUndo: WordBool index 33 read GetWordBoolProp;
    property Modified: WordBool index 34 read GetWordBoolProp write SetWordBoolProp;
    property SelLength: Integer index 35 read GetIntegerProp write SetIntegerProp;
    property SelStart: Integer index 36 read GetIntegerProp write SetIntegerProp;
    property SelText: WideString index 37 read GetWideStringProp write SetWideStringProp;
    property Text: WideString index -517 read GetWideStringProp write SetWideStringProp;
    property DoubleBuffered: WordBool index 39 read GetWordBoolProp write SetWordBoolProp;
  published
    property Alignment: TOleEnum index 1 read GetTOleEnumProp write SetTOleEnumProp stored False;
    property BiDiMode: TOleEnum index 2 read GetTOleEnumProp write SetTOleEnumProp stored False;
    property BorderStyle: TOleEnum index 3 read GetTOleEnumProp write SetTOleEnumProp stored False;
    property Color: TColor index -501 read GetTColorProp write SetTColorProp stored False;
    property Ctl3D: WordBool index 4 read GetWordBoolProp write SetWordBoolProp stored False;
    property DragCursor: Smallint index 5 read GetSmallintProp write SetSmallintProp stored False;
    property DragMode: TOleEnum index 6 read GetTOleEnumProp write SetTOleEnumProp stored False;
    property Enabled: WordBool index -514 read GetWordBoolProp write SetWordBoolProp stored False;
    property Font: TFont index -512 read GetTFontProp write SetTFontProp stored False;
    property HideSelection: WordBool index 7 read GetWordBoolProp write SetWordBoolProp stored False;
    property ImeMode: TOleEnum index 8 read GetTOleEnumProp write SetTOleEnumProp stored False;
    property ImeName: WideString index 9 read GetWideStringProp write SetWideStringProp stored False;
    property MaxLength: Integer index 10 read GetIntegerProp write SetIntegerProp stored False;
    property OEMConvert: WordBool index 11 read GetWordBoolProp write SetWordBoolProp stored False;
    property ParentColor: WordBool index 12 read GetWordBoolProp write SetWordBoolProp stored False;
    property ParentCtl3D: WordBool index 13 read GetWordBoolProp write SetWordBoolProp stored False;
    property ParentFont: WordBool index 14 read GetWordBoolProp write SetWordBoolProp stored False;
    property ReadOnly: WordBool index 15 read GetWordBoolProp write SetWordBoolProp stored False;
    property ScrollBars: TOleEnum index 16 read GetTOleEnumProp write SetTOleEnumProp stored False;
    property Visible: WordBool index 17 read GetWordBoolProp write SetWordBoolProp stored False;
    property WantReturns: WordBool index 18 read GetWordBoolProp write SetWordBoolProp stored False;
    property WantTabs: WordBool index 19 read GetWordBoolProp write SetWordBoolProp stored False;
    property WordWrap: WordBool index 20 read GetWordBoolProp write SetWordBoolProp stored False;
    property Cursor: Smallint index 55 read GetSmallintProp write SetSmallintProp stored False;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
    property OnKeyPress: TMemoXOnKeyPress read FOnKeyPress write FOnKeyPress;
  end;

procedure Register;

implementation

uses ComObj;

procedure TMemoX.InitControlData;
const
  CEventDispIDs: array [0..3] of DWORD = (
    $00000001, $00000002, $00000003, $00000009);
  CTFontIDs: array [0..0] of DWORD = (
    $FFFFFE00);
  CControlData: TControlData2 = (
    ClassID: '{0DB46874-09C5-11D2-AE5C-00A024E3867F}';
    EventIID: '{0DB46872-09C5-11D2-AE5C-00A024E3867F}';
    EventCount: 4;
    EventDispIDs: @CEventDispIDs;
    LicenseKey: nil (*HR:$80040154*);
    Flags: $0000002D;
    Version: 401;
    FontCount: 1;
    FontIDs: @CTFontIDs);
begin
  ControlData := @CControlData;
  TControlData2(CControlData).FirstEventOfs := Cardinal(@@FOnChange) - Cardinal(Self);
end;

procedure TMemoX.CreateControl;

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

begin
  if FIntf = nil then DoCreate;
end;

function TMemoX.GetControlInterface: IMemoX;
begin
  CreateControl;
  Result := FIntf;
end;

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

procedure TMemoX.Clear;
begin
  DefaultInterface.Clear;
end;

procedure TMemoX.ClearSelection;
begin
  DefaultInterface.ClearSelection;
end;

procedure TMemoX.CopyToClipboard;
begin
  DefaultInterface.CopyToClipboard;
end;

procedure TMemoX.CutToClipboard;
begin
  DefaultInterface.CutToClipboard;
end;

procedure TMemoX.PasteFromClipboard;
begin
  DefaultInterface.PasteFromClipboard;
end;

procedure TMemoX.Undo;
begin
  DefaultInterface.Undo;
end;

procedure TMemoX.ClearUndo;
begin
  DefaultInterface.ClearUndo;
end;

procedure TMemoX.SelectAll;
begin
  DefaultInterface.SelectAll;
end;

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

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

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

procedure TMemoX.InitiateAction;
begin
  DefaultInterface.InitiateAction;
end;

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

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

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

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

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

procedure TMemoX.AboutBox;
begin
  DefaultInterface.AboutBox;
end;

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

end.