lvctrl_tlb.pas

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

    procedure Set_Checked(Value: WordBool); safecall;
    function  Get_SubItems: IStrings; safecall;
    procedure Set_SubItems(const Value: IStrings); safecall;
    property Caption: WideString read Get_Caption write Set_Caption;
    property Index: Integer read Get_Index;
    property Checked: WordBool read Get_Checked write Set_Checked;
    property SubItems: IStrings read Get_SubItems write Set_SubItems;
  end;

// *********************************************************************//
// DispIntf:  IListItemDisp
// Flags:     (4416) Dual OleAutomation Dispatchable
// GUID:      {1B5911E1-88A1-11D2-9261-00104B700B61}
// *********************************************************************//
  IListItemDisp = dispinterface
    ['{1B5911E1-88A1-11D2-9261-00104B700B61}']
    property Caption: WideString dispid 1;
    property Index: Integer readonly dispid 2;
    property Checked: WordBool dispid 3;
    property SubItems: IStrings dispid 4;
  end;

// *********************************************************************//
// Interface: IListItems
// Flags:     (4416) Dual OleAutomation Dispatchable
// GUID:      {C6B36444-88B1-11D2-9261-00104B700B61}
// *********************************************************************//
  IListItems = interface(IDispatch)
    ['{C6B36444-88B1-11D2-9261-00104B700B61}']
    function  Get__NewEnum: IUnknown; safecall;
    function  Get_Item(Index: Integer): IListItem; safecall;
    function  Get_Count: Integer; safecall;
    function  Add: IListItem; safecall;
    procedure Remove(Index: Integer); safecall;
    property _NewEnum: IUnknown read Get__NewEnum;
    property Item[Index: Integer]: IListItem read Get_Item; default;
    property Count: Integer read Get_Count;
  end;

// *********************************************************************//
// DispIntf:  IListItemsDisp
// Flags:     (4416) Dual OleAutomation Dispatchable
// GUID:      {C6B36444-88B1-11D2-9261-00104B700B61}
// *********************************************************************//
  IListItemsDisp = dispinterface
    ['{C6B36444-88B1-11D2-9261-00104B700B61}']
    property _NewEnum: IUnknown readonly dispid -4;
    property Item[Index: Integer]: IListItem readonly dispid 0; default;
    property Count: Integer readonly dispid 1;
    function  Add: IListItem; dispid 2;
    procedure Remove(Index: Integer); dispid 3;
  end;


