{*****************************************************************************}
{ }
{ Tnt Delphi Unicode Controls }
{ http://www.tntware.com/delphicontrols/unicode/ }
{ Version: 2.3.0 }
{ }
{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
{ }
{*****************************************************************************}
unit TntStdCtrls;
{$INCLUDE TntCompilers.inc}
interface
{ TODO: Implement TCustomListBox.KeyPress, OnDataFind. }
uses
Windows, Messages, Classes, Controls, TntControls, StdCtrls, Graphics,
TntClasses, TntSysUtils;
{TNT-WARN TCustomEdit}
type
TTntCustomEdit = class(TCustomEdit{TNT-ALLOW TCustomEdit})
private
FPasswordChar: WideChar;
procedure SetSelText(const Value: WideString);
function GetText: WideString;
procedure SetText(const Value: WideString);
function GetHint: WideString;
procedure SetHint(const Value: WideString);
function IsHintStored: Boolean;
function GetPasswordChar: WideChar;
procedure SetPasswordChar(const Value: WideChar);
protected
procedure CreateWindowHandle(const Params: TCreateParams); override;
procedure CreateWnd; override;
procedure DefineProperties(Filer: TFiler); override;
function GetActionLinkClass: TControlActionLinkClass; override;
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
function GetSelStart: Integer; reintroduce; virtual;
procedure SetSelStart(const Value: Integer); reintroduce; virtual;
function GetSelLength: Integer; reintroduce; virtual;
procedure SetSelLength(const Value: Integer); reintroduce; virtual;
function GetSelText: WideString; reintroduce; virtual;
property PasswordChar: WideChar read GetPasswordChar write SetPasswordChar default #0;
public
property SelText: WideString read GetSelText write SetSelText;
property SelStart: Integer read GetSelStart write SetSelStart;
property SelLength: Integer read GetSelLength write SetSelLength;
property Text: WideString read GetText write SetText;
published
property Hint: WideString read GetHint write SetHint stored IsHintStored;
end;
{TNT-WARN TEdit}
TTntEdit = class(TTntCustomEdit)
published
property Align;
property Anchors;
property AutoSelect;
property AutoSize;
property BevelEdges;
property BevelInner;
property BevelKind default bkNone;
property BevelOuter;
property BevelWidth;
property BiDiMode;
property BorderStyle;
property CharCase;
property Color;
property Constraints;
property Ctl3D;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property HideSelection;
property ImeMode;
property ImeName;
property MaxLength;
property OEMConvert;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PasswordChar;
property PopupMenu;
property ReadOnly;
property ShowHint;
property TabOrder;
property TabStop;
property Text;
property Visible;
property OnChange;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
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 OnStartDock;
property OnStartDrag;
end;
type
TTntCustomMemo = class;
TTntMemoStrings = class(TTntStrings)
protected
FMemo: TCustomMemo{TNT-ALLOW TCustomMemo};
FMemoLines: TStrings{TNT-ALLOW TStrings};
FRichEditMode: Boolean;
FLineBreakStyle: TTntTextLineBreakStyle;
function Get(Index: Integer): WideString; override;
function GetCount: Integer; override;
function GetTextStr: WideString; override;
procedure Put(Index: Integer; const S: WideString); override;
procedure SetUpdateState(Updating: Boolean); override;
public
constructor Create;
procedure SetTextStr(const Value: WideString); override;
procedure Clear; override;
procedure Delete(Index: Integer); override;
procedure Insert(Index: Integer; const S: WideString); override;
end;
{TNT-WARN TCustomMemo}
TTntCustomMemo = class(TCustomMemo{TNT-ALLOW TCustomMemo})
private
FLines: TTntStrings;
procedure SetSelText(const Value: WideString);
function GetText: WideString;
procedure SetText(const Value: WideString);
function GetHint: WideString;
procedure SetHint(const Value: WideString);
function IsHintStored: Boolean;
protected
procedure CreateWindowHandle(const Params: TCreateParams); override;
procedure DefineProperties(Filer: TFiler); override;
function GetActionLinkClass: TControlActionLinkClass; override;
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
procedure SetLines(const Value: TTntStrings); virtual;
function GetSelStart: Integer; reintroduce; virtual;
procedure SetSelStart(const Value: Integer); reintroduce; virtual;
function GetSelLength: Integer; reintroduce; virtual;
procedure SetSelLength(const Value: Integer); reintroduce; virtual;
function GetSelText: WideString; reintroduce;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property SelText: WideString read GetSelText write SetSelText;
property SelStart: Integer read GetSelStart write SetSelStart;
property SelLength: Integer read GetSelLength write SetSelLength;
property Text: WideString read GetText write SetText;
property Lines: TTntStrings read FLines write SetLines;
published
property Hint: WideString read GetHint write SetHint stored IsHintStored;
end;
{TNT-WARN TMemo}
TTntMemo = class(TTntCustomMemo)
published
property Align;
property Alignment;
property Anchors;
property BevelEdges;
property BevelInner;
property BevelKind default bkNone;
property BevelOuter;
property BiDiMode;
property BorderStyle;
property Color;
property Constraints;
property Ctl3D;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property HideSelection;
property ImeMode;
property ImeName;
property Lines;
property MaxLength;
property OEMConvert;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly;
property ScrollBars;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property WantReturns;
property WantTabs;
property WordWrap;
property OnChange;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
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 OnStartDock;
property OnStartDrag;
end;
TTntComboBoxStrings = class(TTntStrings)
protected
function Get(Index: Integer): WideString; override;
function GetCount: Integer; override;
function GetObject(Index: Integer): TObject; override;
procedure PutObject(Index: Integer; AObject: TObject); override;
procedure SetUpdateState(Updating: Boolean); override;
public
ComboBox: TCustomComboBox{TNT-ALLOW TCustomComboBox};
function Add(const S: WideString): Integer; override;
procedure Clear; override;
procedure Delete(Index: Integer); override;
function IndexOf(const S: WideString): Integer; override;
procedure Insert(Index: Integer; const S: WideString); override;
end;
type
TWMCharMsgHandler = procedure(var Message: TWMChar) of object;
{$IFDEF DELPHI_7} // fix for Delphi 7 only
{ TD7PatchedComboBoxStrings }
type
TD7PatchedComboBoxStrings = class(TCustomComboBoxStrings)
protected
function Get(Index: Integer): string{TNT-ALLOW string}; override;
public
function Add(const S: string{TNT-ALLOW string}): Integer; override;
procedure Insert(Index: Integer; const S: string{TNT-ALLOW string}); override;
end;
{$ENDIF}
type
ITntComboFindString = interface
['{63BEBEF4-B1A2-495A-B558-7487B66F6827}']
function FindString(const Value: WideString; StartPos: Integer): Integer;
end;
{TNT-WARN TCustomComboBox}
type
TTntCustomComboBox = class(TCustomComboBox{TNT-ALLOW TCustomComboBox},
IWideCustomListControl)
private
FItems: TTntStrings;
FSaveItems: TTntStrings;
FSaveItemIndex: Integer;
FFilter: WideString;
FLastTime: Cardinal;
function GetItems: TTntStrings;
function GetSelStart: Integer;
procedure SetSelStart(const Value: Integer);
function GetSelLength: Integer;
procedure SetSelLength(const Value: Integer);
function GetSelText: WideString;
procedure SetSelText(const Value: WideString);
function GetText: WideString;
procedure SetText(const Value: WideString);
procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
function GetHint: WideString;
procedure SetHint(const Value: WideString);
function IsHintStored: Boolean;
procedure WMChar(var Message: TWMChar); message WM_CHAR;
protected
procedure CreateWindowHandle(const Params: TCreateParams); override;
procedure DefineProperties(Filer: TFiler); override;
function GetActionLinkClass: TControlActionLinkClass; override;
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
procedure DestroyWnd; override;
function GetAutoComplete_UniqueMatchOnly: Boolean; dynamic;
function GetAutoComplete_PreserveDataEntryCase: Boolean; dynamic;
procedure DoEditCharMsg(var Message: TWMChar); virtual;
procedure CreateWnd; override;
procedure ComboWndProc(var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer); override;
procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
procedure KeyPress(var Key: AnsiChar); override;
{$IFDEF DELPHI_7} // fix for Delphi 7 only
function GetItemsClass: TCustomComboBoxStringsClass; override;
{$ENDIF}
procedure SetItems(const Value: TTntStrings); reintroduce; virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure CopySelection(Destination: TCustomListControl); override;
procedure AddItem(const Item: WideString; AObject: TObject); reintroduce; virtual;
public
property SelText: WideString read GetSelText write SetSelText;
property SelStart: Integer read GetSelStart write SetSelStart;
property SelLength: Integer read GetSelLength write SetSelLength;
property Text: WideString read GetText write SetText;
property Items: TTntStrings read GetItems write SetItems;
published
property Hint: WideString read GetHint write SetHint stored IsHintStored;
end;
{TNT-WARN TComboBox}
TTntComboBox = class(TTntCustomComboBox)
published
property Align;
property AutoComplete default True;
{$IFDEF COMPILER_9_UP}
property AutoCompleteDelay default 500;
{$ENDIF}
property AutoDropDown default False;
{$IFDEF COMPILER_7_UP}
property AutoCloseUp default False;
{$ENDIF}
property BevelEdges;
property BevelInner;
property BevelKind default bkNone;
property BevelOuter;
property Style; {Must be published before Items}
property Anchors;
property BiDiMode;
property CharCase;
property Color;
property Constraints;
property Ctl3D;
property DragCursor;
property DragKind;
property DragMode;
property DropDownCount;
property Enabled;
property Font;
property ImeMode;
property ImeName;
property ItemHeight;
property ItemIndex default -1;
property MaxLength;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Sorted;
property TabOrder;
property TabStop;
property Text;
property Visible;
property OnChange;
property OnClick;
property OnCloseUp;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDrawItem;
property OnDropDown;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMeasureItem;
{$IFDEF COMPILER_10_UP}
property OnMouseEnter;
property OnMouseLeave;
{$ENDIF}
property OnSelect;
property OnStartDock;
property OnStartDrag;
property Items; { Must be published after OnMeasureItem }
end;
TLBGetWideDataEvent = procedure(Control: TWinControl; Index: Integer;
var Data: WideString) of object;
TAccessCustomListBox = class(TCustomListBox{TNT-ALLOW TCustomListBox});
TTntListBoxStrings = class(TTntStrings)
private
FListBox: TAccessCustomListBox;
function GetListBox: TCustomListBox{TNT-ALLOW TCustomListBox};
procedure SetListBox(const Value: TCustomListBox{TNT-ALLOW TCustomListBox});
protected
procedure Put(Index: Integer; const S: WideString); override;
function Get(Index: Integer): WideString; override;
function GetCount: Integer; override;
function GetObject(Index: Integer): TObject; override;
procedure PutObject(Index: Integer; AObject: TObject); override;
procedure SetUpdateState(Updating: Boolean); override;
public
function Add(const S: WideString): Integer; override;
procedure Clear; override;
procedure Delete(Index: Integer); override;
procedure Exchange(Index1, Index2: Integer); override;
function IndexOf(const S: WideString): Integer; override;
procedure Insert(Index: Integer; const S: WideString); override;
procedure Move(CurIndex, NewIndex: Integer); override;
property ListBox: TCustomListBox{TNT-ALLOW TCustomListBox} read GetListBox write SetListBox;
end;
{TNT-WARN TCustomListBox}
type
TTntCustomListBox = class(TCustomListBox{TNT-ALLOW TCustomListBox}, IWideCustomListControl)
private
FItems: TTntStrings;
FSaveItems: TTntStrings;
FSaveTopIndex: Integer;
FSaveItemIndex: Integer;
FOnData: TLBGetWideDataEvent;
procedure SetItems(const Value: TTntStrings);
function GetHint: WideString;
procedure SetHint(const Value: WideString);
function IsHintStored: Boolean;
procedure LBGetText(var Message: TMessage); message LB_GETTEXT;
procedure LBGetTextLen(var Message: TMessage); message LB_GETTEXTLEN;
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 DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
property OnData: TLBGetWideDataEvent read FOnData write FOnData;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure CopySelection(Destination: TCustomListControl); override;
procedure AddItem(const Item: WideString; AObject: TObject); reintroduce; virtual;
property Items: TTntStrings read FItems write SetItems;
published
property Hint: WideString read GetHint write SetHint stored IsHintStored;
end;
{TNT-WARN TListBox}
TTntListBox = class(TTntCustomListBox)
published
property Style;
property AutoComplete;
{$IFDEF COMPILER_9_UP}
property AutoCompleteDelay;
{$ENDIF}
property Align;
property Anchors;
property BevelEdges;
property BevelInner;
property BevelKind default bkNone;
property BevelOuter;
property BevelWidth;
property BiDiMode;
property BorderStyle;
property Color;
property Columns;
property Constraints;
property Ctl3D;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property ExtendedSelect;
property Font;
property ImeMode;
property ImeName;
property IntegralHeight;
property ItemHeight;
property Items;
property MultiSelect;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ScrollWidth;
property ShowHint;
property Sorted;
property TabOrder;
property TabStop;
property TabWidth;
property Visible;
property OnClick;
property OnContextPopup;
property OnData;
property OnDataFind;
property OnDataObject;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDrawItem;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMeasureItem;
{$IFDEF COMPILER_9_UP}
property OnMouseActivate;
{$ENDIF}
property OnMouseDown;
{$IFDEF COMPILER_10_UP}
property OnMouseEnter;
property OnMouseLeave;
{$ENDIF}
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;
{TNT-WARN TCustomLabel}
TTntCustomLabel = class(TCustomLabel{TNT-ALLOW TCustomLabel})
private
function GetCaption: TWideCaption;
procedure SetCaption(const Value: TWideCaption);
function GetHint: WideString;
procedure SetHint(const Value: WideString);
function IsCaptionStored: Boolean;
function IsHintStored: Boolean;
procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
protected
procedure DefineProperties(Filer: TFiler); override;
function GetActionLinkClass: TControlActionLinkClass; override;
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
function GetLabelText: WideString; reintroduce; virtual;
procedure DoDrawText(var Rect: TRect; Flags: Longint); override;
property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
published
property Hint: WideString read GetHint write SetHint stored IsHintStored;
end;
{TNT-WARN TLabel}
TTntLabel = class(TTntCustomLabel)
published
property Align;
property Alignment;
property Anchors;
property AutoSize;
property BiDiMode;
property Caption;
property Color {$IFDEF COMPILER_7_UP} nodefault {$ENDIF};
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
{$IFDEF COMPILER_9_UP}
property EllipsisPosition;
{$ENDIF}
property Enabled;
property FocusControl;
property Font;
property ParentBiDiMode;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowAccelChar;
property ShowHint;
property Transparent;
property Layout;
property Visible;
property WordWrap;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
{$IFDEF COMPILER_9_UP}
property OnMouseActivate;
{$ENDIF}
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnMouseEnter;
property OnMouseLeave;
property OnStartDock;
property OnStartDrag;
end;
{TNT-WARN TButton}
TTntButton = class(TButton{TNT-ALLOW TButton})
private
function GetCaption: TWideCaption;
procedure SetCaption(const Value: TWideCaption);
function GetHint: WideString;
procedure SetHint(const Value: WideString);
function IsCaptionStored: Boolean;
function IsHintStored: Boolean;
procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
protected
procedure CreateWindowHandle(const Params: TCreateParams); override;
procedure DefineProperties(Filer: TFiler); override;
function GetActionLinkClass: TControlActionLinkClass; override;
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
published
property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
property Hint: WideString read GetHint write SetHint stored IsHintStored;
end;
{TNT-WARN TCustomCheckBox}
TTntCustomCheckBox = class(TCustomCheckBox{TNT-ALLOW TCustomCheckBox})
private
function GetCaption: TWideCaption;
procedure SetCaption(const Value: TWideCaption);
function GetHint: WideString;
procedure SetHint(const Value: WideString);
function IsCaptionStored: Boolean;
function IsHintStored: Boolean;
procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
protected
procedure CreateWindowHandle(const Params: TCreateParams); override;
procedure DefineProperties(Filer: TFiler); override;
function GetActionLinkClass: TControlActionLinkClass; override;
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
public
property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
published
property Hint: WideString read GetHint write SetHint stored IsHintStored;
end;
{TNT-WARN TCheckBox}
TTntCheckBox = class(TTntCustomCheckBox)
published
property Action;
property Align;
property Alignment;
property AllowGrayed;
property Anchors;
property BiDiMode;
property Caption;
property Checked;
property Color {$IFDEF COMPILER_7_UP} nodefault {$ENDIF};
property Constraints;
property Ctl3D;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property State;
property TabOrder;
property TabStop;
property Visible;
{$IFDEF COMPILER_7_UP}
property WordWrap;
{$ENDIF}
property OnClick;
property OnContextPopup;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
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 OnStartDock;
property OnStartDrag;
end;
{TNT-WARN TRadioButton}
TTntRadioButton = class(TRadioButton{TNT-ALLOW TRadioButton})
private
function GetCaption: TWideCaption;
procedure SetCaption(const Value: TWideCaption);
function GetHint: WideString;
procedure SetHint(const Value: WideString);
function IsCaptionStored: Boolean;
function IsHintStored: Boolean;
procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
protected
procedure CreateWindowHandle(const Params: TCreateParams); override;
procedure DefineProperties(Filer: TFiler); override;
function GetActionLinkClass: TControlActionLinkClass; override;
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
published
property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
property Hint: WideString read GetHint write SetHint stored IsHintStored;
end;
{TNT-WARN TScrollBar}
TTntScrollBar = class(TScrollBar{TNT-ALLOW TScrollBar})
private
function GetHint: WideString;
procedure SetHint(const Value: WideString);
function IsHintStored: Boolean;
protected
procedure CreateWindowHandle(const Params: TCreateParams); override;
procedure DefineProperties(Filer: TFiler); override;
function GetActionLinkClass: TControlActionLinkClass; override;
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
published
property Hint: WideString read GetHint write SetHint stored IsHintStored;
end;
{TNT-WARN TCustomGroupBox}
TTntCustomGroupBox = class(TCustomGroupBox{TNT-ALLOW TCustomGroupBox})
private
function GetCaption: TWideCaption;
procedure SetCaption(const Value: TWideCaption);
function GetHint: WideString;
procedure SetHint(const Value: WideString);
function IsCaptionStored: Boolean;
function IsHintStored: Boolean;
procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
protected
procedure Paint; override;
procedure CreateWindowHandle(const Params: TCreateParams); override;
procedure DefineProperties(Filer: TFiler); override;
function GetActionLinkClass: TControlActionLinkClass; override;
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
published
property Hint: WideString read GetHint write SetHint stored IsHintStored;
end;
{TNT-WARN TGroupBox}
TTntGroupBox = class(TTntCustomGroupBox)
published
property Align;
property Anchors;
property BiDiMode;
property Caption;
property Color;
property Constraints;
property Ctl3D;
property DockSite;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
{$IFDEF COMPILER_10_UP}
property Padding;
{$ENDIF}
{$IFDEF COMPILER_7_UP}
property ParentBackground default True;
{$ENDIF}
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
{$IFDEF COMPILER_9_UP}
property OnAlignInsertBefore;
property OnAlignPosition;
{$ENDIF}
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDockDrop;
property OnDockOver;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGetSiteInfo;
{$IFDEF COMPILER_9_UP}
property OnMouseActivate;
{$ENDIF}
property OnMouseDown;
{$IFDEF COMPILER_10_UP}
property OnMouseEnter;
property OnMouseLeave;
{$ENDIF}
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
property OnUnDock;
end;
{TNT-WARN TCustomStaticText}
TTntCustomStaticText = class(TCustomStaticText{TNT-ALLOW TCustomStaticText})
private
procedure AdjustBounds;
function GetCaption: TWideCaption;
procedure SetCaption(const Value: TWideCaption);
function GetHint: WideString;
procedure SetHint(const Value: WideString);
function IsCaptionStored: Boolean;
function IsHintStored: Boolean;
procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
protected
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
procedure Loaded; override;
procedure SetAutoSize(AValue: boolean); override;
procedure CreateWindowHandle(const Params: TCreateParams); override;
procedure DefineProperties(Filer: TFiler); override;
function GetActionLinkClass: TControlActionLinkClass; override;
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
public
constructor Create(AOwner: TComponent); override;
published
property Hint: WideString read GetHint write SetHint stored IsHintStored;
end;
{TNT-WARN TStaticText}
TTntStaticText = class(TTntCustomStaticText)
published
property Align;
property Alignment;
property Anchors;
property AutoSize;
property BevelEdges;
property BevelInner;
property BevelKind default bkNone;
property BevelOuter;
property BiDiMode;
property BorderStyle;
property Caption;
property Color {$IFDEF COMPILER_7_UP} nodefault {$ENDIF};
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property FocusControl;
property Font;
property ParentBiDiMode;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowAccelChar;
property ShowHint;
property TabOrder;
property TabStop;
{$IFDEF COMPILER_7_UP}
property Transparent;
{$ENDIF}
property Visible;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
{$IFDEF COMPILER_9_UP}
property OnMouseActivate;
{$ENDIF}
property OnMouseDown;
{$IFDEF COMPILER_10_UP}
property OnMouseEnter;
property OnMouseLeave;
{$ENDIF}
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;
procedure TntCombo_AfterInherited_CreateWnd(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
Items: TTntStrings; var FSaveItems: TTntStrings; FSaveItemIndex: integer; PreInheritedAnsiText: AnsiString);
procedure TntCombo_BeforeInherited_DestroyWnd(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
Items: TTntStrings; var FSaveItems: TTntStrings; ItemIndex: integer; var FSaveItemIndex: integer;
var SavedText: WideString);
function TntCombo_ComboWndProc(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer; DoEditCharMsg: TWMCharMsgHandler): Boolean;
function TntCombo_CNCommand(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; Items: TTntStrings; var Message: TWMCommand): Boolean;
function TntCombo_GetSelStart(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}): Integer;
procedure TntCombo_SetSelStart(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; const Value: Integer);
function TntCombo_GetSelLength(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}): Integer;
procedure TntCombo_SetSelLength(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; const Value: Integer);
function TntCombo_GetSelText(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}): WideString;
procedure TntCombo_SetSelText(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; const Value: WideString);
procedure TntCombo_BeforeKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; var SaveAutoComplete: Boolean);
procedure TntCombo_AfterKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; var SaveAutoComplete: Boolean);
procedure TntCombo_DropDown_PreserveSelection(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox});
procedure TntComboBox_AddItem(Items: TTntStrings; const Item: WideString; AObject: TObject);
procedure TntComboBox_CopySelection(Items: TTntStrings; ItemIndex: Integer;
Destination: TCustomListControl);
procedure TntCombo_AutoSearchKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
Items: TTntStrings; var Message: TWMChar; var FFilter: WideString; var FLastTime: Cardinal);
procedure TntCombo_AutoCompleteKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
Items: TTntStrings; var Message: TWMChar;
AutoComplete_UniqueMatchOnly, AutoComplete_PreserveDataEntryCase: Boolean);
procedure TntCombo_DefaultDrawItem(Canvas: TCanvas; Index: Integer; Rect: TRect;
State: TOwnerDrawState; Items: TTntStrings);
procedure TntCustomEdit_CreateWindowHandle(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Params: TCreateParams);
procedure TntCustomEdit_AfterInherited_CreateWnd(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; var FPasswordChar: WideChar);
function TntCustomEdit_GetSelStart(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}): Integer;
procedure TntCustomEdit_SetSelStart(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Value: Integer);
function TntCustomEdit_GetSelLength(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}): Integer;
procedure TntCustomEdit_SetSelLength(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Value: Integer);
function TntCustomEdit_GetSelText(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}): WideString;
procedure TntCustomEdit_SetSelText(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Value: WideString);
function TntCustomEdit_GetPasswordChar(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; var FPasswordChar: WideChar): WideChar;
procedure TntCustomEdit_SetPasswordChar(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; var FPasswordChar: WideChar; const Value: WideChar);
function TntMemo_LineStart(Handle: THandle; Index: Integer): Integer;
function TntMemo_LineLength(Handle: THandle; Index: Integer; StartPos: Integer = -1): Integer;
procedure TntListBox_AfterInherited_CreateWnd(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox};
var FSaveItems: TTntStrings; FItems: TTntStrings; FSaveTopIndex, FSaveItemIndex: Integer);
procedure TntListBox_BeforeInherited_DestroyWnd(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox};
var FSaveItems: TTntStrings; const FItems: TTntStrings; var FSaveTopIndex, FSaveItemIndex: Integer);
procedure TntListBox_DrawItem_Text(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox}; Items: TTntStrings; Index: Integer; Rect: TRect);
procedure TntListBox_AddItem(Items: TTntStrings; const Item: WideString; AObject: TObject);
procedure TntListBox_CopySelection(ListBox: TCustomListbox{TNT-ALLOW TCustomListbox};
Items: TTntStrings; Destination: TCustomListControl);
function TntCustomListBox_LBGetText(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox}; OnData: TLBGetWideDataEvent; var Message: TMessage): Boolean;
function TntCustomListBox_LBGetTextLen(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox}; OnData: TLBGetWideDataEvent; var Message: TMessage): Boolean;
function TntLabel_DoDrawText(Control: TCustomLabel{TNT-ALLOW TCustomLabel}; var Rect: TRect; Flags: Integer; const GetLabelText: WideString): Boolean;
procedure TntLabel_CMDialogChar(Control: TCustomLabel{TNT-ALLOW TCustomLabel}; var Message: TCMDialogChar; const Caption: WideString);
procedure TntButton_CMDialogChar(Button: TButton{TNT-ALLOW TButton}; var Message: TCMDialogChar);
implementation
uses
Forms, SysUtils, Consts, RichEdit, ComStrs,
RTLConsts, {$IFDEF THEME_7_UP} Themes, {$ENDIF}
TntForms, TntGraphics, TntActnList, TntWindows,
{$IFDEF COMPILER_9_UP} WideStrUtils, {$ENDIF} TntWideStrUtils;
{ TTntCustomEdit }
procedure TntCustomEdit_CreateWindowHandle(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Params: TCreateParams);
var
P: TCreateParams;
begin
if SysLocale.FarEast
and (not Win32PlatformIsUnicode)
and ((Params.Style and ES_READONLY) <> 0) then begin
// Work around Far East Win95 API/IME bug.
P := Params;
P.Style := P.Style and (not ES_READONLY);
CreateUnicodeHandle(Edit, P, 'EDIT');
if Edit.HandleAllocated then
SendMessage(Edit.Handle, EM_SETREADONLY, Ord(True), 0);
end else
CreateUnicodeHandle(Edit, Params, 'EDIT');
end;
procedure TntCustomEdit_AfterInherited_CreateWnd(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; var FPasswordChar: WideChar);
var
PasswordChar: WideChar;
begin
PasswordChar := TntCustomEdit_GetPasswordChar(Edit, FPasswordChar);
if Win32PlatformIsUnicode then
SendMessageW(Edit.Handle, EM_SETPASSWORDCHAR, Ord(PasswordChar), 0);
end;
function TntCustomEdit_GetSelStart(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}): Integer;
begin
if Win32PlatformIsUnicode then
Result := Edit.SelStart
else
Result := Length(WideString(Copy(Edit.Text, 1, Edit.SelStart)));
end;
procedure TntCustomEdit_SetSelStart(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Value: Integer);
begin
if Win32PlatformIsUnicode then
Edit.SelStart := Value
else
Edit.SelStart := Length(AnsiString(Copy(TntControl_GetText(Edit), 1, Value)));
end;
function TntCustomEdit_GetSelLength(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}): Integer;
begin
if Win32PlatformIsUnicode then
Result := Edit.SelLength
else
Result := Length(TntCustomEdit_GetSelText(Edit));
end;
procedure TntCustomEdit_SetSelLength(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Value: Integer);
var
StartPos: Integer;
begin
if Win32PlatformIsUnicode then
Edit.SelLength := Value
else begin
StartPos := TntCustomEdit_GetSelStart(Edit);
Edit.SelLength := Length(AnsiString(Copy(TntControl_GetText(Edit), StartPos + 1, Value)));
end;
end;
function TntCustomEdit_GetSelText(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}): WideString;
begin
if Win32PlatformIsUnicode then
Result := Copy(TntControl_GetText(Edit), Edit.SelStart + 1, Edit.SelLength)
else
Result := Edit.SelText
end;
procedure TntCustomEdit_SetSelText(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Value: WideString);
begin
if Win32PlatformIsUnicode then
SendMessageW(Edit.Handle, EM_REPLACESEL, 0, Longint(PWideChar(Value)))
else
Edit.SelText := Value;
end;
function WideCharToAnsiChar(const C: WideChar): AnsiChar;
begin
if C <= High(AnsiChar) then
Result := AnsiChar(C)
else
Result := '*';
end;
type TAccessCustomEdit = class(TCustomEdit{TNT-ALLOW TCustomEdit});
function TntCustomEdit_GetPasswordChar(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; var FPasswordChar: WideChar): WideChar;
begin
if TAccessCustomEdit(Edit).PasswordChar <> WideCharToAnsiChar(FPasswordChar) then
FPasswordChar := WideChar(TAccessCustomEdit(Edit).PasswordChar);
Result := FPasswordChar;
end;
procedure TntCustomEdit_SetPasswordChar(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; var FPasswordChar: WideChar; const Value: WideChar);
var
SaveWindowHandle: Integer;
PasswordCharSetHere: Boolean;
begin
if TntCustomEdit_GetPasswordChar(Edit, FPasswordChar) <> Value then
begin
FPasswordChar := Value;
PasswordCharSetHere := Win32PlatformIsUnicode and Edit.HandleAllocated;
SaveWindowHandle := TAccessCustomEdit(Edit).WindowHandle;
try
if PasswordCharSetHere then
TAccessCustomEdit(Edit).WindowHandle := 0; // this prevents TCustomEdit from actually changing it
TAccessCustomEdit(Edit).PasswordChar := WideCharToAnsiChar(FPasswordChar);
finally
TAccessCustomEdit(Edit).WindowHandle := SaveWindowHandle;
end;
if PasswordCharSetHere then
begin
Assert(Win32PlatformIsUnicode);
Assert(Edit.HandleAllocated);
SendMessageW(Edit.Handle, EM_SETPASSWORDCHAR, Ord(FPasswordChar), 0);
Edit.Invalidate;
end;
end;
end;
procedure TTntCustomEdit.CreateWindowHandle(const Params: TCreateParams);
begin
TntCustomEdit_CreateWindowHandle(Self, Params);
end;
procedure TTntCustomEdit.CreateWnd;
begin
inherited;
TntCustomEdit_AfterInherited_CreateWnd(Self, FPasswordChar);
end;
procedure TTntCustomEdit.DefineProperties(Filer: TFiler);
begin
inherited;
TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntCustomEdit.GetSelStart: Integer;
begin
Result := TntCustomEdit_GetSelStart(Self);
end;
procedure TTntCustomEdit.SetSelStart(const Value: Integer);
begin
TntCustomEdit_SetSelStart(Self, Value);
end;
function TTntCustomEdit.GetSelLength: Integer;
begin
Result := TntCustomEdit_GetSelLength(Self);
end;
procedure TTntCustomEdit.SetSelLength(const Value: Integer);
begin
TntCustomEdit_SetSelLength(Self, Value);
end;
function TTntCustomEdit.GetSelText: WideString;
begin
Result := TntCustomEdit_GetSelText(Self);
end;
procedure TTntCustomEdit.SetSelText(const Value: WideString);
begin
TntCustomEdit_SetSelText(Self, Value);
end;
function TTntCustomEdit.GetPasswordChar: WideChar;
begin
Result := TntCustomEdit_GetPasswordChar(Self, FPasswordChar);
end;
procedure TTntCustomEdit.SetPasswordChar(const Value: WideChar);
begin
TntCustomEdit_SetPasswordChar(Self, FPasswordChar, Value);
end;
function TTntCustomEdit.GetText: WideString;
begin
Result := TntControl_GetText(Self);
end;
procedure TTntCustomEdit.SetText(const Value: WideString);
begin
TntControl_SetText(Self, Value);
end;
function TTntCustomEdit.IsHintStored: Boolean;
begin
Result := TntControl_IsHintStored(Self);
end;
function TTntCustomEdit.GetHint: WideString;
begin
Result := TntControl_GetHint(Self)
end;
procedure TTntCustomEdit.SetHint(const Value: WideString);
begin
TntControl_SetHint(Self, Value);
end;
procedure TTntCustomEdit.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
inherited;
end;
function TTntCustomEdit.GetActionLinkClass: TControlActionLinkClass;
begin
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;
{ TTntMemoStrings }
constructor TTntMemoStrings.Create;
begin
inherited;
FLineBreakStyle := tlbsCRLF;
end;
function TTntMemoStrings.GetCount: Integer;
begin
Result := FMemoLines.Count;
end;
function TntMemo_LineStart(Handle: THandle; Index: Integer): Integer;
begin
Assert(Win32PlatformIsUnicode);
Result := SendMessageW(Handle, EM_LINEINDEX, Index, 0);
end;
function TntMemo_LineLength(Handle: THandle; Index: Integer; StartPos: Integer = -1): Integer;
begin
Assert(Win32PlatformIsUnicode);
if StartPos = -1 then
StartPos := TntMemo_LineStart(Handle, Index);
if StartPos < 0 then
Result := 0
else
Result := SendMessageW(Handle, EM_LINELENGTH, StartPos, 0);
end;
function TTntMemoStrings.Get(Index: Integer): WideString;
var
Len: Integer;
begin
if (not IsWindowUnicode(FMemo.Handle)) then
Result := FMemoLines[Index]
else begin
SetLength(Result, TntMemo_LineLength(FMemo.Handle, Index));
if Length(Result) > 0 then begin
if Length(Result) > High(Word) then
raise EOutOfResources.Create(SOutlineLongLine);
Word((PWideChar(Result))^) := Length(Result);
Len := SendMessageW(FMemo.Handle, EM_GETLINE, Index, Longint(PWideChar(Result)));
SetLength(Result, Len);
end;
end;
end;
procedure TTntMemoStrings.Put(Index: Integer; const S: WideString);
var
StartPos: Integer;
begin
if (not IsWindowUnicode(FMemo.Handle)) then
FMemoLines[Index] := S
else begin
StartPos := TntMemo_LineStart(FMemo.Handle, Index);
if StartPos >= 0 then
begin
SendMessageW(FMemo.Handle, EM_SETSEL, StartPos, StartPos + TntMemo_LineLength(FMemo.Handle, Index));
SendMessageW(FMemo.Handle, EM_REPLACESEL, 0, Longint(PWideChar(S)));
end;
end;
end;
procedure TTntMemoStrings.Insert(Index: Integer; const S: Widestring);
function RichEditSelStartW: Integer;
var
CharRange: TCharRange;
begin
SendMessageW(FMemo.Handle, EM_EXGETSEL, 0, Longint(@CharRange));
Result := CharRange.cpMin;
end;
var
StartPos, LineLen: Integer;
Line: WideString;
begin
if (not IsWindowUnicode(FMemo.Handle)) then
FMemoLines.Insert(Index, S)
else begin
if Index >= 0 then
begin
StartPos := TntMemo_LineStart(FMemo.Handle, Index);
if StartPos >= 0 then
Line := S + CRLF
else begin
StartPos := TntMemo_LineStart(FMemo.Handle, Index - 1);
LineLen := TntMemo_LineLength(FMemo.Handle, Index - 1);
if LineLen = 0 then
Exit;
Inc(StartPos, LineLen);
Line := CRLF + s;
end;
SendMessageW(FMemo.Handle, EM_SETSEL, StartPos, StartPos);
if (FRichEditMode)
and (FLineBreakStyle <> tlbsCRLF) then begin
Line := TntAdjustLineBreaks(Line, FLineBreakStyle);
if Line = CR then
Line := CRLF; { This helps a ReadOnly RichEdit 4.1 control to insert a blank line. }
SendMessageW(FMemo.Handle, EM_REPLACESEL, 0, Longint(PWideChar(Line)));
if Line = CRLF then
Line := CR;
end else
SendMessageW(FMemo.Handle, EM_REPLACESEL, 0, Longint(PWideChar(Line)));
if (FRichEditMode)
and (RichEditSelStartW <> (StartPos + Length(Line))) then
raise EOutOfResources.Create(sRichEditInsertError);
end;
end;
end;
procedure TTntMemoStrings.Delete(Index: Integer);
begin
FMemoLines.Delete(Index);
end;
procedure TTntMemoStrings.Clear;
begin
FMemoLines.Clear;
end;
type TAccessStrings = class(TStrings{TNT-ALLOW TStrings});
procedure TTntMemoStrings.SetUpdateState(Updating: Boolean);
begin
TAccessStrings(FMemoLines).SetUpdateState(Updating);
end;
function TTntMemoStrings.GetTextStr: WideString;
begin
if (not FRichEditMode) then
Result := TntControl_GetText(FMemo)
else
Result := inherited GetTextStr;
end;
procedure TTntMemoStrings.SetTextStr(const Value: WideString);
var
NewText: WideString;
begin
NewText := TntAdjustLineBreaks(Value, FLineBreakStyle);
if NewText <> GetTextStr then begin
FMemo.HandleNeeded;
TntControl_SetText(FMemo, NewText);
end;
end;
{ TTntCustomMemo }
constructor TTntCustomMemo.Create(AOwner: TComponent);
begin
inherited;
FLines := TTntMemoStrings.Create;
TTntMemoStrings(FLines).FMemo := Self;
TTntMemoStrings(FLines).FMemoLines := TCustomMemo{TNT-ALLOW TCustomMemo}(Self).Lines;
end;
destructor TTntCustomMemo.Destroy;
begin
FreeAndNil(FLines);
inherited;
end;
procedure TTntCustomMemo.SetLines(const Value: TTntStrings);
begin
FLines.Assign(Value);
end;
procedure TTntCustomMemo.CreateWindowHandle(const Params: TCreateParams);
begin
TntCustomEdit_CreateWindowHandle(Self, Params);
end;
procedure TTntCustomMemo.DefineProperties(Filer: TFiler);
begin
inherited;
TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntCustomMemo.GetSelStart: Integer;
begin
Result := TntCustomEdit_GetSelStart(Self);
end;
procedure TTntCustomMemo.SetSelStart(const Value: Integer);
begin
TntCustomEdit_SetSelStart(Self, Value);
end;
function TTntCustomMemo.GetSelLength: Integer;
begin
Result := TntCustomEdit_GetSelLength(Self);
end;
procedure TTntCustomMemo.SetSelLength(const Value: Integer);
begin
TntCustomEdit_SetSelLength(Self, Value);
end;
function TTntCustomMemo.GetSelText: WideString;
begin
Result := TntCustomEdit_GetSelText(Self);
end;
procedure TTntCustomMemo.SetSelText(const Value: WideString);
begin
TntCustomEdit_SetSelText(Self, Value);
end;
function TTntCustomMemo.GetText: WideString;
begin
Result := TntControl_GetText(Self);
end;
procedure TTntCustomMemo.SetText(const Value: WideString);
begin
TntControl_SetText(Self, Value);
end;
function TTntCustomMemo.IsHintStored: Boolean;
begin
Result := TntControl_IsHintStored(Self);
end;
function TTntCustomMemo.GetHint: WideString;
begin
Result := TntControl_GetHint(Self)
end;
procedure TTntCustomMemo.SetHint(const Value: WideString);
begin
TntControl_SetHint(Self, Value);
end;
procedure TTntCustomMemo.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
inherited;
end;
function TTntCustomMemo.GetActionLinkClass: TControlActionLinkClass;
begin
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;
{$IFDEF DELPHI_7} // fix for Delphi 7 only
function TD7PatchedComboBoxStrings.Get(Index: Integer): string{TNT-ALLOW string};
var
Len: Integer;
begin
Len := SendMessage(ComboBox.Handle, CB_GETLBTEXTLEN, Index, 0);
if Len > 0 then
begin
SetLength(Result, Len);
SendMessage(ComboBox.Handle, CB_GETLBTEXT, Index, Longint(PChar{TNT-ALLOW PChar}(Result)));
end
else
SetLength(Result, 0);
end;
function TD7PatchedComboBoxStrings.Add(const S: string{TNT-ALLOW string}): Integer;
begin
Result := SendMessage(ComboBox.Handle, CB_ADDSTRING, 0, Longint(PChar{TNT-ALLOW PChar}(S)));
if Result < 0 then
raise EOutOfResources.Create(SInsertLineError);
end;
procedure TD7PatchedComboBoxStrings.Insert(Index: Integer; const S: string{TNT-ALLOW string});
begin
if SendMessage(ComboBox.Handle, CB_INSERTSTRING, Index,
Longint(PChar{TNT-ALLOW PChar}(S))) < 0 then
raise EOutOfResources.Create(SInsertLineError);
end;
{$ENDIF}
{ TTntComboBoxStrings }
function TTntComboBoxStrings.GetCount: Integer;
begin
Result := ComboBox.Items.Count;
end;
function TTntComboBoxStrings.Get(Index: Integer): WideString;
var
Len: Integer;
begin
if (not IsWindowUnicode(ComboBox.Handle)) then
Result := ComboBox.Items[Index]
else begin
Len := SendMessageW(ComboBox.Handle, CB_GETLBTEXTLEN, Index, 0);
if Len = CB_ERR then
Result := ''
else begin
SetLength(Result, Len + 1);
Len := SendMessageW(ComboBox.Handle, CB_GETLBTEXT, Index, Longint(PWideChar(Result)));
if Len = CB_ERR then
Result := ''
else
Result := PWideChar(Result);
end;
end;
end;
function TTntComboBoxStrings.GetObject(Index: Integer): TObject;
begin
Result := ComboBox.Items.Objects[Index];
end;
procedure TTntComboBoxStrings.PutObject(Index: Integer; AObject: TObject);
begin
ComboBox.Items.Objects[Index] := AObject;
end;
function TTntComboBoxStrings.Add(const S: WideString): Integer;
begin
if (not IsWindowUnicode(ComboBox.Handle)) then
Result := ComboBox.Items.Add(S)
else begin
Result := SendMessageW(ComboBox.Handle, CB_ADDSTRING, 0, Longint(PWideChar(S)));
if Result < 0 then
raise EOutOfResources.Create(SInsertLineError);
end;
end;
procedure TTntComboBoxStrings.Insert(Index: Integer; const S: WideString);
begin
if (not IsWindowUnicode(ComboBox.Handle)) then
ComboBox.Items.Insert(Index, S)
else begin
if SendMessageW(ComboBox.Handle, CB_INSERTSTRING, Index, Longint(PWideChar(S))) < 0 then
raise EOutOfResources.Create(SInsertLineError);
end;
end;
procedure TTntComboBoxStrings.Delete(Index: Integer);
begin
ComboBox.Items.Delete(Index);
end;
procedure TTntComboBoxStrings.Clear;
var
S: WideString;
begin
S := TntControl_GetText(ComboBox);
SendMessage(ComboBox.Handle, CB_RESETCONTENT, 0, 0);
TntControl_SetText(ComboBox, S);
ComboBox.Update;
end;
procedure TTntComboBoxStrings.SetUpdateState(Updating: Boolean);
begin
TAccessStrings(ComboBox.Items).SetUpdateState(Updating);
end;
function TTntComboBoxStrings.IndexOf(const S: WideString): Integer;
begin
if (not IsWindowUnicode(ComboBox.Handle)) then
Result := ComboBox.Items.IndexOf(S)
else
Result := SendMessageW(ComboBox.Handle, CB_FINDSTRINGEXACT, -1, LongInt(PWideChar(S)));
end;
{ TTntCustomComboBox }
type TAccessCustomComboBox = class(TCustomComboBox{TNT-ALLOW TCustomComboBox});
procedure TntCombo_AfterInherited_CreateWnd(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
Items: TTntStrings; var FSaveItems: TTntStrings; FSaveItemIndex: integer; PreInheritedAnsiText: AnsiString);
begin
if (not Win32PlatformIsUnicode) then begin
TAccessCustomComboBox(Combo).Text := PreInheritedAnsiText;
end else begin
with TAccessCustomComboBox(Combo) do
begin
if ListHandle <> 0 then begin
// re-extract FDefListProc as a Unicode proc
SetWindowLongA(ListHandle, GWL_WNDPROC, Integer(FDefListProc));
FDefListProc := Pointer(GetWindowLongW(ListHandle, GWL_WNDPROC));
// override with FListInstance as a Unicode proc
SetWindowLongW(ListHandle, GWL_WNDPROC, Integer(FListInstance));
end;
SetWindowLongW(EditHandle, GWL_WNDPROC, GetWindowLong(EditHandle, GWL_WNDPROC));
end;
if FSaveItems <> nil then
begin
Items.Assign(FSaveItems);
FreeAndNil(FSaveItems);
if FSaveItemIndex <> -1 then
begin
if Items.Count < FSaveItemIndex then FSaveItemIndex := Items.Count;
SendMessage(Combo.Handle, CB_SETCURSEL, FSaveItemIndex, 0);
end;
end;
TntControl_SetText(Combo, TntControl_GetStoredText(Combo, TAccessCustomComboBox(Combo).Text));
end;
end;
procedure TntCombo_BeforeInherited_DestroyWnd(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
Items: TTntStrings; var FSaveItems: TTntStrings; ItemIndex: integer; var FSaveItemIndex: integer;
var SavedText: WideString);
begin
Assert(not (csDestroyingHandle in Combo.ControlState));
if (Win32PlatformIsUnicode) then begin
SavedText := TntControl_GetText(Combo);
if (Items.Count > 0) then
begin
FSaveItems := TTntStringList.Create;
FSaveItems.Assign(Items);
FSaveItemIndex:= ItemIndex;
Items.Clear; { This keeps TCustomComboBox from creating its own FSaveItems. (this kills the original ItemIndex) }
end;
end;
end;
function TntCombo_ComboWndProc(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer; DoEditCharMsg: TWMCharMsgHandler): Boolean;
procedure CallDefaultWindowProc;
begin
with Message do begin { call default wnd proc }
if IsWindowUnicode(ComboWnd) then
Result := CallWindowProcW(ComboProc, ComboWnd, Msg, WParam, LParam)
else
Result := CallWindowProcA(ComboProc, ComboWnd, Msg, WParam, LParam);
end;
end;
function DoWideKeyPress(Message: TWMChar): Boolean;
begin
DoEditCharMsg(Message);
Result := (Message.CharCode = 0);
end;
begin
Result := False;
try
if (Message.Msg = WM_CHAR) then begin
// WM_CHAR
Result := True;
if IsWindowUnicode(ComboWnd) then
MakeWMCharMsgSafeForAnsi(Message);
try
if TAccessCustomComboBox(Combo).DoKeyPress(TWMKey(Message)) then Exit;
if DoWideKeyPress(TWMKey(Message)) then Exit;
finally
if IsWindowUnicode(ComboWnd) then
RestoreWMCharMsg(Message);
end;
with TWMKey(Message) do begin
if ((CharCode = VK_RETURN) or (CharCode = VK_ESCAPE)) and Combo.DroppedDown then begin
Combo.DroppedDown := False;
Exit;
end;
end;
CallDefaultWindowProc;
end else if (IsWindowUnicode(ComboWnd)) then begin
// UNICODE
if IsTextMessage(Message.Msg)
or (Message.Msg = EM_REPLACESEL)
or (Message.Msg = WM_IME_COMPOSITION)
then begin
// message w/ text parameter
Result := True;
CallDefaultWindowProc;
end else if (Message.Msg = WM_IME_CHAR) then begin
// WM_IME_CHAR
Result := True;
with Message do { convert to WM_CHAR }
Result := SendMessageW(ComboWnd, WM_CHAR, WParam, LParam);
end;
end;
except
Application.HandleException(Combo);
end;
end;
function TntCombo_CNCommand(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; Items: TTntStrings; var Message: TWMCommand): Boolean;
begin
Result := False;
if Message.NotifyCode = CBN_SELCHANGE then begin
Result := True;
TntControl_SetText(Combo, Items[Combo.ItemIndex]);
TAccessCustomComboBox(Combo).Click;
TAccessCustomComboBox(Combo).Select;
end;
end;
function TntCombo_GetSelStart(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}): Integer;
begin
if Win32PlatformIsUnicode then
Result := Combo.SelStart
else
Result := Length(WideString(Copy(TAccessCustomComboBox(Combo).Text, 1, Combo.SelStart)));
end;
procedure TntCombo_SetSelStart(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; const Value: Integer);
begin
if Win32PlatformIsUnicode then
Combo.SelStart := Value
else
Combo.SelStart := Length(AnsiString(Copy(TntControl_GetText(Combo), 1, Value)));
end;
function TntCombo_GetSelLength(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}): Integer;
begin
if Win32PlatformIsUnicode then
Result := Combo.SelLength
else
Result := Length(TntCombo_GetSelText(Combo));
end;
procedure TntCombo_SetSelLength(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; const Value: Integer);
var
StartPos: Integer;
begin
if Win32PlatformIsUnicode then
Combo.SelLength := Value
else begin
StartPos := TntCombo_GetSelStart(Combo);
Combo.SelLength := Length(AnsiString(Copy(TntControl_GetText(Combo), StartPos + 1, Value)));
end;
end;
function TntCombo_GetSelText(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}): WideString;
begin
if Win32PlatformIsUnicode then begin
Result := '';
if TAccessCustomComboBox(Combo).Style < csDropDownList then
Result := Copy(TntControl_GetText(Combo), Combo.SelStart + 1, Combo.SelLength);
end else
Result := Combo.SelText
end;
procedure TntCombo_SetSelText(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; const Value: WideString);
begin
if Win32PlatformIsUnicode then begin
if TAccessCustomComboBox(Combo).Style < csDropDownList then
begin
Combo.HandleNeeded;
SendMessageW(TAccessCustomComboBox(Combo).EditHandle, EM_REPLACESEL, 0, Longint(PWideChar(Value)));
end;
end else
Combo.SelText := Value
end;
procedure TntCombo_BeforeKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; var SaveAutoComplete: Boolean);
begin
SaveAutoComplete := TAccessCustomComboBox(Combo).AutoComplete;
TAccessCustomComboBox(Combo).AutoComplete := False;
end;
procedure TntCombo_AfterKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; var SaveAutoComplete: Boolean);
begin
TAccessCustomComboBox(Combo).AutoComplete := SaveAutoComplete;
end;
procedure TntCombo_DropDown_PreserveSelection(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox});
var
OldSelStart, OldSelLength: Integer;
OldText: WideString;
begin
OldText := TntControl_GetText(Combo);
OldSelStart := TntCombo_GetSelStart(Combo);
OldSelLength := TntCombo_GetSelLength(Combo);
Combo.DroppedDown := True;
TntControl_SetText(Combo, OldText);
TntCombo_SetSelStart(Combo, OldSelStart);
TntCombo_SetSelLength(Combo ,OldSelLength);
end;
procedure TntComboBox_AddItem(Items: TTntStrings; const Item: WideString; AObject: TObject);
begin
Items.AddObject(Item, AObject);
end;
procedure TntComboBox_CopySelection(Items: TTntStrings; ItemIndex: Integer;
Destination: TCustomListControl);
begin
if ItemIndex <> -1 then
WideListControl_AddItem(Destination, Items[ItemIndex], Items.Objects[ItemIndex]);
end;
function TntCombo_FindString(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
StartPos: Integer; const Text: WideString): Integer;
var
ComboFindString: ITntComboFindString;
begin
if Combo.GetInterface(ITntComboFindString, ComboFindString) then
Result := ComboFindString.FindString(Text, StartPos)
else if IsWindowUnicode(Combo.Handle) then
Result := SendMessageW(Combo.Handle, CB_FINDSTRING, StartPos, Integer(PWideChar(Text)))
else
Result := SendMessageA(Combo.Handle, CB_FINDSTRING, StartPos, Integer(PAnsiChar(AnsiString(Text))))
end;
function TntCombo_FindUniqueString(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
StartPos: Integer; const Text: WideString): Integer;
var
Match_1, Match_2: Integer;
begin
Result := CB_ERR;
Match_1 := TntCombo_FindString(Combo, -1, Text);
if Match_1 <> CB_ERR then begin
Match_2 := TntCombo_FindString(Combo, Match_1, Text);
if Match_2 = Match_1 then
Result := Match_1;
end;
end;
function TntCombo_AutoSelect(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; Items: TTntStrings;
const SearchText: WideString; UniqueMatchOnly: Boolean; UseDataEntryCase: Boolean): Boolean;
var
Idx: Integer;
ValueChange: Boolean;
begin
if UniqueMatchOnly then
Idx := TntCombo_FindUniqueString(Combo, -1, SearchText)
else
Idx := TntCombo_FindString(Combo, -1, SearchText);
Result := (Idx <> CB_ERR);
if Result then begin
if TAccessCustomComboBox(Combo).Style = csDropDown then
ValueChange := not WideSameStr(TntControl_GetText(Combo), Items[Idx])
else
ValueChange := Idx <> Combo.ItemIndex;
{$IFDEF COMPILER_7_UP}
// auto-closeup
if Combo.AutoCloseUp and (Items.IndexOf(SearchText) <> -1) then
Combo.DroppedDown := False;
{$ENDIF}
// select item
Combo.ItemIndex := Idx;
// update edit
if (TAccessCustomComboBox(Combo).Style in [csDropDown, csSimple]) then begin
if UseDataEntryCase then begin
// preserve case of characters as they are entered
TntControl_SetText(Combo, SearchText + Copy(Items[Combo.ItemIndex], Length(SearchText) + 1, MaxInt));
end else begin
TntControl_SetText(Combo, Items[Idx]);
end;
// select the rest of the string
TntCombo_SetSelStart(Combo, Length(SearchText));
TntCombo_SetSelLength(Combo, Length(TntControl_GetText(Combo)) - TntCombo_GetSelStart(Combo));
end;
// notify events
if ValueChange then begin
TAccessCustomComboBox(Combo).Click;
TAccessCustomComboBox(Combo).Select;
end;
end;
end;
procedure TntCombo_AutoSearchKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
Items: TTntStrings; var Message: TWMChar; var FFilter: WideString; var FLastTime: Cardinal);
var
Key: WideChar;
begin
if TAccessCustomComboBox(Combo).Style in [csSimple, csDropDown] then
exit;
if not Combo.AutoComplete then
exit;
Key := GetWideCharFromWMCharMsg(Message);
try
case Ord(Key) of
VK_ESCAPE:
exit;
VK_TAB:
if Combo.AutoDropDown and Combo.DroppedDown then
Combo.DroppedDown := False;
VK_BACK:
Delete(FFilter, Length(FFilter), 1);
else begin
if Combo.AutoDropDown and (not Combo.DroppedDown) then
Combo.DroppedDown := True;
// reset FFilter if it's been too long (1.25 sec) { Windows XP is actually 2 seconds! }
if GetTickCount - FLastTime >= 1250 then
FFilter := '';
FLastTime := GetTickCount;
// if AutoSelect works, remember new FFilter
if TntCombo_AutoSelect(Combo, Items, FFilter + Key, False, True) then begin
FFilter := FFilter + Key;
Key := #0;
end;
end;
end;
finally
SetWideCharForWMCharMsg(Message, Key);
end;
end;
procedure TntCombo_AutoCompleteKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
Items: TTntStrings; var Message: TWMChar;
AutoComplete_UniqueMatchOnly, AutoComplete_PreserveDataEntryCase: Boolean);
var
Key: WideChar;
FindText: WideString;
begin
Assert(TAccessCustomComboBox(Combo).Style in [csSimple, csDropDown], 'Internal Error: TntCombo_AutoCompleteKeyPress is only for csSimple and csDropDown style combo boxes.');
if not Combo.AutoComplete then exit;
Key := GetWideCharFromWMCharMsg(Message);
try
case Ord(Key) of
VK_ESCAPE:
exit;
VK_TAB:
if Combo.AutoDropDown and Combo.DroppedDown then
Combo.DroppedDown := False;
VK_BACK:
exit;
else begin
if Combo.AutoDropDown and (not Combo.DroppedDown) then
TntCombo_DropDown_PreserveSelection(Combo);
// AutoComplete only if the selection is at the very end
if ((TntCombo_GetSelStart(Combo) + TntCombo_GetSelLength(Combo))
= Length(TntControl_GetText(Combo))) then
begin
FindText := Copy(TntControl_GetText(Combo), 1, TntCombo_GetSelStart(Combo)) + Key;
if TntCombo_AutoSelect(Combo, Items, FindText, AutoComplete_UniqueMatchOnly, AutoComplete_PreserveDataEntryCase) then
begin
Key := #0;
end;
end;
end;
end;
finally
SetWideCharForWMCharMsg(Message, Key);
end;
end;
//--
constructor TTntCustomComboBox.Create(AOwner: TComponent);
begin
inherited;
FItems := TTntComboBoxStrings.Create;
TTntComboBoxStrings(FItems).ComboBox := Self;
end;
destructor TTntCustomComboBox.Destroy;
begin
FreeAndNil(FItems);
FreeAndNil(FSaveItems);
inherited;
end;
procedure TTntCustomComboBox.CreateWindowHandle(const Params: TCreateParams);
begin
CreateUnicodeHandle(Self, Params, 'COMBOBOX');
end;
procedure TTntCustomComboBox.DefineProperties(Filer: TFiler);
begin
inherited;
TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
procedure TTntCustomComboBox.CreateWnd;
var
PreInheritedAnsiText: AnsiString;
begin
PreInheritedAnsiText := TAccessCustomComboBox(Self).Text;
inherited;
TntCombo_AfterInherited_CreateWnd(Self, Items, FSaveItems, FSaveItemIndex, PreInheritedAnsiText);
end;
procedure TTntCustomComboBox.DestroyWnd;
var
SavedText: WideString;
begin
if not (csDestroyingHandle in ControlState) then begin { avoid recursion when parent is TToolBar and system font changes. }
TntCombo_BeforeInherited_DestroyWnd(Self, Items, FSaveItems, ItemIndex, FSaveItemIndex, SavedText);
inherited;
TntControl_SetStoredText(Self, SavedText);
end;
end;
procedure TTntCustomComboBox.ComboWndProc(var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer);
begin
if not TntCombo_ComboWndProc(Self, Message, ComboWnd, ComboProc, DoEditCharMsg) then
inherited;
end;
procedure TTntCustomComboBox.KeyPress(var Key: AnsiChar);
var
SaveAutoComplete: Boolean;
begin
TntCombo_BeforeKeyPress(Self, SaveAutoComplete);
try
inherited;
finally
TntCombo_AfterKeyPress(Self, SaveAutoComplete);
end;
end;
procedure TTntCustomComboBox.DoEditCharMsg(var Message: TWMChar);
begin
TntCombo_AutoCompleteKeyPress(Self, Items, Message,
GetAutoComplete_UniqueMatchOnly, GetAutoComplete_PreserveDataEntryCase);
end;
procedure TTntCustomComboBox.WMChar(var Message: TWMChar);
begin
TntCombo_AutoSearchKeyPress(Self, Items, Message, FFilter, FLastTime);
if Message.CharCode <> 0 then
inherited;
end;
procedure TntCombo_DefaultDrawItem(Canvas: TCanvas; Index: Integer; Rect: TRect;
State: TOwnerDrawState; Items: TTntStrings);
begin
Canvas.FillRect(Rect);
if Index >= 0 then
WideCanvasTextOut(Canvas, Rect.Left + 2, Rect.Top, Items[Index]);
end;
procedure TTntCustomComboBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
TControlCanvas(Canvas).UpdateTextFlags;
if Assigned(OnDrawItem) then
OnDrawItem(Self, Index, Rect, State)
else
TntCombo_DefaultDrawItem(Canvas, Index, Rect, State, Items);
end;
function TTntCustomComboBox.GetItems: TTntStrings;
begin
Result := FItems;
end;
procedure TTntCustomComboBox.SetItems(const Value: TTntStrings);
begin
FItems.Assign(Value);
end;
function TTntCustomComboBox.GetSelStart: Integer;
begin
Result := TntCombo_GetSelStart(Self);
end;
procedure TTntCustomComboBox.SetSelStart(const Value: Integer);
begin
TntCombo_SetSelStart(Self, Value);
end;
function TTntCustomComboBox.GetSelLength: Integer;
begin
Result := TntCombo_GetSelLength(Self);
end;
procedure TTntCustomComboBox.SetSelLength(const Value: Integer);
begin
TntCombo_SetSelLength(Self, Value);
end;
function TTntCustomComboBox.GetSelText: WideString;
begin
Result := TntCombo_GetSelText(Self);
end;
procedure TTntCustomComboBox.SetSelText(const Value: WideString);
begin
TntCombo_SetSelText(Self, Value);
end;
function TTntCustomComboBox.GetText: WideString;
begin
Result := TntControl_GetText(Self);
end;
procedure TTntCustomComboBox.SetText(const Value: WideString);
begin
TntControl_SetText(Self, Value);
end;
procedure TTntCustomComboBox.CNCommand(var Message: TWMCommand);
begin
if not TntCombo_CNCommand(Self, Items, Message) then
inherited;
end;
function TTntCustomComboBox.GetAutoComplete_PreserveDataEntryCase: Boolean;
begin
Result := True;
end;
function TTntCustomComboBox.GetAutoComplete_UniqueMatchOnly: Boolean;
begin
Result := False;
end;
function TTntCustomComboBox.IsHintStored: Boolean;
begin
Result := TntControl_IsHintStored(Self)
end;
function TTntCustomComboBox.GetHint: WideString;
begin
Result := TntControl_GetHint(Self)
end;
procedure TTntCustomComboBox.SetHint(const Value: WideString);
begin
TntControl_SetHint(Self, Value);
end;
procedure TTntCustomComboBox.AddItem(const Item: WideString; AObject: TObject);
begin
TntComboBox_AddItem(Items, Item, AObject);
end;
procedure TTntCustomComboBox.CopySelection(Destination: TCustomListControl);
begin
TntComboBox_CopySelection(Items, ItemIndex, Destination);
end;
procedure TTntCustomComboBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
inherited;
end;
function TTntCustomComboBox.GetActionLinkClass: TControlActionLinkClass;
begin
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;
{$IFDEF DELPHI_7} // fix for Delphi 7 only
function TTntCustomComboBox.GetItemsClass: TCustomComboBoxStringsClass;
begin
Result := TD7PatchedComboBoxStrings;
end;
{$ENDIF}
{ TTntListBoxStrings }
function TTntListBoxStrings.GetListBox: TCustomListBox{TNT-ALLOW TCustomListBox};
begin
Result := TCustomListBox{TNT-ALLOW TCustomListBox}(FListBox);
end;
procedure TTntListBoxStrings.SetListBox(const Value: TCustomListBox{TNT-ALLOW TCustomListBox});
begin
FListBox := TAccessCustomListBox(Value);
end;
function TTntListBoxStrings.GetCount: Integer;
begin
Result := ListBox.Items.Count;
end;
function TTntListBoxStrings.Get(Index: Integer): WideString;
var
Len: Integer;
begin
if (not IsWindowUnicode(ListBox.Handle)) then
Result := ListBox.Items[Index]
else begin
Len := SendMessageW(ListBox.Handle, LB_GETTEXTLEN, Index, 0);
if Len = LB_ERR then
Error(SListIndexError, Index)
else begin
SetLength(Result, Len + 1);
Len := SendMessageW(ListBox.Handle, LB_GETTEXT, Index, Longint(PWideChar(Result)));
if Len = LB_ERR then
Result := ''
else
Result := PWideChar(Result);
end;
end;
end;
function TTntListBoxStrings.GetObject(Index: Integer): TObject;
begin
Result := ListBox.Items.Objects[Index];
end;
procedure TTntListBoxStrings.Put(Index: Integer; const S: WideString);
var
I: Integer;
TempData: Longint;
begin
I := ListBox.ItemIndex;
TempData := FListBox.InternalGetItemData(Index);
// Set the Item to 0 in case it is an object that gets freed during Delete
FListBox.InternalSetItemData(Index, 0);
Delete(Index);
InsertObject(Index, S, nil);
FListBox.InternalSetItemData(Index, TempData);
ListBox.ItemIndex := I;
end;
procedure TTntListBoxStrings.PutObject(Index: Integer; AObject: TObject);
begin
ListBox.Items.Objects[Index] := AObject;
end;
function TTntListBoxStrings.Add(const S: WideString): Integer;
begin
if (not IsWindowUnicode(ListBox.Handle)) then
Result := ListBox.Items.Add(S)
else begin
Result := SendMessageW(ListBox.Handle, LB_ADDSTRING, 0, Longint(PWideChar(S)));
if Result < 0 then
raise EOutOfResources.Create(SInsertLineError);
end;
end;
procedure TTntListBoxStrings.Insert(Index: Integer; const S: WideString);
begin
if (not IsWindowUnicode(ListBox.Handle)) then
ListBox.Items.Insert(Index, S)
else begin
if SendMessageW(ListBox.Handle, LB_INSERTSTRING, Index, Longint(PWideChar(S))) < 0 then
raise EOutOfResources.Create(SInsertLineError);
end;
end;
procedure TTntListBoxStrings.Delete(Index: Integer);
begin
FListBox.DeleteString(Index);
end;
procedure TTntListBoxStrings.Exchange(Index1, Index2: Integer);
var
TempData: Longint;
TempString: WideString;
begin
BeginUpdate;
try
TempString := Strings[Index1];
TempData := FListBox.InternalGetItemData(Index1);
Strings[Index1] := Strings[Index2];
FListBox.InternalSetItemData(Index1, FListBox.InternalGetItemData(Index2));
Strings[Index2] := TempString;
FListBox.InternalSetItemData(Index2, TempData);
if ListBox.ItemIndex = Index1 then
ListBox.ItemIndex := Index2
else if ListBox.ItemIndex = Index2 then
ListBox.ItemIndex := Index1;
finally
EndUpdate;
end;
end;
procedure TTntListBoxStrings.Clear;
begin
FListBox.ResetContent;
end;
procedure TTntListBoxStrings.SetUpdateState(Updating: Boolean);
begin
TAccessStrings(ListBox.Items).SetUpdateState(Updating);
end;
function TTntListBoxStrings.IndexOf(const S: WideString): Integer;
begin
if (not IsWindowUnicode(ListBox.Handle)) then
Result := ListBox.Items.IndexOf(S)
else
Result := SendMessageW(ListBox.Handle, LB_FINDSTRINGEXACT, -1, LongInt(PWideChar(S)));
end;
procedure TTntListBoxStrings.Move(CurIndex, NewIndex: Integer);
var
TempData: Longint;
TempString: WideString;
begin
BeginUpdate;
FListBox.FMoving := True;
try
if CurIndex <> NewIndex then
begin
TempString := Get(CurIndex);
TempData := FListBox.InternalGetItemData(CurIndex);
FListBox.InternalSetItemData(CurIndex, 0);
Delete(CurIndex);
Insert(NewIndex, TempString);
FListBox.InternalSetItemData(NewIndex, TempData);
end;
finally
FListBox.FMoving := False;
EndUpdate;
end;
end;
//-- list box helper procs
procedure TntListBox_AfterInherited_CreateWnd(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox};
var FSaveItems: TTntStrings; FItems: TTntStrings; FSaveTopIndex, FSaveItemIndex: Integer);
begin
if FSaveItems <> nil then
begin
FItems.Assign(FSaveItems);
FreeAndNil(FSaveItems);
ListBox.TopIndex := FSaveTopIndex;
ListBox.ItemIndex := FSaveItemIndex;
end;
end;
procedure TntListBox_BeforeInherited_DestroyWnd(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox};
var FSaveItems: TTntStrings; const FItems: TTntStrings; var FSaveTopIndex, FSaveItemIndex: Integer);
begin
if (FItems.Count > 0)
and (not (TAccessCustomListBox(ListBox).Style in [lbVirtual, lbVirtualOwnerDraw]))
then begin
FSaveItems := TTntStringList.Create;
FSaveItems.Assign(FItems);
FSaveTopIndex := ListBox.TopIndex;
FSaveItemIndex := ListBox.ItemIndex;
ListBox.Items.Clear; { This keeps TCustomListBox from creating its own FSaveItems. (this kills the original ItemIndex) }
end;
end;
procedure TntListBox_DrawItem_Text(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox}; Items: TTntStrings; Index: Integer; Rect: TRect);
var
Flags: Integer;
Canvas: TCanvas;
begin
Canvas := TAccessCustomListBox(ListBox).Canvas;
Canvas.FillRect(Rect);
if Index < Items.Count then
begin
Flags := ListBox.DrawTextBiDiModeFlags(DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
if not ListBox.UseRightToLeftAlignment then
Inc(Rect.Left, 2)
else
Dec(Rect.Right, 2);
Tnt_DrawTextW(Canvas.Handle, PWideChar(Items[Index]), Length(Items[Index]), Rect, Flags);
end;
end;
procedure TntListBox_AddItem(Items: TTntStrings; const Item: WideString; AObject: TObject);
begin
Items.AddObject(PWideChar(Item), AObject);
end;
procedure TntListBox_CopySelection(ListBox: TCustomListbox{TNT-ALLOW TCustomListbox};
Items: TTntStrings; Destination: TCustomListControl);
var
I: Integer;
begin
if ListBox.MultiSelect then
begin
for I := 0 to Items.Count - 1 do
if ListBox.Selected[I] then
WideListControl_AddItem(Destination, PWideChar(Items[I]), Items.Objects[I]);
end
else
if Listbox.ItemIndex <> -1 then
WideListControl_AddItem(Destination, PWideChar(Items[ListBox.ItemIndex]), Items.Objects[ListBox.ItemIndex]);
end;
function TntCustomListBox_GetOwnerData(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox}; OnData: TLBGetWideDataEvent; Index: Integer; out Data: WideString): Boolean;
var
AnsiData: AnsiString;
begin
Result := False;
Data := '';
if (Index > -1) and (Index < ListBox.Count) then begin
if Assigned(OnData) then begin
OnData(ListBox, Index, Data);
Result := True;
end else if Assigned(TAccessCustomListBox(ListBox).OnData) then begin
AnsiData := '';
TAccessCustomListBox(ListBox).OnData(ListBox, Index, AnsiData);
Data := AnsiData;
Result := True;
end;
end;
end;
function TntCustomListBox_LBGetText(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox}; OnData: TLBGetWideDataEvent; var Message: TMessage): Boolean;
var
S: WideString;
AnsiS: AnsiString;
begin
if TAccessCustomListBox(ListBox).Style in [lbVirtual, lbVirtualOwnerDraw] then
begin
Result := True;
if TntCustomListBox_GetOwnerData(ListBox, OnData, Message.WParam, S) then begin
if Win32PlatformIsUnicode then begin
WStrCopy(PWideChar(Message.LParam), PWideChar(S));
Message.Result := Length(S);
end else begin
AnsiS := S;
StrCopy{TNT-ALLOW StrCopy}(PAnsiChar(Message.LParam), PAnsiChar(AnsiS));
Message.Result := Length(AnsiS);
end;
end
else
Message.Result := LB_ERR;
end
else
Result := False;
end;
function TntCustomListBox_LBGetTextLen(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox}; OnData: TLBGetWideDataEvent; var Message: TMessage): Boolean;
var
S: WideString;
begin
if TAccessCustomListBox(ListBox).Style in [lbVirtual, lbVirtualOwnerDraw] then
begin
Result := True;
if TntCustomListBox_GetOwnerData(ListBox, OnData, Message.WParam, S) then begin
if Win32PlatformIsUnicode then
Message.Result := Length(S)
else
Message.Result := Length(AnsiString(S));
end else
Message.Result := LB_ERR;
end
else
Result := False;
end;
{ TTntCustomListBox }
constructor TTntCustomListBox.Create(AOwner: TComponent);
begin
inherited;
FItems := TTntListBoxStrings.Create;
TTntListBoxStrings(FItems).ListBox := Self;
end;
destructor TTntCustomListBox.Destroy;
begin
FreeAndNil(FItems);
FreeAndNil(FSaveItems);
inherited;
end;
procedure TTntCustomListBox.CreateWindowHandle(const Params: TCreateParams);
begin
CreateUnicodeHandle(Self, Params, 'LISTBOX');
end;
procedure TTntCustomListBox.DefineProperties(Filer: TFiler);
begin
inherited;
TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
procedure TTntCustomListBox.CreateWnd;
begin
inherited;
TntListBox_AfterInherited_CreateWnd(Self, FSaveItems, FItems, FSaveTopIndex, FSaveItemIndex);
end;
procedure TTntCustomListBox.DestroyWnd;
begin
TntListBox_BeforeInherited_DestroyWnd(Self, FSaveItems, FItems, FSaveTopIndex, FSaveItemIndex);
inherited;
end;
procedure TTntCustomListBox.SetItems(const Value: TTntStrings);
begin
FItems.Assign(Value);
end;
procedure TTntCustomListBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
if Assigned(OnDrawItem) then
OnDrawItem(Self, Index, Rect, State)
else
TntListBox_DrawItem_Text(Self, Items, Index, Rect);
end;
function TTntCustomListBox.IsHintStored: Boolean;
begin
Result := TntControl_IsHintStored(Self)
end;
function TTntCustomListBox.GetHint: WideString;
begin
Result := TntControl_GetHint(Self)
end;
procedure TTntCustomListBox.SetHint(const Value: WideString);
begin
TntControl_SetHint(Self, Value);
end;
procedure TTntCustomListBox.AddItem(const Item: WideString; AObject: TObject);
begin
TntListBox_AddItem(Items, Item, AObject);
end;
procedure TTntCustomListBox.CopySelection(Destination: TCustomListControl);
begin
TntListBox_CopySelection(Self, Items, Destination);
end;
procedure TTntCustomListBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
inherited;
end;
function TTntCustomListBox.GetActionLinkClass: TControlActionLinkClass;
begin
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;
procedure TTntCustomListBox.LBGetText(var Message: TMessage);
begin
if not TntCustomListBox_LBGetText(Self, OnData, Message) then
inherited;
end;
procedure TTntCustomListBox.LBGetTextLen(var Message: TMessage);
begin
if not TntCustomListBox_LBGetTextLen(Self, OnData, Message) then
inherited;
end;
// --- label helper procs
type TAccessCustomLabel = class(TCustomLabel{TNT-ALLOW TCustomLabel});
function TntLabel_DoDrawText(Control: TCustomLabel{TNT-ALLOW TCustomLabel}; var Rect: TRect; Flags: Integer; const GetLabelText: WideString): Boolean;
{$IFDEF COMPILER_9_UP}
const
EllipsisStr = '...';
Ellipsis: array[TEllipsisPosition] of Longint = (0, DT_PATH_ELLIPSIS,
DT_END_ELLIPSIS, DT_WORD_ELLIPSIS);
{$ENDIF}
var
Text: WideString;
ShowAccelChar: Boolean;
Canvas: TCanvas;
{$IFDEF COMPILER_9_UP}
DText: WideString;
NewRect: TRect;
Height: Integer;
Delim: Integer;
{$ENDIF}
begin
Result := False;
if Win32PlatformIsUnicode then begin
Result := True;
Text := GetLabelText;
ShowAccelChar := TAccessCustomLabel(Control).ShowAccelChar;
Canvas := Control.Canvas;
if (Flags and DT_CALCRECT <> 0) and ((Text = '') or ShowAccelChar and
(Text[1] = '&') and (Text[2] = #0)) then Text := Text + ' ';
if not ShowAccelChar then Flags := Flags or DT_NOPREFIX;
Flags := Control.DrawTextBiDiModeFlags(Flags);
Canvas.Font := TAccessCustomLabel(Control).Font;
{$IFDEF COMPILER_9_UP}
if (TAccessCustomLabel(Control).EllipsisPosition <> epNone)
and (not TAccessCustomLabel(Control).AutoSize) then
begin
DText := Text;
Flags := Flags and not (DT_EXPANDTABS or DT_CALCRECT);
Flags := Flags or Ellipsis[TAccessCustomLabel(Control).EllipsisPosition];
if TAccessCustomLabel(Control).WordWrap
and (TAccessCustomLabel(Control).EllipsisPosition in [epEndEllipsis, epWordEllipsis]) then
begin
repeat
NewRect := Rect;
Dec(NewRect.Right, WideCanvasTextWidth(Canvas, EllipsisStr));
Tnt_DrawTextW(Canvas.Handle, PWideChar(DText), Length(DText), NewRect, Flags or DT_CALCRECT);
Height := NewRect.Bottom - NewRect.Top;
if (Height > TAccessCustomLabel(Control).ClientHeight)
and (Height > Canvas.Font.Height) then
begin
Delim := WideLastDelimiter(' '#9, Text);
if Delim = 0 then
Delim := Length(Text);
Dec(Delim);
Text := Copy(Text, 1, Delim);
DText := Text + EllipsisStr;
if Text = '' then
Break;
end else
Break;
until False;
end;
if Text <> '' then
Text := DText;
end;
{$ENDIF}
if not Control.Enabled then
begin
OffsetRect(Rect, 1, 1);
Canvas.Font.Color := clBtnHighlight;
Tnt_DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), Rect, Flags);
OffsetRect(Rect, -1, -1);
Canvas.Font.Color := clBtnShadow;
Tnt_DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), Rect, Flags);
end
else
Tnt_DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), Rect, Flags);
end;
end;
procedure TntLabel_CMDialogChar(Control: TCustomLabel{TNT-ALLOW TCustomLabel}; var Message: TCMDialogChar; const Caption: WideString);
var
FocusControl: TWinControl;
ShowAccelChar: Boolean;
begin
FocusControl := TAccessCustomLabel(Control).FocusControl;
ShowAccelChar := TAccessCustomLabel(Control).ShowAccelChar;
if (FocusControl <> nil) and Control.Enabled and ShowAccelChar and
IsWideCharAccel(Message.CharCode, Caption) then
with FocusControl do
if CanFocus then
begin
SetFocus;
Message.Result := 1;
end;
end;
{ TTntCustomLabel }
procedure TTntCustomLabel.CMDialogChar(var Message: TCMDialogChar);
begin
TntLabel_CMDialogChar(Self, Message, Caption);
end;
function TTntCustomLabel.IsCaptionStored: Boolean;
begin
Result := TntControl_IsCaptionStored(Self)
end;
function TTntCustomLabel.GetCaption: TWideCaption;
begin
Result := TntControl_GetText(Self);
end;
procedure TTntCustomLabel.SetCaption(const Value: TWideCaption);
begin
TntControl_SetText(Self, Value);
end;
procedure TTntCustomLabel.DefineProperties(Filer: TFiler);
begin
inherited;
TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntCustomLabel.GetLabelText: WideString;
begin
Result := Caption;
end;
procedure TTntCustomLabel.DoDrawText(var Rect: TRect; Flags: Integer);
begin
if not TntLabel_DoDrawText(Self, Rect, Flags, GetLabelText) then
inherited;
end;
function TTntCustomLabel.IsHintStored: Boolean;
begin
Result := TntControl_IsHintStored(Self)
end;
function TTntCustomLabel.GetHint: WideString;
begin
Result := TntControl_GetHint(Self)
end;
procedure TTntCustomLabel.SetHint(const Value: WideString);
begin
TntControl_SetHint(Self, Value);
end;
procedure TTntCustomLabel.CMHintShow(var Message: TMessage);
begin
ProcessCMHintShowMsg(Message);
inherited;
end;
procedure TTntCustomLabel.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
inherited;
end;
function TTntCustomLabel.GetActionLinkClass: TControlActionLinkClass;
begin
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;
{ TTntButton }
procedure TntButton_CMDialogChar(Button: TButton{TNT-ALLOW TButton}; var Message: TCMDialogChar);
begin
with Message do
if IsWideCharAccel(Message.CharCode, TntControl_GetText(Button))
and Button.CanFocus then
begin
Button.Click;
Result := 1;
end else
Button.Broadcast(Message);
end;
procedure TTntButton.CreateWindowHandle(const Params: TCreateParams);
begin
CreateUnicodeHandle(Self, Params, 'BUTTON');
end;
procedure TTntButton.DefineProperties(Filer: TFiler);
begin
inherited;
TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
procedure TTntButton.CMDialogChar(var Message: TCMDialogChar);
begin
TntButton_CMDialogChar(Self, Message);
end;
function TTntButton.IsCaptionStored: Boolean;
begin
Result := TntControl_IsCaptionStored(Self)
end;
function TTntButton.GetCaption: TWideCaption;
begin
Result := TntControl_GetText(Self)
end;
procedure TTntButton.SetCaption(const Value: TWideCaption);
begin
TntControl_SetText(Self, Value);
end;
function TTntButton.IsHintStored: Boolean;
begin
Result := TntControl_IsHintStored(Self)
end;
function TTntButton.GetHint: WideString;
begin
Result := TntControl_GetHint(Self)
end;
procedure TTntButton.SetHint(const Value: WideString);
begin
TntControl_SetHint(Self, Value);
end;
procedure TTntButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
inherited;
end;
function TTntButton.GetActionLinkClass: TControlActionLinkClass;
begin
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;
{ TTntCustomCheckBox }
procedure TTntCustomCheckBox.CreateWindowHandle(const Params: TCreateParams);
begin
CreateUnicodeHandle(Self, Params, 'BUTTON');
end;
procedure TTntCustomCheckBox.DefineProperties(Filer: TFiler);
begin
inherited;
TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
procedure TTntCustomCheckBox.CMDialogChar(var Message: TCMDialogChar);
begin
with Message do
if IsWideCharAccel(Message.CharCode, Caption)
and CanFocus then
begin
SetFocus;
if Focused then Toggle;
Result := 1;
end else
Broadcast(Message);
end;
function TTntCustomCheckBox.IsCaptionStored: Boolean;
begin
Result := TntControl_IsCaptionStored(Self)
end;
function TTntCustomCheckBox.GetCaption: TWideCaption;
begin
Result := TntControl_GetText(Self)
end;
procedure TTntCustomCheckBox.SetCaption(const Value: TWideCaption);
begin
TntControl_SetText(Self, Value);
end;
function TTntCustomCheckBox.IsHintStored: Boolean;
begin
Result := TntControl_IsHintStored(Self)
end;
function TTntCustomCheckBox.GetHint: WideString;
begin
Result := TntControl_GetHint(Self)
end;
procedure TTntCustomCheckBox.SetHint(const Value: WideString);
begin
TntControl_SetHint(Self, Value);
end;
procedure TTntCustomCheckBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
inherited;
end;
function TTntCustomCheckBox.GetActionLinkClass: TControlActionLinkClass;
begin
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;
{ TTntRadioButton }
procedure TTntRadioButton.CreateWindowHandle(const Params: TCreateParams);
begin
CreateUnicodeHandle(Self, Params, 'BUTTON');
end;
procedure TTntRadioButton.DefineProperties(Filer: TFiler);
begin
inherited;
TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
procedure TTntRadioButton.CMDialogChar(var Message: TCMDialogChar);
begin
with Message do
if IsWideCharAccel(Message.CharCode, Caption)
and CanFocus then
begin
SetFocus;
Result := 1;
end else
Broadcast(Message);
end;
function TTntRadioButton.IsCaptionStored: Boolean;
begin
Result := TntControl_IsCaptionStored(Self);
end;
function TTntRadioButton.GetCaption: TWideCaption;
begin
Result := TntControl_GetText(Self)
end;
procedure TTntRadioButton.SetCaption(const Value: TWideCaption);
begin
TntControl_SetText(Self, Value);
end;
function TTntRadioButton.IsHintStored: Boolean;
begin
Result := TntControl_IsHintStored(Self)
end;
function TTntRadioButton.GetHint: WideString;
begin
Result := TntControl_GetHint(Self)
end;
procedure TTntRadioButton.SetHint(const Value: WideString);
begin
TntControl_SetHint(Self, Value);
end;
procedure TTntRadioButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
inherited;
end;
function TTntRadioButton.GetActionLinkClass: TControlActionLinkClass;
begin
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;
{ TTntScrollBar }
procedure TTntScrollBar.CreateWindowHandle(const Params: TCreateParams);
begin
CreateUnicodeHandle(Self, Params, 'SCROLLBAR');
end;
procedure TTntScrollBar.DefineProperties(Filer: TFiler);
begin
inherited;
TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntScrollBar.IsHintStored: Boolean;
begin
Result := TntControl_IsHintStored(Self)
end;
function TTntScrollBar.GetHint: WideString;
begin
Result := TntControl_GetHint(Self)
end;
procedure TTntScrollBar.SetHint(const Value: WideString);
begin
TntControl_SetHint(Self, Value);
end;
procedure TTntScrollBar.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
inherited;
end;
function TTntScrollBar.GetActionLinkClass: TControlActionLinkClass;
begin
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;
{ TTntCustomGroupBox }
procedure TTntCustomGroupBox.CreateWindowHandle(const Params: TCreateParams);
begin
CreateUnicodeHandle(Self, Params, '');
end;
procedure TTntCustomGroupBox.DefineProperties(Filer: TFiler);
begin
inherited;
TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
procedure TTntCustomGroupBox.CMDialogChar(var Message: TCMDialogChar);
begin
with Message do
if IsWideCharAccel(Message.CharCode, Caption)
and CanFocus then
begin
SelectFirst;
Result := 1;
end else
Broadcast(Message);
end;
function TTntCustomGroupBox.IsCaptionStored: Boolean;
begin
Result := TntControl_IsCaptionStored(Self);
end;
function TTntCustomGroupBox.GetCaption: TWideCaption;
begin
Result := TntControl_GetText(Self)
end;
procedure TTntCustomGroupBox.SetCaption(const Value: TWideCaption);
begin
TntControl_SetText(Self, Value);
end;
procedure TTntCustomGroupBox.Paint;
{$IFDEF THEME_7_UP}
procedure PaintThemedGroupBox;
var
CaptionRect: TRect;
OuterRect: TRect;
Size: TSize;
Box: TThemedButton;
Details: TThemedElementDetails;
begin
with Canvas do begin
if Caption <> '' then
begin
GetTextExtentPoint32W(Handle, PWideChar(Caption), Length(Caption), Size);
CaptionRect := Rect(0, 0, Size.cx, Size.cy);
if not UseRightToLeftAlignment then
OffsetRect(CaptionRect, 8, 0)
else
OffsetRect(CaptionRect, Width - 8 - CaptionRect.Right, 0);
end
else
CaptionRect := Rect(0, 0, 0, 0);
OuterRect := ClientRect;
OuterRect.Top := (CaptionRect.Bottom - CaptionRect.Top) div 2;
with CaptionRect do
ExcludeClipRect(Handle, Left, Top, Right, Bottom);
if Enabled then
Box := tbGroupBoxNormal
else
Box := tbGroupBoxDisabled;
Details := ThemeServices.GetElementDetails(Box);
ThemeServices.DrawElement(Handle, Details, OuterRect);
SelectClipRgn(Handle, 0);
if Text <> '' then
ThemeServices.DrawText{TNT-ALLOW DrawText}(Handle, Details, Caption, CaptionRect, DT_LEFT, 0);
end;
end;
{$ENDIF}
procedure PaintGroupBox;
var
H: Integer;
R: TRect;
Flags: Longint;
begin
with Canvas do begin
H := WideCanvasTextHeight(Canvas, '0');
R := Rect(0, H div 2 - 1, Width, Height);
if Ctl3D then
begin
Inc(R.Left);
Inc(R.Top);
Brush.Color := clBtnHighlight;
FrameRect(R);
OffsetRect(R, -1, -1);
Brush.Color := clBtnShadow;
end else
Brush.Color := clWindowFrame;
FrameRect(R);
if Caption <> '' then
begin
if not UseRightToLeftAlignment then
R := Rect(8, 0, 0, H)
else
R := Rect(R.Right - WideCanvasTextWidth(Canvas, Caption) - 8, 0, 0, H);
Flags := DrawTextBiDiModeFlags(DT_SINGLELINE);
Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), R, Flags or DT_CALCRECT);
Brush.Color := Color;
Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), R, Flags);
end;
end;
end;
begin
if (not Win32PlatformIsUnicode) then
inherited
else
begin
Canvas.Font := Self.Font;
{$IFDEF THEME_7_UP}
if ThemeServices.ThemesEnabled then
PaintThemedGroupBox
else
PaintGroupBox;
{$ELSE}
PaintGroupBox;
{$ENDIF}
end;
end;
function TTntCustomGroupBox.IsHintStored: Boolean;
begin
Result := TntControl_IsHintStored(Self)
end;
function TTntCustomGroupBox.GetHint: WideString;
begin
Result := TntControl_GetHint(Self);
end;
procedure TTntCustomGroupBox.SetHint(const Value: WideString);
begin
TntControl_SetHint(Self, Value);
end;
procedure TTntCustomGroupBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
inherited;
end;
function TTntCustomGroupBox.GetActionLinkClass: TControlActionLinkClass;
begin
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;
{ TTntCustomStaticText }
constructor TTntCustomStaticText.Create(AOwner: TComponent);
begin
inherited;
AdjustBounds;
end;
procedure TTntCustomStaticText.CMFontChanged(var Message: TMessage);
begin
inherited;
AdjustBounds;
end;
procedure TTntCustomStaticText.CMTextChanged(var Message: TMessage);
begin
inherited;
AdjustBounds;
end;
procedure TTntCustomStaticText.Loaded;
begin
inherited;
AdjustBounds;
end;
procedure TTntCustomStaticText.SetAutoSize(AValue: boolean);
begin
inherited;
if AValue then
AdjustBounds;
end;
procedure TTntCustomStaticText.CreateWindowHandle(const Params: TCreateParams);
begin
CreateUnicodeHandle(Self, Params, 'STATIC');
end;
procedure TTntCustomStaticText.DefineProperties(Filer: TFiler);
begin
inherited;
TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
procedure TTntCustomStaticText.CMDialogChar(var Message: TCMDialogChar);
begin
if (FocusControl <> nil) and Enabled and ShowAccelChar and
IsWideCharAccel(Message.CharCode, Caption) then
with FocusControl do
if CanFocus then
begin
SetFocus;
Message.Result := 1;
end;
end;
function TTntCustomStaticText.IsCaptionStored: Boolean;
begin
Result := TntControl_IsCaptionStored(Self)
end;
procedure TTntCustomStaticText.AdjustBounds;
var
DC: HDC;
SaveFont: HFont;
TextSize: TSize;
begin
if not (csReading in ComponentState) and AutoSize then
begin
DC := GetDC(0);
SaveFont := SelectObject(DC, Font.Handle);
GetTextExtentPoint32W(DC, PWideChar(Caption), Length(Caption), TextSize);
SelectObject(DC, SaveFont);
ReleaseDC(0, DC);
SetBounds(Left, Top,
TextSize.cx + (GetSystemMetrics(SM_CXBORDER) * 4),
TextSize.cy + (GetSystemMetrics(SM_CYBORDER) * 4));
end;
end;
function TTntCustomStaticText.GetCaption: TWideCaption;
begin
Result := TntControl_GetText(Self)
end;
procedure TTntCustomStaticText.SetCaption(const Value: TWideCaption);
begin
TntControl_SetText(Self, Value);
end;
function TTntCustomStaticText.IsHintStored: Boolean;
begin
Result := TntControl_IsHintStored(Self)
end;
function TTntCustomStaticText.GetHint: WideString;
begin
Result := TntControl_GetHint(Self)
end;
procedure TTntCustomStaticText.SetHint(const Value: WideString);
begin
TntControl_SetHint(Self, Value);
end;
procedure TTntCustomStaticText.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
inherited;
end;
function TTntCustomStaticText.GetActionLinkClass: TControlActionLinkClass;
begin
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;
end.