tntcomctrls.pas

TNTUniCtrlsWithExceptions UniCode 国际化语言

{*****************************************************************************}
{                                                                             }
{    Tnt Delphi Unicode Controls                                              }
{      http://www.tntware.com/delphicontrols/unicode/                         }
{        Version: 2.3.0                                                       }
{                                                                             }
{    Copyright (c) 2002-2007, Troy Wolbrink ([e-mail])       }
{                                                                             }
{*****************************************************************************}

unit TntComCtrls;

{$INCLUDE TntCompilers.inc}

interface

{ TODO: TTntCustomListView events - reintroduce ones that refer to ansi classes (ie. TListItem) }
{ TODO: Handle RichEdit CRLF emulation at the WndProc level. }
{ TODO: TTntCustomTreeView events - reintroduce ones that refer to ansi classes (ie. TTreeNode) }
{ TODO: THotKey, Tanimate, TCoolBar (TCoolBand) }
{ TODO: TToolBar: Unicode-enable TBN_GETBUTTONINFO/DoGetButton }
{ TODO: TToolBar: Unicode-enable handling of CN_DIALOGCHAR, WM_SYSCOMMAND, FindButtonFromAccel }

uses
  Classes, Controls, ListActns, Menus, ComCtrls, Messages,
  Windows, CommCtrl, Contnrs, TntControls, TntClasses, Graphics, TntSysUtils;

type
  TTntCustomListView = class;
  TTntListItems = class;

{TNT-WARN TListColumn}
  TTntListColumn = class(TListColumn{TNT-ALLOW TListColumn})
  private
    FCaption: WideString;
    procedure SetInheritedCaption(const Value: AnsiString);
    function GetCaption: WideString;
    procedure SetCaption(const Value: WideString);
  protected
    procedure DefineProperties(Filer: TFiler); override;
  public
    procedure Assign(Source: TPersistent); override;
  published
    property Caption: WideString read GetCaption write SetCaption;
  end;

{TNT-WARN TListColumns}
  TTntListColumns = class(TListColumns{TNT-ALLOW TListColumns})
  private
    function GetItem(Index: Integer): TTntListColumn;
    procedure SetItem(Index: Integer; Value: TTntListColumn);
  public
    constructor Create(AOwner: TTntCustomListView);
    function Add: TTntListColumn;
    function Owner: TTntCustomListView;
    property Items[Index: Integer]: TTntListColumn read GetItem write SetItem; default;
  end;

{TNT-WARN TListItem}
  TTntListItem = class(TListItem{TNT-ALLOW TListItem})
  private
    FCaption: WideString;
    FSubItems: TTntStrings;
    procedure SetInheritedCaption(const Value: AnsiString);
    function GetCaption: WideString;
    procedure SetCaption(const Value: WideString);
    procedure SetSubItems(const Value: TTntStrings);
    function GetListView: TTntCustomListView;
    function GetTntOwner: TTntListItems;
  public
    constructor Create(AOwner: TListItems{TNT-ALLOW TListItems}); virtual;
    destructor Destroy; override;
    property Owner: TTntListItems read GetTntOwner;
    property ListView: TTntCustomListView read GetListView;
    procedure Assign(Source: TPersistent); override;
    property Caption: WideString read GetCaption write SetCaption;
    property SubItems: TTntStrings read FSubItems write SetSubItems;
  end;

  TTntListItemsEnumerator = class
  private
    FIndex: Integer;
    FListItems: TTntListItems;
  public
    constructor Create(AListItems: TTntListItems);
    function GetCurrent: TTntListItem;
    function MoveNext: Boolean;
    property Current: TTntListItem read GetCurrent;
  end;

{TNT-WARN TListItems}
  TTntListItems = class(TListItems{TNT-ALLOW TListItems})
  private
    function GetItem(Index: Integer): TTntListItem;
    procedure SetItem(Index: Integer; const Value: TTntListItem);
  public
    function Owner: TTntCustomListView;
    property Item[Index: Integer]: TTntListItem read GetItem write SetItem; default;
    function Add: TTntListItem;
    function AddItem(Item: TTntListItem; Index: Integer = -1): TTntListItem;
    function GetEnumerator: TTntListItemsEnumerator;
    function Insert(Index: Integer): TTntListItem;
  end;

  TTntLVEditedEvent = procedure(Sender: TObject; Item: TTntListItem; var S: WideString) of object;
  TTntLVOwnerDataFindEvent = procedure(Sender: TObject; Find: TItemFind;
    const FindString: WideString; const FindPosition: TPoint; FindData: Pointer;
    StartIndex: Integer; Direction: TSearchDirection; Wrap: Boolean;
    var Index: Integer) of object;

{TNT-WARN TCustomListView}
  _TntInternalCustomListView = class(TCustomListView{TNT-ALLOW TCustomListView})
  private
    PWideFindString: PWideChar;
    CurrentDispInfo: PLVDispInfoW;
    OriginalDispInfoMask: Cardinal;
    function OwnerDataFindW(Find: TItemFind; const FindString: WideString;
      const FindPosition: TPoint; FindData: Pointer; StartIndex: Integer;
        Direction: TSearchDirection; Wrap: Boolean): Integer; virtual; abstract;
    function OwnerDataFetchW(Item: TListItem{TNT-ALLOW TListItem}; Request: TItemRequest): Boolean; virtual; abstract;
  protected
    function OwnerDataFind(Find: TItemFind; const FindString: AnsiString;
      const FindPosition: TPoint; FindData: Pointer; StartIndex: Integer;
        Direction: TSearchDirection; Wrap: Boolean): Integer; override;
    function OwnerDataFetch(Item: TListItem{TNT-ALLOW TListItem}; Request: TItemRequest): Boolean; override;
  end;

  TTntCustomListView = class(_TntInternalCustomListView, IWideCustomListControl)
  private
    FEditHandle: THandle;
    FEditInstance: Pointer;
    FDefEditProc: Pointer;
    FOnEdited: TTntLVEditedEvent;
    FOnDataFind: TTntLVOwnerDataFindEvent;
    procedure EditWndProcW(var Message: TMessage);
    procedure BeginChangingWideItem;
    procedure EndChangingWideItem;
    function GetHint: WideString;
    procedure SetHint(const Value: WideString);
    function IsHintStored: Boolean;
    function GetListColumns: TTntListColumns;
    procedure SetListColumns(const Value: TTntListColumns);
    function ColumnFromIndex(Index: Integer): TTntListColumn;
    function GetColumnFromTag(Tag: Integer): TTntListColumn;
    function OwnerDataFindW(Find: TItemFind; const FindString: WideString;
      const FindPosition: TPoint; FindData: Pointer; StartIndex: Integer;
        Direction: TSearchDirection; Wrap: Boolean): Integer; override;
    function OwnerDataFetchW(Item: TListItem{TNT-ALLOW TListItem}; Request: TItemRequest): Boolean; override;
    function GetDropTarget: TTntListItem;
    procedure SetDropTarget(const Value: TTntListItem);
    function GetItemFocused: TTntListItem;
    procedure SetItemFocused(const Value: TTntListItem);
    function GetSelected: TTntListItem;
    procedure SetSelected(const Value: TTntListItem);
    function GetTopItem: TTntListItem;
  private
    FSavedItems: TObjectList;
    FTestingForSortProc: Boolean;
    FChangingWideItemCount: Integer;
    FTempItem: TTntListItem;
    function AreItemsStored: Boolean;
    function GetItems: TTntListItems;
    procedure SetItems(Value: TTntListItems);
    procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
    function GetItemW(Value: TLVItemW): TTntListItem;
    procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY;
  protected
    procedure CreateWindowHandle(const Params: TCreateParams); override;
    procedure DefineProperties(Filer: TFiler); override;
    function GetActionLinkClass: TControlActionLinkClass; override;
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
    procedure CreateWnd; override;
    procedure DestroyWnd; override;
    procedure WndProc(var Message: TMessage); override;
    function OwnerDataFetch(Item: TListItem{TNT-ALLOW TListItem}; Request: TItemRequest): Boolean; reintroduce; virtual;
    function CreateListItem: TListItem{TNT-ALLOW TListItem}; override;
    function CreateListItems: TListItems{TNT-ALLOW TListItems}; override;
    property Items: TTntListItems read GetItems write SetItems stored AreItemsStored;
    procedure Edit(const Item: TLVItem); override;
    function OwnerDataFind(Find: TItemFind; const FindString: WideString;
      const FindPosition: TPoint; FindData: Pointer; StartIndex: Integer;
      Direction: TSearchDirection; Wrap: Boolean): Integer; reintroduce; virtual;
    property Columns: TTntListColumns read GetListColumns write SetListColumns;
    procedure DrawItem(Item: TListItem{TNT-ALLOW TListItem}; Rect: TRect; State: TOwnerDrawState); override;
    property OnEdited: TTntLVEditedEvent read FOnEdited write FOnEdited;
    property OnDataFind: TTntLVOwnerDataFindEvent read FOnDataFind write FOnDataFind;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Column[Index: Integer]: TTntListColumn read ColumnFromIndex;
    procedure CopySelection(Destination: TCustomListControl); override;
    procedure AddItem(const Item: WideString; AObject: TObject); reintroduce; virtual;
    function FindCaption(StartIndex: Integer; Value: WideString; Partial,
      Inclusive, Wrap: Boolean): TTntListItem;
    function GetSearchString: WideString;
    function StringWidth(S: WideString): Integer;
  public
    property DropTarget: TTntListItem read GetDropTarget write SetDropTarget;
    property ItemFocused: TTntListItem read GetItemFocused write SetItemFocused;
    property Selected: TTntListItem read GetSelected write SetSelected;
    property TopItem: TTntListItem read GetTopItem;
  published
    property Hint: WideString read GetHint write SetHint stored IsHintStored;
  end;

{TNT-WARN TListView}
  TTntListView = class(TTntCustomListView)
  published
    property Action;
    property Align;
    property AllocBy;
    property Anchors;
    property BevelEdges;
    property BevelInner;
    property BevelOuter;
    property BevelKind default bkNone;
    property BevelWidth;
    property BiDiMode;
    property BorderStyle;
    property BorderWidth;
    property Checkboxes;
    property Color;
    property Columns;
    property ColumnClick;
    property Constraints;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property FlatScrollBars;
    property FullDrag;
    property GridLines;
    property HideSelection;
    property HotTrack;
    property HotTrackStyles;
    property HoverTime;
    property IconOptions;
    property Items;
    property LargeImages;
    property MultiSelect;
    property OwnerData;
    property OwnerDraw;
    property ReadOnly default False;
    property RowSelect;
    property ParentBiDiMode;
    property ParentColor default False;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowColumnHeaders;
    property ShowWorkAreas;
    property ShowHint;
    property SmallImages;
    property SortType;
    property StateImages;
    property TabOrder;
    property TabStop default True;
    property ViewStyle;
    property Visible;
    property OnAdvancedCustomDraw;
    property OnAdvancedCustomDrawItem;
    property OnAdvancedCustomDrawSubItem;
    property OnChange;
    property OnChanging;
    property OnClick;
    property OnColumnClick;
    property OnColumnDragged;
    property OnColumnRightClick;
    property OnCompare;
    property OnContextPopup;
    property OnCustomDraw;
    property OnCustomDrawItem;
    property OnCustomDrawSubItem;
    property OnData;
    property OnDataFind;
    property OnDataHint;
    property OnDataStateChange;
    property OnDblClick;
    property OnDeletion;
    property OnDrawItem;
    property OnEdited;
    property OnEditing;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetImageIndex;
    property OnGetSubItemImage;
    property OnDragDrop;
    property OnDragOver;
    property OnInfoTip;
    property OnInsert;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    {$IFDEF COMPILER_9_UP}
    property OnMouseActivate;
    {$ENDIF}
    property OnMouseDown;
    {$IFDEF COMPILER_10_UP}
    property OnMouseEnter;
    property OnMouseLeave;
    {$ENDIF}
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnSelectItem;
    property OnStartDock;
    property OnStartDrag;
  end;

type
{TNT-WARN TToolButton}
  TTntToolButton = class(TToolButton{TNT-ALLOW TToolButton})
  private
    procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
    function GetCaption: TWideCaption;
    procedure SetCaption(const Value: TWideCaption);
    function IsCaptionStored: Boolean;
    function GetHint: WideString;
    procedure SetHint(const Value: WideString);
    function IsHintStored: Boolean;
    procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
    function GetMenuItem: TMenuItem{TNT-ALLOW TMenuItem};
    procedure SetMenuItem(const Value: TMenuItem{TNT-ALLOW TMenuItem});
  protected
    procedure DefineProperties(Filer: TFiler); override;
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
    function GetActionLinkClass: TControlActionLinkClass; override;
  published
    property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
    property Hint: WideString read GetHint write SetHint stored IsHintStored;
    property MenuItem: TMenuItem{TNT-ALLOW TMenuItem} read GetMenuItem write SetMenuItem;
  end;

type
{TNT-WARN TToolBar}
  TTntToolBar = class(TToolBar{TNT-ALLOW TToolBar})
  private
    FCaption: WideString;
    procedure TBInsertButtonA(var Message: TMessage); message TB_INSERTBUTTONA;
    procedure WMGetText(var Message: TWMGetText); message WM_GETTEXT;
    procedure WMGetTextLength(var Message: TWMGetTextLength); message WM_GETTEXTLENGTH;
    procedure WMSetText(var Message: TWMSetText); message WM_SETTEXT;
    function GetMenu: TMainMenu{TNT-ALLOW TMainMenu};
    procedure SetMenu(const Value: TMainMenu{TNT-ALLOW TMainMenu});
  private
    function GetCaption: WideString;
    function GetHint: WideString;
    function IsCaptionStored: Boolean;
    function IsHintStored: Boolean;
    procedure SetCaption(const Value: WideString);
    procedure SetHint(const Value: WideString);
  protected
    procedure CreateWindowHandle(const Params: TCreateParams); override;
    procedure DefineProperties(Filer: TFiler); override;
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
    function GetActionLinkClass: TControlActionLinkClass; override;
  published
    property Caption: WideString read GetCaption write SetCaption stored IsCaptionStored;
    property Hint: WideString read GetHint write SetHint stored IsHintStored;
    property Menu: TMainMenu{TNT-ALLOW TMainMenu} read GetMenu write SetMenu;
  end;

type
{TNT-WARN TCustomRichEdit}
  TTntCustomRichEdit = class(TCustomRichEdit{TNT-ALLOW TCustomRichEdit})
  private
    FRichEditStrings: TTntStrings;
    FPrintingTextLength: Integer;
    procedure WMGetTextLength(var Message: TWMGetTextLength); message WM_GETTEXTLENGTH;
    procedure SetRichEditStrings(const Value: TTntStrings);
    function GetWideSelText: WideString;
    function GetText: WideString;
    procedure SetWideSelText(const Value: WideString);
    procedure SetText(const Value: WideString);
    function GetHint: WideString;
    function IsHintStored: Boolean;
    procedure SetHint(const Value: WideString);
    procedure SetRTFText(Flags: DWORD; const Value: AnsiString);
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWindowHandle(const Params: TCreateParams); override;