// *********************************************************************//
// OLE Control Proxy class declaration
// Control Name     : TListViewX
// Help String      : ListViewX Control
// Default Interface: IListViewX
// Def. Intf. DISP? : No
// Event   Interface: IListViewXEvents
// TypeFlags        : (34) CanCreate Control
// *********************************************************************//
  TListViewXOnDataHint = procedure(Sender: TObject; StartIndex: Integer; EndIndex: Integer) of object;
  TListViewXOnKeyPress = procedure(Sender: TObject; var Key: Smallint) of object;

  TListViewX = class(TOleControl)
  private
    FOnClick: TNotifyEvent;
    FOnDataHint: TListViewXOnDataHint;
    FOnDblClick: TNotifyEvent;
    FOnKeyPress: TListViewXOnKeyPress;
    FOnResize: TNotifyEvent;
    FIntf: IListViewX;
    function  GetControlInterface: IListViewX;
  protected
    procedure CreateControl;
    procedure InitControlData; override;
    function  Get_Items: IListItems;
  public
    function  AlphaSort: WordBool;
    procedure Arrange(Code: TxListArrangement);
    function  GetSearchString: WideString;
    function  IsEditing: WordBool;
    procedure Scroll(DX: Integer; DY: Integer);
    function  StringWidth(const S: WideString): Integer;
    procedure UpdateItems(FirstIndex: Integer; LastIndex: Integer);
    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: IListViewX read GetControlInterface;
    property  DefaultInterface: IListViewX read GetControlInterface;
    property SelCount: Integer index 30 read GetIntegerProp;
    property VisibleRowCount: Integer index 34 read GetIntegerProp;
    property DoubleBuffered: WordBool index 37 read GetWordBoolProp write SetWordBoolProp;
    property Items: IListItems read Get_Items;
  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 AllocBy: Integer index 1 read GetIntegerProp write SetIntegerProp 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 Checkboxes: WordBool index 4 read GetWordBoolProp write SetWordBoolProp stored False;
    property Color: TColor index -501 read GetTColorProp write SetTColorProp stored False;
    property ColumnClick: WordBool index 5 read GetWordBoolProp write SetWordBoolProp stored False;
    property Ctl3D: WordBool index 6 read GetWordBoolProp write SetWordBoolProp stored False;
    property DragCursor: Smallint index 7 read GetSmallintProp write SetSmallintProp stored False;
    property DragMode: TOleEnum index 8 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 FlatScrollBars: WordBool index 9 read GetWordBoolProp write SetWordBoolProp stored False;
    property FullDrag: WordBool index 10 read GetWordBoolProp write SetWordBoolProp stored False;
    property GridLines: WordBool index 11 read GetWordBoolProp write SetWordBoolProp stored False;
    property HideSelection: WordBool index 12 read GetWordBoolProp write SetWordBoolProp stored False;
    property HotTrack: WordBool index 13 read GetWordBoolProp write SetWordBoolProp stored False;
    property MultiSelect: WordBool index 14 read GetWordBoolProp write SetWordBoolProp stored False;
    property OwnerData: WordBool index 15 read GetWordBoolProp write SetWordBoolProp stored False;
    property OwnerDraw: WordBool index 16 read GetWordBoolProp write SetWordBoolProp stored False;
    property ReadOnly: WordBool index 17 read GetWordBoolProp write SetWordBoolProp stored False;
    property RowSelect: WordBool index 18 read GetWordBoolProp write SetWordBoolProp stored False;
    property ParentColor: WordBool index 19 read GetWordBoolProp write SetWordBoolProp stored False;
    property ParentFont: WordBool index 20 read GetWordBoolProp write SetWordBoolProp stored False;
    property ShowColumnHeaders: WordBool index 21 read GetWordBoolProp write SetWordBoolProp stored False;
    property SortType: TOleEnum index 22 read GetTOleEnumProp write SetTOleEnumProp stored False;
    property ViewStyle: TOleEnum index 23 read GetTOleEnumProp write SetTOleEnumProp stored False;
    property Visible: WordBool index 24 read GetWordBoolProp write SetWordBoolProp stored False;
    property Cursor: Smallint index 54 read GetSmallintProp write SetSmallintProp stored False;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property OnDataHint: TListViewXOnDataHint read FOnDataHint write FOnDataHint;
    property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
    property OnKeyPress: TListViewXOnKeyPress read FOnKeyPress write FOnKeyPress;
    property OnResize: TNotifyEvent read FOnResize write FOnResize;
  end;

// *********************************************************************//
// The Class CoListItem provides a Create and CreateRemote method to          
// create instances of the default interface IListItem exposed by              
// the CoClass ListItem. The functions are intended to be used by             
// clients wishing to automate the CoClass objects exposed by the         
// server of this typelibrary.                                            
// *********************************************************************//
  CoListItem = class
    class function Create: IListItem;
    class function CreateRemote(const MachineName: string): IListItem;
  end;


// *********************************************************************//
// OLE Server Proxy class declaration
// Server Object    : TListItem
// Help String      : ListItem Object
// Default Interface: IListItem
// Def. Intf. DISP? : No
// Event   Interface: 
// TypeFlags        : (2) CanCreate
// *********************************************************************//
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  TListItemProperties= class;
{$ENDIF}
  TListItem = class(TOleServer)
  private
    FIntf:        IListItem;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
    FProps:       TListItemProperties;
    function      GetServerProperties: TListItemProperties;
{$ENDIF}
    function      GetDefaultInterface: IListItem;
  protected
    procedure InitServerData; override;
    function  Get_Caption: WideString;
    procedure Set_Caption(const Value: WideString);
    function  Get_Index: Integer;
    function  Get_Checked: WordBool;
    procedure Set_Checked(Value: WordBool);
    function  Get_SubItems: IStrings;
    procedure Set_SubItems(const Value: IStrings);
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure Connect; override;
    procedure ConnectTo(svrIntf: IListItem);
    procedure Disconnect; override;
    property  DefaultInterface: IListItem read GetDefaultInterface;
    property Index: Integer read Get_Index;
    property Caption: WideString read Get_Caption write Set_Caption;
    property Checked: WordBool read Get_Checked write Set_Checked;
    property SubItems: IStrings read Get_SubItems write Set_SubItems;
  published
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
    property Server: TListItemProperties read GetServerProperties;
{$ENDIF}
  end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
