{*****************************************************************************} { } { 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.