From 194923c172167eb3fc33807ec8009b255f86337e Mon Sep 17 00:00:00 2001 From: Vadim Dashevskiy Date: Mon, 8 Oct 2012 09:10:06 +0000 Subject: Plugin is not adapted until someone can compile it and tell others how to do the same git-svn-id: http://svn.miranda-ng.org/main/trunk@1809 1316c22d-e87f-b044-9b9b-93d7a3e3ba9c --- .../lib/TntUnicodeControls/Source/TntStdCtrls.pas | 3215 -------------------- 1 file changed, 3215 deletions(-) delete mode 100644 plugins/Chess4Net/lib/TntUnicodeControls/Source/TntStdCtrls.pas (limited to 'plugins/Chess4Net/lib/TntUnicodeControls/Source/TntStdCtrls.pas') diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntStdCtrls.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntStdCtrls.pas deleted file mode 100644 index 09c7da4573..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntStdCtrls.pas +++ /dev/null @@ -1,3215 +0,0 @@ - -{*****************************************************************************} -{ } -{ 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. -- cgit v1.2.3