// *********************************************************************//
// OLE Server Properties Proxy Class
// Server Object    : TListItem
// (This object is used by the IDE's Property Inspector to allow editing
//  of the properties of this server)
// *********************************************************************//
 TListItemProperties = class(TPersistent)
  private
    FServer:    TListItem;
    function    GetDefaultInterface: IListItem;
    constructor Create(AServer: TListItem);
  protected
    function  Get_Caption: WideString;
    procedure Set_Caption(const Value: WideString);
    function  Get_Index: Integer;
    function  Get_Checked: WordBool;
    procedure Set_Checked(Value: WordBool);
    function  Get_SubItems: IStrings;
    procedure Set_SubItems(const Value: IStrings);
  public
    property DefaultInterface: IListItem read GetDefaultInterface;
  published
    property Caption: WideString read Get_Caption write Set_Caption;
    property Checked: WordBool read Get_Checked write Set_Checked;
    property SubItems: IStrings read Get_SubItems write Set_SubItems;
  end;
{$ENDIF}


// *********************************************************************//
// The Class CoListItems provides a Create and CreateRemote method to          
// create instances of the default interface IListItems exposed by              
// the CoClass ListItems. The functions are intended to be used by             
// clients wishing to automate the CoClass objects exposed by the         
// server of this typelibrary.                                            
// *********************************************************************//
  CoListItems = class
    class function Create: IListItems;
    class function CreateRemote(const MachineName: string): IListItems;
  end;


// *********************************************************************//
// OLE Server Proxy class declaration
// Server Object    : TListItems
// Help String      : ListItems Object
// Default Interface: IListItems
// Def. Intf. DISP? : No
// Event   Interface: 
// TypeFlags        : (2) CanCreate
// *********************************************************************//
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  TListItemsProperties= class;
{$ENDIF}
  TListItems = class(TOleServer)
  private
    FIntf:        IListItems;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
    FProps:       TListItemsProperties;
    function      GetServerProperties: TListItemsProperties;
{$ENDIF}
    function      GetDefaultInterface: IListItems;
  protected
    procedure InitServerData; override;
    function  Get_Item(Index: Integer): IListItem;
    function  Get_Count: Integer;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure Connect; override;
    procedure ConnectTo(svrIntf: IListItems);
    procedure Disconnect; override;
    function  Add: IListItem;
    procedure Remove(Index: Integer);
    property  DefaultInterface: IListItems read GetDefaultInterface;
    property Item[Index: Integer]: IListItem read Get_Item; default;
    property Count: Integer read Get_Count;
  published
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
    property Server: TListItemsProperties read GetServerProperties;
{$ENDIF}
  end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
// *********************************************************************//
// OLE Server Properties Proxy Class
// Server Object    : TListItems
// (This object is used by the IDE's Property Inspector to allow editing
//  of the properties of this server)
// *********************************************************************//
 TListItemsProperties = class(TPersistent)
  private
    FServer:    TListItems;
    function    GetDefaultInterface: IListItems;
    constructor Create(AServer: TListItems);
  protected
    function  Get_Item(Index: Integer): IListItem;
    function  Get_Count: Integer;
  public
    property DefaultInterface: IListItems read GetDefaultInterface;
  published
  end;
{$ENDIF}


procedure Register;

implementation

uses ComObj;

procedure TListViewX.InitControlData;
const
  CEventDispIDs: array [0..4] of DWORD = (
    $00000003, $0000000B, $0000000D, $00000019, $0000001E);
  CTFontIDs: array [0..0] of DWORD = (
    $FFFFFE00);
  CControlData: TControlData2 = (
    ClassID: '{2C998C85-8899-11D2-9261-00104B700B61}';
    EventIID: '{2C998C83-8899-11D2-9261-00104B700B61}';
    EventCount: 5;
    EventDispIDs: @CEventDispIDs;
    LicenseKey: nil (*HR:$00000000*);
    Flags: $0000000D;
    Version: 401;
    FontCount: 1;
    FontIDs: @CTFontIDs);
begin
  ControlData := @CControlData;
  TControlData2(CControlData).FirstEventOfs := Cardinal(@@FOnClick) - Cardinal(Self);
end;

procedure TListViewX.CreateControl;

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

begin
  if FIntf = nil then DoCreate;
end;

function TListViewX.GetControlInterface: IListViewX;
begin
  CreateControl;
  Result := FIntf;
end;

function  TListViewX.Get_Items: IListItems;
begin
  Result := DefaultInterface.Get_Items;
end;

function  TListViewX.AlphaSort: WordBool;
begin
  Result := DefaultInterface.AlphaSort;
end;

procedure TListViewX.Arrange(Code: TxListArrangement);
begin
  DefaultInterface.Arrange(Code);