Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

TntStdCtrls.pas@ 1083

Last change on this file since 1083 was 672, checked in by Kevin Toppenberg, 15 years ago
Adding source to tntControls for compilation
File size: 98.6 KB

Line
1
2	{*****************************************************************************}
3	{ }
4	{ Tnt Delphi Unicode Controls }
5	{ http://www.tntware.com/delphicontrols/unicode/ }
6	{ Version: 2.3.0 }
7	{ }
8	{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
9	{ }
10	{*****************************************************************************}
11
12	unit TntStdCtrls;
13
14	{$INCLUDE TntCompilers.inc}
15
16	interface
17
18	{ TODO: Implement TCustomListBox.KeyPress, OnDataFind. }
19
20	uses
21	Windows, Messages, Classes, Controls, TntControls, StdCtrls, Graphics,
22	TntClasses, TntSysUtils;
23
24	{TNT-WARN TCustomEdit}
25	type
26	TTntCustomEdit = class(TCustomEdit{TNT-ALLOW TCustomEdit})
27	private
28	FPasswordChar: WideChar;
29	procedure SetSelText(const Value: WideString);
30	function GetText: WideString;
31	procedure SetText(const Value: WideString);
32	function GetHint: WideString;
33	procedure SetHint(const Value: WideString);
34	function IsHintStored: Boolean;
35	function GetPasswordChar: WideChar;
36	procedure SetPasswordChar(const Value: WideChar);
37	protected
38	procedure CreateWindowHandle(const Params: TCreateParams); override;
39	procedure CreateWnd; override;
40	procedure DefineProperties(Filer: TFiler); override;
41	function GetActionLinkClass: TControlActionLinkClass; override;
42	procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
43	function GetSelStart: Integer; reintroduce; virtual;
44	procedure SetSelStart(const Value: Integer); reintroduce; virtual;
45	function GetSelLength: Integer; reintroduce; virtual;
46	procedure SetSelLength(const Value: Integer); reintroduce; virtual;
47	function GetSelText: WideString; reintroduce; virtual;
48	property PasswordChar: WideChar read GetPasswordChar write SetPasswordChar default #0;
49	public
50	property SelText: WideString read GetSelText write SetSelText;
51	property SelStart: Integer read GetSelStart write SetSelStart;
52	property SelLength: Integer read GetSelLength write SetSelLength;
53	property Text: WideString read GetText write SetText;
54	published
55	property Hint: WideString read GetHint write SetHint stored IsHintStored;
56	end;
57
58	{TNT-WARN TEdit}
59	TTntEdit = class(TTntCustomEdit)
60	published
61	property Align;
62	property Anchors;
63	property AutoSelect;
64	property AutoSize;
65	property BevelEdges;
66	property BevelInner;
67	property BevelKind default bkNone;
68	property BevelOuter;
69	property BevelWidth;
70	property BiDiMode;
71	property BorderStyle;
72	property CharCase;
73	property Color;
74	property Constraints;
75	property Ctl3D;
76	property DragCursor;
77	property DragKind;
78	property DragMode;
79	property Enabled;
80	property Font;
81	property HideSelection;
82	property ImeMode;
83	property ImeName;
84	property MaxLength;
85	property OEMConvert;
86	property ParentBiDiMode;
87	property ParentColor;
88	property ParentCtl3D;
89	property ParentFont;
90	property ParentShowHint;
91	property PasswordChar;
92	property PopupMenu;
93	property ReadOnly;
94	property ShowHint;
95	property TabOrder;
96	property TabStop;
97	property Text;
98	property Visible;
99	property OnChange;
100	property OnClick;
101	property OnContextPopup;
102	property OnDblClick;
103	property OnDragDrop;
104	property OnDragOver;
105	property OnEndDock;
106	property OnEndDrag;
107	property OnEnter;
108	property OnExit;
109	property OnKeyDown;
110	property OnKeyPress;
111	property OnKeyUp;
112	{$IFDEF COMPILER_9_UP}
113	property OnMouseActivate;
114	{$ENDIF}
115	property OnMouseDown;
116	{$IFDEF COMPILER_10_UP}
117	property OnMouseEnter;
118	property OnMouseLeave;
119	{$ENDIF}
120	property OnMouseMove;
121	property OnMouseUp;
122	property OnStartDock;
123	property OnStartDrag;
124	end;
125
126	type
127	TTntCustomMemo = class;
128
129	TTntMemoStrings = class(TTntStrings)
130	protected
131	FMemo: TCustomMemo{TNT-ALLOW TCustomMemo};
132	FMemoLines: TStrings{TNT-ALLOW TStrings};
133	FRichEditMode: Boolean;
134	FLineBreakStyle: TTntTextLineBreakStyle;
135	function Get(Index: Integer): WideString; override;
136	function GetCount: Integer; override;
137	function GetTextStr: WideString; override;
138	procedure Put(Index: Integer; const S: WideString); override;
139	procedure SetUpdateState(Updating: Boolean); override;
140	public
141	constructor Create;
142	procedure SetTextStr(const Value: WideString); override;
143	procedure Clear; override;
144	procedure Delete(Index: Integer); override;
145	procedure Insert(Index: Integer; const S: WideString); override;
146	end;
147
148	{TNT-WARN TCustomMemo}
149	TTntCustomMemo = class(TCustomMemo{TNT-ALLOW TCustomMemo})
150	private
151	FLines: TTntStrings;
152	procedure SetSelText(const Value: WideString);
153	function GetText: WideString;
154	procedure SetText(const Value: WideString);
155	function GetHint: WideString;
156	procedure SetHint(const Value: WideString);
157	function IsHintStored: Boolean;
158	protected
159	procedure CreateWindowHandle(const Params: TCreateParams); override;
160	procedure DefineProperties(Filer: TFiler); override;
161	function GetActionLinkClass: TControlActionLinkClass; override;
162	procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
163	procedure SetLines(const Value: TTntStrings); virtual;
164	function GetSelStart: Integer; reintroduce; virtual;
165	procedure SetSelStart(const Value: Integer); reintroduce; virtual;
166	function GetSelLength: Integer; reintroduce; virtual;
167	procedure SetSelLength(const Value: Integer); reintroduce; virtual;
168	function GetSelText: WideString; reintroduce;
169	public
170	constructor Create(AOwner: TComponent); override;
171	destructor Destroy; override;
172	property SelText: WideString read GetSelText write SetSelText;
173	property SelStart: Integer read GetSelStart write SetSelStart;
174	property SelLength: Integer read GetSelLength write SetSelLength;
175	property Text: WideString read GetText write SetText;
176	property Lines: TTntStrings read FLines write SetLines;
177	published
178	property Hint: WideString read GetHint write SetHint stored IsHintStored;
179	end;
180
181	{TNT-WARN TMemo}
182	TTntMemo = class(TTntCustomMemo)
183	published
184	property Align;
185	property Alignment;
186	property Anchors;
187	property BevelEdges;
188	property BevelInner;
189	property BevelKind default bkNone;
190	property BevelOuter;
191	property BiDiMode;
192	property BorderStyle;
193	property Color;
194	property Constraints;
195	property Ctl3D;
196	property DragCursor;
197	property DragKind;
198	property DragMode;
199	property Enabled;
200	property Font;
201	property HideSelection;
202	property ImeMode;
203	property ImeName;
204	property Lines;
205	property MaxLength;
206	property OEMConvert;
207	property ParentBiDiMode;
208	property ParentColor;
209	property ParentCtl3D;
210	property ParentFont;
211	property ParentShowHint;
212	property PopupMenu;
213	property ReadOnly;
214	property ScrollBars;
215	property ShowHint;
216	property TabOrder;
217	property TabStop;
218	property Visible;
219	property WantReturns;
220	property WantTabs;
221	property WordWrap;
222	property OnChange;
223	property OnClick;
224	property OnContextPopup;
225	property OnDblClick;
226	property OnDragDrop;
227	property OnDragOver;
228	property OnEndDock;
229	property OnEndDrag;
230	property OnEnter;
231	property OnExit;
232	property OnKeyDown;
233	property OnKeyPress;
234	property OnKeyUp;
235	{$IFDEF COMPILER_9_UP}
236	property OnMouseActivate;
237	{$ENDIF}
238	property OnMouseDown;
239	{$IFDEF COMPILER_10_UP}
240	property OnMouseEnter;
241	property OnMouseLeave;
242	{$ENDIF}
243	property OnMouseMove;
244	property OnMouseUp;
245	property OnStartDock;
246	property OnStartDrag;
247	end;
248
249	TTntComboBoxStrings = class(TTntStrings)
250	protected
251	function Get(Index: Integer): WideString; override;
252	function GetCount: Integer; override;
253	function GetObject(Index: Integer): TObject; override;
254	procedure PutObject(Index: Integer; AObject: TObject); override;
255	procedure SetUpdateState(Updating: Boolean); override;
256	public
257	ComboBox: TCustomComboBox{TNT-ALLOW TCustomComboBox};
258	function Add(const S: WideString): Integer; override;
259	procedure Clear; override;
260	procedure Delete(Index: Integer); override;
261	function IndexOf(const S: WideString): Integer; override;
262	procedure Insert(Index: Integer; const S: WideString); override;
263	end;
264
265	type
266	TWMCharMsgHandler = procedure(var Message: TWMChar) of object;
267
268	{$IFDEF DELPHI_7} // fix for Delphi 7 only
269	{ TD7PatchedComboBoxStrings }
270	type
271	TD7PatchedComboBoxStrings = class(TCustomComboBoxStrings)
272	protected
273	function Get(Index: Integer): string{TNT-ALLOW string}; override;
274	public
275	function Add(const S: string{TNT-ALLOW string}): Integer; override;
276	procedure Insert(Index: Integer; const S: string{TNT-ALLOW string}); override;
277	end;
278	{$ENDIF}
279
280	type
281	ITntComboFindString = interface
282	['{63BEBEF4-B1A2-495A-B558-7487B66F6827}']
283	function FindString(const Value: WideString; StartPos: Integer): Integer;
284	end;
285
286	{TNT-WARN TCustomComboBox}
287	type
288	TTntCustomComboBox = class(TCustomComboBox{TNT-ALLOW TCustomComboBox},
289	IWideCustomListControl)
290	private
291	FItems: TTntStrings;
292	FSaveItems: TTntStrings;
293	FSaveItemIndex: Integer;
294	FFilter: WideString;
295	FLastTime: Cardinal;
296	function GetItems: TTntStrings;
297	function GetSelStart: Integer;
298	procedure SetSelStart(const Value: Integer);
299	function GetSelLength: Integer;
300	procedure SetSelLength(const Value: Integer);
301	function GetSelText: WideString;
302	procedure SetSelText(const Value: WideString);
303	function GetText: WideString;
304	procedure SetText(const Value: WideString);
305	procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
306	function GetHint: WideString;
307	procedure SetHint(const Value: WideString);
308	function IsHintStored: Boolean;
309	procedure WMChar(var Message: TWMChar); message WM_CHAR;
310	protected
311	procedure CreateWindowHandle(const Params: TCreateParams); override;
312	procedure DefineProperties(Filer: TFiler); override;
313	function GetActionLinkClass: TControlActionLinkClass; override;
314	procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
315	procedure DestroyWnd; override;
316	function GetAutoComplete_UniqueMatchOnly: Boolean; dynamic;
317	function GetAutoComplete_PreserveDataEntryCase: Boolean; dynamic;
318	procedure DoEditCharMsg(var Message: TWMChar); virtual;
319	procedure CreateWnd; override;
320	procedure ComboWndProc(var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer); override;
321	procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
322	procedure KeyPress(var Key: AnsiChar); override;
323	{$IFDEF DELPHI_7} // fix for Delphi 7 only
324	function GetItemsClass: TCustomComboBoxStringsClass; override;
325	{$ENDIF}
326	procedure SetItems(const Value: TTntStrings); reintroduce; virtual;
327	public
328	constructor Create(AOwner: TComponent); override;
329	destructor Destroy; override;
330	procedure CopySelection(Destination: TCustomListControl); override;
331	procedure AddItem(const Item: WideString; AObject: TObject); reintroduce; virtual;
332	public
333	property SelText: WideString read GetSelText write SetSelText;
334	property SelStart: Integer read GetSelStart write SetSelStart;
335	property SelLength: Integer read GetSelLength write SetSelLength;
336	property Text: WideString read GetText write SetText;
337	property Items: TTntStrings read GetItems write SetItems;
338	published
339	property Hint: WideString read GetHint write SetHint stored IsHintStored;
340	end;
341
342	{TNT-WARN TComboBox}
343	TTntComboBox = class(TTntCustomComboBox)
344	published
345	property Align;
346	property AutoComplete default True;
347	{$IFDEF COMPILER_9_UP}
348	property AutoCompleteDelay default 500;
349	{$ENDIF}
350	property AutoDropDown default False;
351	{$IFDEF COMPILER_7_UP}
352	property AutoCloseUp default False;
353	{$ENDIF}
354	property BevelEdges;
355	property BevelInner;
356	property BevelKind default bkNone;
357	property BevelOuter;
358	property Style; {Must be published before Items}
359	property Anchors;
360	property BiDiMode;
361	property CharCase;
362	property Color;
363	property Constraints;
364	property Ctl3D;
365	property DragCursor;
366	property DragKind;
367	property DragMode;
368	property DropDownCount;
369	property Enabled;
370	property Font;
371	property ImeMode;
372	property ImeName;
373	property ItemHeight;
374	property ItemIndex default -1;
375	property MaxLength;
376	property ParentBiDiMode;
377	property ParentColor;
378	property ParentCtl3D;
379	property ParentFont;
380	property ParentShowHint;
381	property PopupMenu;
382	property ShowHint;
383	property Sorted;
384	property TabOrder;
385	property TabStop;
386	property Text;
387	property Visible;
388	property OnChange;
389	property OnClick;
390	property OnCloseUp;
391	property OnContextPopup;
392	property OnDblClick;
393	property OnDragDrop;
394	property OnDragOver;
395	property OnDrawItem;
396	property OnDropDown;
397	property OnEndDock;
398	property OnEndDrag;
399	property OnEnter;
400	property OnExit;
401	property OnKeyDown;
402	property OnKeyPress;
403	property OnKeyUp;
404	property OnMeasureItem;
405	{$IFDEF COMPILER_10_UP}
406	property OnMouseEnter;
407	property OnMouseLeave;
408	{$ENDIF}
409	property OnSelect;
410	property OnStartDock;
411	property OnStartDrag;
412	property Items; { Must be published after OnMeasureItem }
413	end;
414
415	TLBGetWideDataEvent = procedure(Control: TWinControl; Index: Integer;
416	var Data: WideString) of object;
417
418	TAccessCustomListBox = class(TCustomListBox{TNT-ALLOW TCustomListBox});
419
420	TTntListBoxStrings = class(TTntStrings)
421	private
422	FListBox: TAccessCustomListBox;
423	function GetListBox: TCustomListBox{TNT-ALLOW TCustomListBox};
424	procedure SetListBox(const Value: TCustomListBox{TNT-ALLOW TCustomListBox});
425	protected
426	procedure Put(Index: Integer; const S: WideString); override;
427	function Get(Index: Integer): WideString; override;
428	function GetCount: Integer; override;
429	function GetObject(Index: Integer): TObject; override;
430	procedure PutObject(Index: Integer; AObject: TObject); override;
431	procedure SetUpdateState(Updating: Boolean); override;
432	public
433	function Add(const S: WideString): Integer; override;
434	procedure Clear; override;
435	procedure Delete(Index: Integer); override;
436	procedure Exchange(Index1, Index2: Integer); override;
437	function IndexOf(const S: WideString): Integer; override;
438	procedure Insert(Index: Integer; const S: WideString); override;
439	procedure Move(CurIndex, NewIndex: Integer); override;
440	property ListBox: TCustomListBox{TNT-ALLOW TCustomListBox} read GetListBox write SetListBox;
441	end;
442
443	{TNT-WARN TCustomListBox}
444	type
445	TTntCustomListBox = class(TCustomListBox{TNT-ALLOW TCustomListBox}, IWideCustomListControl)
446	private
447	FItems: TTntStrings;
448	FSaveItems: TTntStrings;
449	FSaveTopIndex: Integer;
450	FSaveItemIndex: Integer;
451	FOnData: TLBGetWideDataEvent;
452	procedure SetItems(const Value: TTntStrings);
453	function GetHint: WideString;
454	procedure SetHint(const Value: WideString);
455	function IsHintStored: Boolean;
456	procedure LBGetText(var Message: TMessage); message LB_GETTEXT;
457	procedure LBGetTextLen(var Message: TMessage); message LB_GETTEXTLEN;
458	protected
459	procedure CreateWindowHandle(const Params: TCreateParams); override;
460	procedure DefineProperties(Filer: TFiler); override;
461	function GetActionLinkClass: TControlActionLinkClass; override;
462	procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
463	procedure CreateWnd; override;
464	procedure DestroyWnd; override;
465	procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
466	property OnData: TLBGetWideDataEvent read FOnData write FOnData;
467	public
468	constructor Create(AOwner: TComponent); override;
469	destructor Destroy; override;
470	procedure CopySelection(Destination: TCustomListControl); override;
471	procedure AddItem(const Item: WideString; AObject: TObject); reintroduce; virtual;
472	property Items: TTntStrings read FItems write SetItems;
473	published
474	property Hint: WideString read GetHint write SetHint stored IsHintStored;
475	end;
476
477	{TNT-WARN TListBox}
478	TTntListBox = class(TTntCustomListBox)
479	published
480	property Style;
481	property AutoComplete;
482	{$IFDEF COMPILER_9_UP}
483	property AutoCompleteDelay;
484	{$ENDIF}
485	property Align;
486	property Anchors;
487	property BevelEdges;
488	property BevelInner;
489	property BevelKind default bkNone;
490	property BevelOuter;
491	property BevelWidth;
492	property BiDiMode;
493	property BorderStyle;
494	property Color;
495	property Columns;
496	property Constraints;
497	property Ctl3D;
498	property DragCursor;
499	property DragKind;
500	property DragMode;
501	property Enabled;
502	property ExtendedSelect;
503	property Font;
504	property ImeMode;
505	property ImeName;
506	property IntegralHeight;
507	property ItemHeight;
508	property Items;
509	property MultiSelect;
510	property ParentBiDiMode;
511	property ParentColor;
512	property ParentCtl3D;
513	property ParentFont;
514	property ParentShowHint;
515	property PopupMenu;
516	property ScrollWidth;
517	property ShowHint;
518	property Sorted;
519	property TabOrder;
520	property TabStop;
521	property TabWidth;
522	property Visible;
523	property OnClick;
524	property OnContextPopup;
525	property OnData;
526	property OnDataFind;
527	property OnDataObject;
528	property OnDblClick;
529	property OnDragDrop;
530	property OnDragOver;
531	property OnDrawItem;
532	property OnEndDock;
533	property OnEndDrag;
534	property OnEnter;
535	property OnExit;
536	property OnKeyDown;
537	property OnKeyPress;
538	property OnKeyUp;
539	property OnMeasureItem;
540	{$IFDEF COMPILER_9_UP}
541	property OnMouseActivate;
542	{$ENDIF}
543	property OnMouseDown;
544	{$IFDEF COMPILER_10_UP}
545	property OnMouseEnter;
546	property OnMouseLeave;
547	{$ENDIF}
548	property OnMouseMove;
549	property OnMouseUp;
550	property OnStartDock;
551	property OnStartDrag;
552	end;
553
554	{TNT-WARN TCustomLabel}
555	TTntCustomLabel = class(TCustomLabel{TNT-ALLOW TCustomLabel})
556	private
557	function GetCaption: TWideCaption;
558	procedure SetCaption(const Value: TWideCaption);
559	function GetHint: WideString;
560	procedure SetHint(const Value: WideString);
561	function IsCaptionStored: Boolean;
562	function IsHintStored: Boolean;
563	procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
564	procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
565	protected
566	procedure DefineProperties(Filer: TFiler); override;
567	function GetActionLinkClass: TControlActionLinkClass; override;
568	procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
569	function GetLabelText: WideString; reintroduce; virtual;
570	procedure DoDrawText(var Rect: TRect; Flags: Longint); override;
571	property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
572	published
573	property Hint: WideString read GetHint write SetHint stored IsHintStored;
574	end;
575
576	{TNT-WARN TLabel}
577	TTntLabel = class(TTntCustomLabel)
578	published
579	property Align;
580	property Alignment;
581	property Anchors;
582	property AutoSize;
583	property BiDiMode;
584	property Caption;
585	property Color {$IFDEF COMPILER_7_UP} nodefault {$ENDIF};
586	property Constraints;
587	property DragCursor;
588	property DragKind;
589	property DragMode;
590	{$IFDEF COMPILER_9_UP}
591	property EllipsisPosition;
592	{$ENDIF}
593	property Enabled;
594	property FocusControl;
595	property Font;
596	property ParentBiDiMode;
597	property ParentColor;
598	property ParentFont;
599	property ParentShowHint;
600	property PopupMenu;
601	property ShowAccelChar;
602	property ShowHint;
603	property Transparent;
604	property Layout;
605	property Visible;
606	property WordWrap;
607	property OnClick;
608	property OnContextPopup;
609	property OnDblClick;
610	property OnDragDrop;
611	property OnDragOver;
612	property OnEndDock;
613	property OnEndDrag;
614	{$IFDEF COMPILER_9_UP}
615	property OnMouseActivate;
616	{$ENDIF}
617	property OnMouseDown;
618	property OnMouseMove;
619	property OnMouseUp;
620	property OnMouseEnter;
621	property OnMouseLeave;
622	property OnStartDock;
623	property OnStartDrag;
624	end;
625
626	{TNT-WARN TButton}
627	TTntButton = class(TButton{TNT-ALLOW TButton})
628	private
629	function GetCaption: TWideCaption;
630	procedure SetCaption(const Value: TWideCaption);
631	function GetHint: WideString;
632	procedure SetHint(const Value: WideString);
633	function IsCaptionStored: Boolean;
634	function IsHintStored: Boolean;
635	procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
636	protected
637	procedure CreateWindowHandle(const Params: TCreateParams); override;
638	procedure DefineProperties(Filer: TFiler); override;
639	function GetActionLinkClass: TControlActionLinkClass; override;
640	procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
641	published
642	property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
643	property Hint: WideString read GetHint write SetHint stored IsHintStored;
644	end;
645
646	{TNT-WARN TCustomCheckBox}
647	TTntCustomCheckBox = class(TCustomCheckBox{TNT-ALLOW TCustomCheckBox})
648	private
649	function GetCaption: TWideCaption;
650	procedure SetCaption(const Value: TWideCaption);
651	function GetHint: WideString;
652	procedure SetHint(const Value: WideString);
653	function IsCaptionStored: Boolean;
654	function IsHintStored: Boolean;
655	procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
656	protected
657	procedure CreateWindowHandle(const Params: TCreateParams); override;
658	procedure DefineProperties(Filer: TFiler); override;
659	function GetActionLinkClass: TControlActionLinkClass; override;
660	procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
661	public
662	property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
663	published
664	property Hint: WideString read GetHint write SetHint stored IsHintStored;
665	end;
666
667	{TNT-WARN TCheckBox}
668	TTntCheckBox = class(TTntCustomCheckBox)
669	published
670	property Action;
671	property Align;
672	property Alignment;
673	property AllowGrayed;
674	property Anchors;
675	property BiDiMode;
676	property Caption;
677	property Checked;
678	property Color {$IFDEF COMPILER_7_UP} nodefault {$ENDIF};
679	property Constraints;
680	property Ctl3D;
681	property DragCursor;
682	property DragKind;
683	property DragMode;
684	property Enabled;
685	property Font;
686	property ParentBiDiMode;
687	property ParentColor;
688	property ParentCtl3D;
689	property ParentFont;
690	property ParentShowHint;
691	property PopupMenu;
692	property ShowHint;
693	property State;
694	property TabOrder;
695	property TabStop;
696	property Visible;
697	{$IFDEF COMPILER_7_UP}
698	property WordWrap;
699	{$ENDIF}
700	property OnClick;
701	property OnContextPopup;
702	property OnDragDrop;
703	property OnDragOver;
704	property OnEndDock;
705	property OnEndDrag;
706	property OnEnter;
707	property OnExit;
708	property OnKeyDown;
709	property OnKeyPress;
710	property OnKeyUp;
711	{$IFDEF COMPILER_9_UP}
712	property OnMouseActivate;
713	{$ENDIF}
714	property OnMouseDown;
715	{$IFDEF COMPILER_10_UP}
716	property OnMouseEnter;
717	property OnMouseLeave;
718	{$ENDIF}
719	property OnMouseMove;
720	property OnMouseUp;
721	property OnStartDock;
722	property OnStartDrag;
723	end;
724
725	{TNT-WARN TRadioButton}
726	TTntRadioButton = class(TRadioButton{TNT-ALLOW TRadioButton})
727	private
728	function GetCaption: TWideCaption;
729	procedure SetCaption(const Value: TWideCaption);
730	function GetHint: WideString;
731	procedure SetHint(const Value: WideString);
732	function IsCaptionStored: Boolean;
733	function IsHintStored: Boolean;
734	procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
735	protected
736	procedure CreateWindowHandle(const Params: TCreateParams); override;
737	procedure DefineProperties(Filer: TFiler); override;
738	function GetActionLinkClass: TControlActionLinkClass; override;
739	procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
740	published
741	property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
742	property Hint: WideString read GetHint write SetHint stored IsHintStored;
743	end;
744
745	{TNT-WARN TScrollBar}
746	TTntScrollBar = class(TScrollBar{TNT-ALLOW TScrollBar})
747	private
748	function GetHint: WideString;
749	procedure SetHint(const Value: WideString);
750	function IsHintStored: Boolean;
751	protected
752	procedure CreateWindowHandle(const Params: TCreateParams); override;
753	procedure DefineProperties(Filer: TFiler); override;
754	function GetActionLinkClass: TControlActionLinkClass; override;
755	procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
756	published
757	property Hint: WideString read GetHint write SetHint stored IsHintStored;
758	end;
759
760	{TNT-WARN TCustomGroupBox}
761	TTntCustomGroupBox = class(TCustomGroupBox{TNT-ALLOW TCustomGroupBox})
762	private
763	function GetCaption: TWideCaption;
764	procedure SetCaption(const Value: TWideCaption);
765	function GetHint: WideString;
766	procedure SetHint(const Value: WideString);
767	function IsCaptionStored: Boolean;
768	function IsHintStored: Boolean;
769	procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
770	protected
771	procedure Paint; override;
772	procedure CreateWindowHandle(const Params: TCreateParams); override;
773	procedure DefineProperties(Filer: TFiler); override;
774	function GetActionLinkClass: TControlActionLinkClass; override;
775	procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
776	property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
777	published
778	property Hint: WideString read GetHint write SetHint stored IsHintStored;
779	end;
780
781	{TNT-WARN TGroupBox}
782	TTntGroupBox = class(TTntCustomGroupBox)
783	published
784	property Align;
785	property Anchors;
786	property BiDiMode;
787	property Caption;
788	property Color;
789	property Constraints;
790	property Ctl3D;
791	property DockSite;
792	property DragCursor;
793	property DragKind;
794	property DragMode;
795	property Enabled;
796	property Font;
797	{$IFDEF COMPILER_10_UP}
798	property Padding;
799	{$ENDIF}
800	{$IFDEF COMPILER_7_UP}
801	property ParentBackground default True;
802	{$ENDIF}
803	property ParentBiDiMode;
804	property ParentColor;
805	property ParentCtl3D;
806	property ParentFont;
807	property ParentShowHint;
808	property PopupMenu;
809	property ShowHint;
810	property TabOrder;
811	property TabStop;
812	property Visible;
813	{$IFDEF COMPILER_9_UP}
814	property OnAlignInsertBefore;
815	property OnAlignPosition;
816	{$ENDIF}
817	property OnClick;
818	property OnContextPopup;
819	property OnDblClick;
820	property OnDragDrop;
821	property OnDockDrop;
822	property OnDockOver;
823	property OnDragOver;
824	property OnEndDock;
825	property OnEndDrag;
826	property OnEnter;
827	property OnExit;
828	property OnGetSiteInfo;
829	{$IFDEF COMPILER_9_UP}
830	property OnMouseActivate;
831	{$ENDIF}
832	property OnMouseDown;
833	{$IFDEF COMPILER_10_UP}
834	property OnMouseEnter;
835	property OnMouseLeave;
836	{$ENDIF}
837	property OnMouseMove;
838	property OnMouseUp;
839	property OnStartDock;
840	property OnStartDrag;
841	property OnUnDock;
842	end;
843
844	{TNT-WARN TCustomStaticText}
845	TTntCustomStaticText = class(TCustomStaticText{TNT-ALLOW TCustomStaticText})
846	private
847	procedure AdjustBounds;
848	function GetCaption: TWideCaption;
849	procedure SetCaption(const Value: TWideCaption);
850	function GetHint: WideString;
851	procedure SetHint(const Value: WideString);
852	function IsCaptionStored: Boolean;
853	function IsHintStored: Boolean;
854	procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
855	protected
856	procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
857	procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
858	procedure Loaded; override;
859	procedure SetAutoSize(AValue: boolean); override;
860	procedure CreateWindowHandle(const Params: TCreateParams); override;
861	procedure DefineProperties(Filer: TFiler); override;
862	function GetActionLinkClass: TControlActionLinkClass; override;
863	procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
864	property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
865	public
866	constructor Create(AOwner: TComponent); override;
867	published
868	property Hint: WideString read GetHint write SetHint stored IsHintStored;
869	end;
870
871	{TNT-WARN TStaticText}
872	TTntStaticText = class(TTntCustomStaticText)
873	published
874	property Align;
875	property Alignment;
876	property Anchors;
877	property AutoSize;
878	property BevelEdges;
879	property BevelInner;
880	property BevelKind default bkNone;
881	property BevelOuter;
882	property BiDiMode;
883	property BorderStyle;
884	property Caption;
885	property Color {$IFDEF COMPILER_7_UP} nodefault {$ENDIF};
886	property Constraints;
887	property DragCursor;
888	property DragKind;
889	property DragMode;
890	property Enabled;
891	property FocusControl;
892	property Font;
893	property ParentBiDiMode;
894	property ParentColor;
895	property ParentFont;
896	property ParentShowHint;
897	property PopupMenu;
898	property ShowAccelChar;
899	property ShowHint;
900	property TabOrder;
901	property TabStop;
902	{$IFDEF COMPILER_7_UP}
903	property Transparent;
904	{$ENDIF}
905	property Visible;
906	property OnClick;
907	property OnContextPopup;
908	property OnDblClick;
909	property OnDragDrop;
910	property OnDragOver;
911	property OnEndDock;
912	property OnEndDrag;
913	{$IFDEF COMPILER_9_UP}
914	property OnMouseActivate;
915	{$ENDIF}
916	property OnMouseDown;
917	{$IFDEF COMPILER_10_UP}
918	property OnMouseEnter;
919	property OnMouseLeave;
920	{$ENDIF}
921	property OnMouseMove;
922	property OnMouseUp;
923	property OnStartDock;
924	property OnStartDrag;
925	end;
926
927	procedure TntCombo_AfterInherited_CreateWnd(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
928	Items: TTntStrings; var FSaveItems: TTntStrings; FSaveItemIndex: integer; PreInheritedAnsiText: AnsiString);
929	procedure TntCombo_BeforeInherited_DestroyWnd(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
930	Items: TTntStrings; var FSaveItems: TTntStrings; ItemIndex: integer; var FSaveItemIndex: integer;
931	var SavedText: WideString);
932	function TntCombo_ComboWndProc(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
933	var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer; DoEditCharMsg: TWMCharMsgHandler): Boolean;
934	function TntCombo_CNCommand(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; Items: TTntStrings; var Message: TWMCommand): Boolean;
935	function TntCombo_GetSelStart(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}): Integer;
936	procedure TntCombo_SetSelStart(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; const Value: Integer);
937	function TntCombo_GetSelLength(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}): Integer;
938	procedure TntCombo_SetSelLength(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; const Value: Integer);
939	function TntCombo_GetSelText(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}): WideString;
940	procedure TntCombo_SetSelText(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; const Value: WideString);
941	procedure TntCombo_BeforeKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; var SaveAutoComplete: Boolean);
942	procedure TntCombo_AfterKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; var SaveAutoComplete: Boolean);
943	procedure TntCombo_DropDown_PreserveSelection(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox});
944	procedure TntComboBox_AddItem(Items: TTntStrings; const Item: WideString; AObject: TObject);
945	procedure TntComboBox_CopySelection(Items: TTntStrings; ItemIndex: Integer;
946	Destination: TCustomListControl);
947	procedure TntCombo_AutoSearchKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
948	Items: TTntStrings; var Message: TWMChar; var FFilter: WideString; var FLastTime: Cardinal);
949	procedure TntCombo_AutoCompleteKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
950	Items: TTntStrings; var Message: TWMChar;
951	AutoComplete_UniqueMatchOnly, AutoComplete_PreserveDataEntryCase: Boolean);
952	procedure TntCombo_DefaultDrawItem(Canvas: TCanvas; Index: Integer; Rect: TRect;
953	State: TOwnerDrawState; Items: TTntStrings);
954
955	procedure TntCustomEdit_CreateWindowHandle(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Params: TCreateParams);
956	procedure TntCustomEdit_AfterInherited_CreateWnd(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; var FPasswordChar: WideChar);
957	function TntCustomEdit_GetSelStart(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}): Integer;
958	procedure TntCustomEdit_SetSelStart(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Value: Integer);
959	function TntCustomEdit_GetSelLength(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}): Integer;
960	procedure TntCustomEdit_SetSelLength(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Value: Integer);
961	function TntCustomEdit_GetSelText(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}): WideString;
962	procedure TntCustomEdit_SetSelText(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Value: WideString);
963	function TntCustomEdit_GetPasswordChar(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; var FPasswordChar: WideChar): WideChar;
964	procedure TntCustomEdit_SetPasswordChar(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; var FPasswordChar: WideChar; const Value: WideChar);
965
966
967	function TntMemo_LineStart(Handle: THandle; Index: Integer): Integer;
968	function TntMemo_LineLength(Handle: THandle; Index: Integer; StartPos: Integer = -1): Integer;
969
970	procedure TntListBox_AfterInherited_CreateWnd(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox};
971	var FSaveItems: TTntStrings; FItems: TTntStrings; FSaveTopIndex, FSaveItemIndex: Integer);
972	procedure TntListBox_BeforeInherited_DestroyWnd(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox};
973	var FSaveItems: TTntStrings; const FItems: TTntStrings; var FSaveTopIndex, FSaveItemIndex: Integer);
974	procedure TntListBox_DrawItem_Text(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox}; Items: TTntStrings; Index: Integer; Rect: TRect);
975	procedure TntListBox_AddItem(Items: TTntStrings; const Item: WideString; AObject: TObject);
976	procedure TntListBox_CopySelection(ListBox: TCustomListbox{TNT-ALLOW TCustomListbox};
977	Items: TTntStrings; Destination: TCustomListControl);
978	function TntCustomListBox_LBGetText(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox}; OnData: TLBGetWideDataEvent; var Message: TMessage): Boolean;
979	function TntCustomListBox_LBGetTextLen(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox}; OnData: TLBGetWideDataEvent; var Message: TMessage): Boolean;
980
981	function TntLabel_DoDrawText(Control: TCustomLabel{TNT-ALLOW TCustomLabel}; var Rect: TRect; Flags: Integer; const GetLabelText: WideString): Boolean;
982	procedure TntLabel_CMDialogChar(Control: TCustomLabel{TNT-ALLOW TCustomLabel}; var Message: TCMDialogChar; const Caption: WideString);
983
984	procedure TntButton_CMDialogChar(Button: TButton{TNT-ALLOW TButton}; var Message: TCMDialogChar);
985
986	implementation
987
988	uses
989	Forms, SysUtils, Consts, RichEdit, ComStrs,
990	RTLConsts, {$IFDEF THEME_7_UP} Themes, {$ENDIF}
991	TntForms, TntGraphics, TntActnList, TntWindows,
992	{$IFDEF COMPILER_9_UP} WideStrUtils, {$ENDIF} TntWideStrUtils;
993
994	{ TTntCustomEdit }
995
996	procedure TntCustomEdit_CreateWindowHandle(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Params: TCreateParams);
997	var
998	P: TCreateParams;
999	begin
1000	if SysLocale.FarEast
1001	and (not Win32PlatformIsUnicode)
1002	and ((Params.Style and ES_READONLY) <> 0) then begin
1003	// Work around Far East Win95 API/IME bug.
1004	P := Params;
1005	P.Style := P.Style and (not ES_READONLY);
1006	CreateUnicodeHandle(Edit, P, 'EDIT');
1007	if Edit.HandleAllocated then
1008	SendMessage(Edit.Handle, EM_SETREADONLY, Ord(True), 0);
1009	end else
1010	CreateUnicodeHandle(Edit, Params, 'EDIT');
1011	end;
1012
1013	procedure TntCustomEdit_AfterInherited_CreateWnd(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; var FPasswordChar: WideChar);
1014	var
1015	PasswordChar: WideChar;
1016	begin
1017	PasswordChar := TntCustomEdit_GetPasswordChar(Edit, FPasswordChar);
1018	if Win32PlatformIsUnicode then
1019	SendMessageW(Edit.Handle, EM_SETPASSWORDCHAR, Ord(PasswordChar), 0);
1020	end;
1021
1022	function TntCustomEdit_GetSelStart(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}): Integer;
1023	begin
1024	if Win32PlatformIsUnicode then
1025	Result := Edit.SelStart
1026	else
1027	Result := Length(WideString(Copy(Edit.Text, 1, Edit.SelStart)));
1028	end;
1029
1030	procedure TntCustomEdit_SetSelStart(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Value: Integer);
1031	begin
1032	if Win32PlatformIsUnicode then
1033	Edit.SelStart := Value
1034	else
1035	Edit.SelStart := Length(AnsiString(Copy(TntControl_GetText(Edit), 1, Value)));
1036	end;
1037
1038	function TntCustomEdit_GetSelLength(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}): Integer;
1039	begin
1040	if Win32PlatformIsUnicode then
1041	Result := Edit.SelLength
1042	else
1043	Result := Length(TntCustomEdit_GetSelText(Edit));
1044	end;
1045
1046	procedure TntCustomEdit_SetSelLength(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Value: Integer);
1047	var
1048	StartPos: Integer;
1049	begin
1050	if Win32PlatformIsUnicode then
1051	Edit.SelLength := Value
1052	else begin
1053	StartPos := TntCustomEdit_GetSelStart(Edit);
1054	Edit.SelLength := Length(AnsiString(Copy(TntControl_GetText(Edit), StartPos + 1, Value)));
1055	end;
1056	end;
1057
1058	function TntCustomEdit_GetSelText(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}): WideString;
1059	begin
1060	if Win32PlatformIsUnicode then
1061	Result := Copy(TntControl_GetText(Edit), Edit.SelStart + 1, Edit.SelLength)
1062	else
1063	Result := Edit.SelText
1064	end;
1065
1066	procedure TntCustomEdit_SetSelText(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Value: WideString);
1067	begin
1068	if Win32PlatformIsUnicode then
1069	SendMessageW(Edit.Handle, EM_REPLACESEL, 0, Longint(PWideChar(Value)))
1070	else
1071	Edit.SelText := Value;
1072	end;
1073
1074	function WideCharToAnsiChar(const C: WideChar): AnsiChar;
1075	begin
1076	if C <= High(AnsiChar) then
1077	Result := AnsiChar(C)
1078	else
1079	Result := '*';
1080	end;
1081
1082	type TAccessCustomEdit = class(TCustomEdit{TNT-ALLOW TCustomEdit});
1083
1084	function TntCustomEdit_GetPasswordChar(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; var FPasswordChar: WideChar): WideChar;
1085	begin
1086	if TAccessCustomEdit(Edit).PasswordChar <> WideCharToAnsiChar(FPasswordChar) then
1087	FPasswordChar := WideChar(TAccessCustomEdit(Edit).PasswordChar);
1088	Result := FPasswordChar;
1089	end;
1090
1091	procedure TntCustomEdit_SetPasswordChar(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; var FPasswordChar: WideChar; const Value: WideChar);
1092	var
1093	SaveWindowHandle: Integer;
1094	PasswordCharSetHere: Boolean;
1095	begin
1096	if TntCustomEdit_GetPasswordChar(Edit, FPasswordChar) <> Value then
1097	begin
1098	FPasswordChar := Value;
1099	PasswordCharSetHere := Win32PlatformIsUnicode and Edit.HandleAllocated;
1100	SaveWindowHandle := TAccessCustomEdit(Edit).WindowHandle;
1101	try
1102	if PasswordCharSetHere then
1103	TAccessCustomEdit(Edit).WindowHandle := 0; // this prevents TCustomEdit from actually changing it
1104	TAccessCustomEdit(Edit).PasswordChar := WideCharToAnsiChar(FPasswordChar);
1105	finally
1106	TAccessCustomEdit(Edit).WindowHandle := SaveWindowHandle;
1107	end;
1108	if PasswordCharSetHere then
1109	begin
1110	Assert(Win32PlatformIsUnicode);
1111	Assert(Edit.HandleAllocated);
1112	SendMessageW(Edit.Handle, EM_SETPASSWORDCHAR, Ord(FPasswordChar), 0);
1113	Edit.Invalidate;
1114	end;
1115	end;
1116	end;
1117
1118	procedure TTntCustomEdit.CreateWindowHandle(const Params: TCreateParams);
1119	begin
1120	TntCustomEdit_CreateWindowHandle(Self, Params);
1121	end;
1122
1123	procedure TTntCustomEdit.CreateWnd;
1124	begin
1125	inherited;
1126	TntCustomEdit_AfterInherited_CreateWnd(Self, FPasswordChar);
1127	end;
1128
1129	procedure TTntCustomEdit.DefineProperties(Filer: TFiler);
1130	begin
1131	inherited;
1132	TntPersistent_AfterInherited_DefineProperties(Filer, Self);
1133	end;
1134
1135	function TTntCustomEdit.GetSelStart: Integer;
1136	begin
1137	Result := TntCustomEdit_GetSelStart(Self);
1138	end;
1139
1140	procedure TTntCustomEdit.SetSelStart(const Value: Integer);
1141	begin
1142	TntCustomEdit_SetSelStart(Self, Value);
1143	end;
1144
1145	function TTntCustomEdit.GetSelLength: Integer;
1146	begin
1147	Result := TntCustomEdit_GetSelLength(Self);
1148	end;
1149
1150	procedure TTntCustomEdit.SetSelLength(const Value: Integer);
1151	begin
1152	TntCustomEdit_SetSelLength(Self, Value);
1153	end;
1154
1155	function TTntCustomEdit.GetSelText: WideString;
1156	begin
1157	Result := TntCustomEdit_GetSelText(Self);
1158	end;
1159
1160	procedure TTntCustomEdit.SetSelText(const Value: WideString);
1161	begin
1162	TntCustomEdit_SetSelText(Self, Value);
1163	end;
1164
1165	function TTntCustomEdit.GetPasswordChar: WideChar;
1166	begin
1167	Result := TntCustomEdit_GetPasswordChar(Self, FPasswordChar);
1168	end;
1169
1170	procedure TTntCustomEdit.SetPasswordChar(const Value: WideChar);
1171	begin
1172	TntCustomEdit_SetPasswordChar(Self, FPasswordChar, Value);
1173	end;
1174
1175	function TTntCustomEdit.GetText: WideString;
1176	begin
1177	Result := TntControl_GetText(Self);
1178	end;
1179
1180	procedure TTntCustomEdit.SetText(const Value: WideString);
1181	begin
1182	TntControl_SetText(Self, Value);
1183	end;
1184
1185	function TTntCustomEdit.IsHintStored: Boolean;
1186	begin
1187	Result := TntControl_IsHintStored(Self);
1188	end;
1189
1190	function TTntCustomEdit.GetHint: WideString;
1191	begin
1192	Result := TntControl_GetHint(Self)
1193	end;
1194
1195	procedure TTntCustomEdit.SetHint(const Value: WideString);
1196	begin
1197	TntControl_SetHint(Self, Value);
1198	end;
1199
1200	procedure TTntCustomEdit.ActionChange(Sender: TObject; CheckDefaults: Boolean);
1201	begin
1202	TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
1203	inherited;
1204	end;
1205
1206	function TTntCustomEdit.GetActionLinkClass: TControlActionLinkClass;
1207	begin
1208	Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
1209	end;
1210
1211	{ TTntMemoStrings }
1212
1213	constructor TTntMemoStrings.Create;
1214	begin
1215	inherited;
1216	FLineBreakStyle := tlbsCRLF;
1217	end;
1218
1219	function TTntMemoStrings.GetCount: Integer;
1220	begin
1221	Result := FMemoLines.Count;
1222	end;
1223
1224	function TntMemo_LineStart(Handle: THandle; Index: Integer): Integer;
1225	begin
1226	Assert(Win32PlatformIsUnicode);
1227	Result := SendMessageW(Handle, EM_LINEINDEX, Index, 0);
1228	end;
1229
1230	function TntMemo_LineLength(Handle: THandle; Index: Integer; StartPos: Integer = -1): Integer;
1231	begin
1232	Assert(Win32PlatformIsUnicode);
1233	if StartPos = -1 then
1234	StartPos := TntMemo_LineStart(Handle, Index);
1235	if StartPos < 0 then
1236	Result := 0
1237	else
1238	Result := SendMessageW(Handle, EM_LINELENGTH, StartPos, 0);
1239	end;
1240
1241	function TTntMemoStrings.Get(Index: Integer): WideString;
1242	var
1243	Len: Integer;
1244	begin
1245	if (not IsWindowUnicode(FMemo.Handle)) then
1246	Result := FMemoLines[Index]
1247	else begin
1248	SetLength(Result, TntMemo_LineLength(FMemo.Handle, Index));
1249	if Length(Result) > 0 then begin
1250	if Length(Result) > High(Word) then
1251	raise EOutOfResources.Create(SOutlineLongLine);
1252	Word((PWideChar(Result))^) := Length(Result);
1253	Len := SendMessageW(FMemo.Handle, EM_GETLINE, Index, Longint(PWideChar(Result)));
1254	SetLength(Result, Len);
1255	end;
1256	end;
1257	end;
1258
1259	procedure TTntMemoStrings.Put(Index: Integer; const S: WideString);
1260	var
1261	StartPos: Integer;
1262	begin
1263	if (not IsWindowUnicode(FMemo.Handle)) then
1264	FMemoLines[Index] := S
1265	else begin
1266	StartPos := TntMemo_LineStart(FMemo.Handle, Index);
1267	if StartPos >= 0 then
1268	begin
1269	SendMessageW(FMemo.Handle, EM_SETSEL, StartPos, StartPos + TntMemo_LineLength(FMemo.Handle, Index));
1270	SendMessageW(FMemo.Handle, EM_REPLACESEL, 0, Longint(PWideChar(S)));
1271	end;
1272	end;
1273	end;
1274
1275	procedure TTntMemoStrings.Insert(Index: Integer; const S: Widestring);
1276
1277	function RichEditSelStartW: Integer;
1278	var
1279	CharRange: TCharRange;
1280	begin
1281	SendMessageW(FMemo.Handle, EM_EXGETSEL, 0, Longint(@CharRange));
1282	Result := CharRange.cpMin;
1283	end;
1284
1285	var
1286	StartPos, LineLen: Integer;
1287	Line: WideString;
1288	begin
1289	if (not IsWindowUnicode(FMemo.Handle)) then
1290	FMemoLines.Insert(Index, S)
1291	else begin
1292	if Index >= 0 then
1293	begin
1294	StartPos := TntMemo_LineStart(FMemo.Handle, Index);
1295	if StartPos >= 0 then
1296	Line := S + CRLF
1297	else begin
1298	StartPos := TntMemo_LineStart(FMemo.Handle, Index - 1);
1299	LineLen := TntMemo_LineLength(FMemo.Handle, Index - 1);
1300	if LineLen = 0 then
1301	Exit;
1302	Inc(StartPos, LineLen);
1303	Line := CRLF + s;
1304	end;
1305	SendMessageW(FMemo.Handle, EM_SETSEL, StartPos, StartPos);
1306
1307	if (FRichEditMode)
1308	and (FLineBreakStyle <> tlbsCRLF) then begin
1309	Line := TntAdjustLineBreaks(Line, FLineBreakStyle);
1310	if Line = CR then
1311	Line := CRLF; { This helps a ReadOnly RichEdit 4.1 control to insert a blank line. }
1312	SendMessageW(FMemo.Handle, EM_REPLACESEL, 0, Longint(PWideChar(Line)));
1313	if Line = CRLF then
1314	Line := CR;
1315	end else
1316	SendMessageW(FMemo.Handle, EM_REPLACESEL, 0, Longint(PWideChar(Line)));
1317
1318	if (FRichEditMode)
1319	and (RichEditSelStartW <> (StartPos + Length(Line))) then
1320	raise EOutOfResources.Create(sRichEditInsertError);
1321	end;
1322	end;
1323	end;
1324
1325	procedure TTntMemoStrings.Delete(Index: Integer);
1326	begin
1327	FMemoLines.Delete(Index);
1328	end;
1329
1330	procedure TTntMemoStrings.Clear;
1331	begin
1332	FMemoLines.Clear;
1333	end;
1334
1335	type TAccessStrings = class(TStrings{TNT-ALLOW TStrings});
1336
1337	procedure TTntMemoStrings.SetUpdateState(Updating: Boolean);
1338	begin
1339	TAccessStrings(FMemoLines).SetUpdateState(Updating);
1340	end;
1341
1342	function TTntMemoStrings.GetTextStr: WideString;
1343	begin
1344	if (not FRichEditMode) then
1345	Result := TntControl_GetText(FMemo)
1346	else
1347	Result := inherited GetTextStr;
1348	end;
1349
1350	procedure TTntMemoStrings.SetTextStr(const Value: WideString);
1351	var
1352	NewText: WideString;
1353	begin
1354	NewText := TntAdjustLineBreaks(Value, FLineBreakStyle);
1355	if NewText <> GetTextStr then begin
1356	FMemo.HandleNeeded;
1357	TntControl_SetText(FMemo, NewText);
1358	end;
1359	end;
1360
1361	{ TTntCustomMemo }
1362
1363	constructor TTntCustomMemo.Create(AOwner: TComponent);
1364	begin
1365	inherited;
1366	FLines := TTntMemoStrings.Create;
1367	TTntMemoStrings(FLines).FMemo := Self;
1368	TTntMemoStrings(FLines).FMemoLines := TCustomMemo{TNT-ALLOW TCustomMemo}(Self).Lines;
1369	end;
1370
1371	destructor TTntCustomMemo.Destroy;
1372	begin
1373	FreeAndNil(FLines);
1374	inherited;
1375	end;
1376
1377	procedure TTntCustomMemo.SetLines(const Value: TTntStrings);
1378	begin
1379	FLines.Assign(Value);
1380	end;
1381
1382	procedure TTntCustomMemo.CreateWindowHandle(const Params: TCreateParams);
1383	begin
1384	TntCustomEdit_CreateWindowHandle(Self, Params);
1385	end;
1386
1387	procedure TTntCustomMemo.DefineProperties(Filer: TFiler);
1388	begin
1389	inherited;
1390	TntPersistent_AfterInherited_DefineProperties(Filer, Self);
1391	end;
1392
1393	function TTntCustomMemo.GetSelStart: Integer;
1394	begin
1395	Result := TntCustomEdit_GetSelStart(Self);
1396	end;
1397
1398	procedure TTntCustomMemo.SetSelStart(const Value: Integer);
1399	begin
1400	TntCustomEdit_SetSelStart(Self, Value);
1401	end;
1402
1403	function TTntCustomMemo.GetSelLength: Integer;
1404	begin
1405	Result := TntCustomEdit_GetSelLength(Self);
1406	end;
1407
1408	procedure TTntCustomMemo.SetSelLength(const Value: Integer);
1409	begin
1410	TntCustomEdit_SetSelLength(Self, Value);
1411	end;
1412
1413	function TTntCustomMemo.GetSelText: WideString;
1414	begin
1415	Result := TntCustomEdit_GetSelText(Self);
1416	end;
1417
1418	procedure TTntCustomMemo.SetSelText(const Value: WideString);
1419	begin
1420	TntCustomEdit_SetSelText(Self, Value);
1421	end;
1422
1423	function TTntCustomMemo.GetText: WideString;
1424	begin
1425	Result := TntControl_GetText(Self);
1426	end;
1427
1428	procedure TTntCustomMemo.SetText(const Value: WideString);
1429	begin
1430	TntControl_SetText(Self, Value);
1431	end;
1432
1433	function TTntCustomMemo.IsHintStored: Boolean;
1434	begin
1435	Result := TntControl_IsHintStored(Self);
1436	end;
1437
1438	function TTntCustomMemo.GetHint: WideString;
1439	begin
1440	Result := TntControl_GetHint(Self)
1441	end;
1442
1443	procedure TTntCustomMemo.SetHint(const Value: WideString);
1444	begin
1445	TntControl_SetHint(Self, Value);
1446	end;
1447
1448	procedure TTntCustomMemo.ActionChange(Sender: TObject; CheckDefaults: Boolean);
1449	begin
1450	TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
1451	inherited;
1452	end;
1453
1454	function TTntCustomMemo.GetActionLinkClass: TControlActionLinkClass;
1455	begin
1456	Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
1457	end;
1458
1459	{$IFDEF DELPHI_7} // fix for Delphi 7 only
1460	function TD7PatchedComboBoxStrings.Get(Index: Integer): string{TNT-ALLOW string};
1461	var
1462	Len: Integer;
1463	begin
1464	Len := SendMessage(ComboBox.Handle, CB_GETLBTEXTLEN, Index, 0);
1465	if Len > 0 then
1466	begin
1467	SetLength(Result, Len);
1468	SendMessage(ComboBox.Handle, CB_GETLBTEXT, Index, Longint(PChar{TNT-ALLOW PChar}(Result)));
1469	end
1470	else
1471	SetLength(Result, 0);
1472	end;
1473
1474	function TD7PatchedComboBoxStrings.Add(const S: string{TNT-ALLOW string}): Integer;
1475	begin
1476	Result := SendMessage(ComboBox.Handle, CB_ADDSTRING, 0, Longint(PChar{TNT-ALLOW PChar}(S)));
1477	if Result < 0 then
1478	raise EOutOfResources.Create(SInsertLineError);
1479	end;
1480
1481	procedure TD7PatchedComboBoxStrings.Insert(Index: Integer; const S: string{TNT-ALLOW string});
1482	begin
1483	if SendMessage(ComboBox.Handle, CB_INSERTSTRING, Index,
1484	Longint(PChar{TNT-ALLOW PChar}(S))) < 0 then
1485	raise EOutOfResources.Create(SInsertLineError);
1486	end;
1487	{$ENDIF}
1488
1489	{ TTntComboBoxStrings }
1490
1491	function TTntComboBoxStrings.GetCount: Integer;
1492	begin
1493	Result := ComboBox.Items.Count;
1494	end;
1495
1496	function TTntComboBoxStrings.Get(Index: Integer): WideString;
1497	var
1498	Len: Integer;
1499	begin
1500	if (not IsWindowUnicode(ComboBox.Handle)) then
1501	Result := ComboBox.Items[Index]
1502	else begin
1503	Len := SendMessageW(ComboBox.Handle, CB_GETLBTEXTLEN, Index, 0);
1504	if Len = CB_ERR then
1505	Result := ''
1506	else begin
1507	SetLength(Result, Len + 1);
1508	Len := SendMessageW(ComboBox.Handle, CB_GETLBTEXT, Index, Longint(PWideChar(Result)));
1509	if Len = CB_ERR then
1510	Result := ''
1511	else
1512	Result := PWideChar(Result);
1513	end;
1514	end;
1515	end;
1516
1517	function TTntComboBoxStrings.GetObject(Index: Integer): TObject;
1518	begin
1519	Result := ComboBox.Items.Objects[Index];
1520	end;
1521
1522	procedure TTntComboBoxStrings.PutObject(Index: Integer; AObject: TObject);
1523	begin
1524	ComboBox.Items.Objects[Index] := AObject;
1525	end;
1526
1527	function TTntComboBoxStrings.Add(const S: WideString): Integer;
1528	begin
1529	if (not IsWindowUnicode(ComboBox.Handle)) then
1530	Result := ComboBox.Items.Add(S)
1531	else begin
1532	Result := SendMessageW(ComboBox.Handle, CB_ADDSTRING, 0, Longint(PWideChar(S)));
1533	if Result < 0 then
1534	raise EOutOfResources.Create(SInsertLineError);
1535	end;
1536	end;
1537
1538	procedure TTntComboBoxStrings.Insert(Index: Integer; const S: WideString);
1539	begin
1540	if (not IsWindowUnicode(ComboBox.Handle)) then
1541	ComboBox.Items.Insert(Index, S)
1542	else begin
1543	if SendMessageW(ComboBox.Handle, CB_INSERTSTRING, Index, Longint(PWideChar(S))) < 0 then
1544	raise EOutOfResources.Create(SInsertLineError);
1545	end;
1546	end;
1547
1548	procedure TTntComboBoxStrings.Delete(Index: Integer);
1549	begin
1550	ComboBox.Items.Delete(Index);
1551	end;
1552
1553	procedure TTntComboBoxStrings.Clear;
1554	var
1555	S: WideString;
1556	begin
1557	S := TntControl_GetText(ComboBox);
1558	SendMessage(ComboBox.Handle, CB_RESETCONTENT, 0, 0);
1559	TntControl_SetText(ComboBox, S);
1560	ComboBox.Update;
1561	end;
1562
1563	procedure TTntComboBoxStrings.SetUpdateState(Updating: Boolean);
1564	begin
1565	TAccessStrings(ComboBox.Items).SetUpdateState(Updating);
1566	end;
1567
1568	function TTntComboBoxStrings.IndexOf(const S: WideString): Integer;
1569	begin
1570	if (not IsWindowUnicode(ComboBox.Handle)) then
1571	Result := ComboBox.Items.IndexOf(S)
1572	else
1573	Result := SendMessageW(ComboBox.Handle, CB_FINDSTRINGEXACT, -1, LongInt(PWideChar(S)));
1574	end;
1575
1576	{ TTntCustomComboBox }
1577
1578	type TAccessCustomComboBox = class(TCustomComboBox{TNT-ALLOW TCustomComboBox});
1579
1580	procedure TntCombo_AfterInherited_CreateWnd(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
1581	Items: TTntStrings; var FSaveItems: TTntStrings; FSaveItemIndex: integer; PreInheritedAnsiText: AnsiString);
1582	begin
1583	if (not Win32PlatformIsUnicode) then begin
1584	TAccessCustomComboBox(Combo).Text := PreInheritedAnsiText;
1585	end else begin
1586	with TAccessCustomComboBox(Combo) do
1587	begin
1588	if ListHandle <> 0 then begin
1589	// re-extract FDefListProc as a Unicode proc
1590	SetWindowLongA(ListHandle, GWL_WNDPROC, Integer(FDefListProc));
1591	FDefListProc := Pointer(GetWindowLongW(ListHandle, GWL_WNDPROC));
1592	// override with FListInstance as a Unicode proc
1593	SetWindowLongW(ListHandle, GWL_WNDPROC, Integer(FListInstance));
1594	end;
1595	SetWindowLongW(EditHandle, GWL_WNDPROC, GetWindowLong(EditHandle, GWL_WNDPROC));
1596	end;
1597	if FSaveItems <> nil then
1598	begin
1599	Items.Assign(FSaveItems);
1600	FreeAndNil(FSaveItems);
1601	if FSaveItemIndex <> -1 then
1602	begin
1603	if Items.Count < FSaveItemIndex then FSaveItemIndex := Items.Count;
1604	SendMessage(Combo.Handle, CB_SETCURSEL, FSaveItemIndex, 0);
1605	end;
1606	end;
1607	TntControl_SetText(Combo, TntControl_GetStoredText(Combo, TAccessCustomComboBox(Combo).Text));
1608	end;
1609	end;
1610
1611	procedure TntCombo_BeforeInherited_DestroyWnd(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
1612	Items: TTntStrings; var FSaveItems: TTntStrings; ItemIndex: integer; var FSaveItemIndex: integer;
1613	var SavedText: WideString);
1614	begin
1615	Assert(not (csDestroyingHandle in Combo.ControlState));
1616	if (Win32PlatformIsUnicode) then begin
1617	SavedText := TntControl_GetText(Combo);
1618	if (Items.Count > 0) then
1619	begin
1620	FSaveItems := TTntStringList.Create;
1621	FSaveItems.Assign(Items);
1622	FSaveItemIndex:= ItemIndex;
1623	Items.Clear; { This keeps TCustomComboBox from creating its own FSaveItems. (this kills the original ItemIndex) }
1624	end;
1625	end;
1626	end;
1627
1628	function TntCombo_ComboWndProc(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
1629	var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer; DoEditCharMsg: TWMCharMsgHandler): Boolean;
1630
1631	procedure CallDefaultWindowProc;
1632	begin
1633	with Message do begin { call default wnd proc }
1634	if IsWindowUnicode(ComboWnd) then
1635	Result := CallWindowProcW(ComboProc, ComboWnd, Msg, WParam, LParam)
1636	else
1637	Result := CallWindowProcA(ComboProc, ComboWnd, Msg, WParam, LParam);
1638	end;
1639	end;
1640
1641	function DoWideKeyPress(Message: TWMChar): Boolean;
1642	begin
1643	DoEditCharMsg(Message);
1644	Result := (Message.CharCode = 0);
1645	end;
1646
1647	begin
1648	Result := False;
1649	try
1650	if (Message.Msg = WM_CHAR) then begin
1651	// WM_CHAR
1652	Result := True;
1653	if IsWindowUnicode(ComboWnd) then
1654	MakeWMCharMsgSafeForAnsi(Message);
1655	try
1656	if TAccessCustomComboBox(Combo).DoKeyPress(TWMKey(Message)) then Exit;
1657	if DoWideKeyPress(TWMKey(Message)) then Exit;
1658	finally
1659	if IsWindowUnicode(ComboWnd) then
1660	RestoreWMCharMsg(Message);
1661	end;
1662	with TWMKey(Message) do begin
1663	if ((CharCode = VK_RETURN) or (CharCode = VK_ESCAPE)) and Combo.DroppedDown then begin
1664	Combo.DroppedDown := False;
1665	Exit;
1666	end;
1667	end;
1668	CallDefaultWindowProc;
1669	end else if (IsWindowUnicode(ComboWnd)) then begin
1670	// UNICODE
1671	if IsTextMessage(Message.Msg)
1672	or (Message.Msg = EM_REPLACESEL)
1673	or (Message.Msg = WM_IME_COMPOSITION)
1674	then begin
1675	// message w/ text parameter
1676	Result := True;
1677	CallDefaultWindowProc;
1678	end else if (Message.Msg = WM_IME_CHAR) then begin
1679	// WM_IME_CHAR
1680	Result := True;
1681	with Message do { convert to WM_CHAR }
1682	Result := SendMessageW(ComboWnd, WM_CHAR, WParam, LParam);
1683	end;
1684	end;
1685	except
1686	Application.HandleException(Combo);
1687	end;
1688	end;
1689
1690	function TntCombo_CNCommand(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; Items: TTntStrings; var Message: TWMCommand): Boolean;
1691	begin
1692	Result := False;
1693	if Message.NotifyCode = CBN_SELCHANGE then begin
1694	Result := True;
1695	TntControl_SetText(Combo, Items[Combo.ItemIndex]);
1696	TAccessCustomComboBox(Combo).Click;
1697	TAccessCustomComboBox(Combo).Select;
1698	end;
1699	end;
1700
1701	function TntCombo_GetSelStart(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}): Integer;
1702	begin
1703	if Win32PlatformIsUnicode then
1704	Result := Combo.SelStart
1705	else
1706	Result := Length(WideString(Copy(TAccessCustomComboBox(Combo).Text, 1, Combo.SelStart)));
1707	end;
1708
1709	procedure TntCombo_SetSelStart(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; const Value: Integer);
1710	begin
1711	if Win32PlatformIsUnicode then
1712	Combo.SelStart := Value
1713	else
1714	Combo.SelStart := Length(AnsiString(Copy(TntControl_GetText(Combo), 1, Value)));
1715	end;
1716
1717	function TntCombo_GetSelLength(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}): Integer;
1718	begin
1719	if Win32PlatformIsUnicode then
1720	Result := Combo.SelLength
1721	else
1722	Result := Length(TntCombo_GetSelText(Combo));
1723	end;
1724
1725	procedure TntCombo_SetSelLength(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; const Value: Integer);
1726	var
1727	StartPos: Integer;
1728	begin
1729	if Win32PlatformIsUnicode then
1730	Combo.SelLength := Value
1731	else begin
1732	StartPos := TntCombo_GetSelStart(Combo);
1733	Combo.SelLength := Length(AnsiString(Copy(TntControl_GetText(Combo), StartPos + 1, Value)));
1734	end;
1735	end;
1736
1737	function TntCombo_GetSelText(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}): WideString;
1738	begin
1739	if Win32PlatformIsUnicode then begin
1740	Result := '';
1741	if TAccessCustomComboBox(Combo).Style < csDropDownList then
1742	Result := Copy(TntControl_GetText(Combo), Combo.SelStart + 1, Combo.SelLength);
1743	end else
1744	Result := Combo.SelText
1745	end;
1746
1747	procedure TntCombo_SetSelText(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; const Value: WideString);
1748	begin
1749	if Win32PlatformIsUnicode then begin
1750	if TAccessCustomComboBox(Combo).Style < csDropDownList then
1751	begin
1752	Combo.HandleNeeded;
1753	SendMessageW(TAccessCustomComboBox(Combo).EditHandle, EM_REPLACESEL, 0, Longint(PWideChar(Value)));
1754	end;
1755	end else
1756	Combo.SelText := Value
1757	end;
1758
1759	procedure TntCombo_BeforeKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; var SaveAutoComplete: Boolean);
1760	begin
1761	SaveAutoComplete := TAccessCustomComboBox(Combo).AutoComplete;
1762	TAccessCustomComboBox(Combo).AutoComplete := False;
1763	end;
1764
1765	procedure TntCombo_AfterKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; var SaveAutoComplete: Boolean);
1766	begin
1767	TAccessCustomComboBox(Combo).AutoComplete := SaveAutoComplete;
1768	end;
1769
1770	procedure TntCombo_DropDown_PreserveSelection(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox});
1771	var
1772	OldSelStart, OldSelLength: Integer;
1773	OldText: WideString;
1774	begin
1775	OldText := TntControl_GetText(Combo);
1776	OldSelStart := TntCombo_GetSelStart(Combo);
1777	OldSelLength := TntCombo_GetSelLength(Combo);
1778	Combo.DroppedDown := True;
1779	TntControl_SetText(Combo, OldText);
1780	TntCombo_SetSelStart(Combo, OldSelStart);
1781	TntCombo_SetSelLength(Combo ,OldSelLength);
1782	end;
1783
1784	procedure TntComboBox_AddItem(Items: TTntStrings; const Item: WideString; AObject: TObject);
1785	begin
1786	Items.AddObject(Item, AObject);
1787	end;
1788
1789	procedure TntComboBox_CopySelection(Items: TTntStrings; ItemIndex: Integer;
1790	Destination: TCustomListControl);
1791	begin
1792	if ItemIndex <> -1 then
1793	WideListControl_AddItem(Destination, Items[ItemIndex], Items.Objects[ItemIndex]);
1794	end;
1795
1796	function TntCombo_FindString(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
1797	StartPos: Integer; const Text: WideString): Integer;
1798	var
1799	ComboFindString: ITntComboFindString;
1800	begin
1801	if Combo.GetInterface(ITntComboFindString, ComboFindString) then
1802	Result := ComboFindString.FindString(Text, StartPos)
1803	else if IsWindowUnicode(Combo.Handle) then
1804	Result := SendMessageW(Combo.Handle, CB_FINDSTRING, StartPos, Integer(PWideChar(Text)))
1805	else
1806	Result := SendMessageA(Combo.Handle, CB_FINDSTRING, StartPos, Integer(PAnsiChar(AnsiString(Text))))
1807	end;
1808
1809	function TntCombo_FindUniqueString(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
1810	StartPos: Integer; const Text: WideString): Integer;
1811	var
1812	Match_1, Match_2: Integer;
1813	begin
1814	Result := CB_ERR;
1815	Match_1 := TntCombo_FindString(Combo, -1, Text);
1816	if Match_1 <> CB_ERR then begin
1817	Match_2 := TntCombo_FindString(Combo, Match_1, Text);
1818	if Match_2 = Match_1 then
1819	Result := Match_1;
1820	end;
1821	end;
1822
1823	function TntCombo_AutoSelect(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; Items: TTntStrings;
1824	const SearchText: WideString; UniqueMatchOnly: Boolean; UseDataEntryCase: Boolean): Boolean;
1825	var
1826	Idx: Integer;
1827	ValueChange: Boolean;
1828	begin
1829	if UniqueMatchOnly then
1830	Idx := TntCombo_FindUniqueString(Combo, -1, SearchText)
1831	else
1832	Idx := TntCombo_FindString(Combo, -1, SearchText);
1833	Result := (Idx <> CB_ERR);
1834	if Result then begin
1835	if TAccessCustomComboBox(Combo).Style = csDropDown then
1836	ValueChange := not WideSameStr(TntControl_GetText(Combo), Items[Idx])
1837	else
1838	ValueChange := Idx <> Combo.ItemIndex;
1839	{$IFDEF COMPILER_7_UP}
1840	// auto-closeup
1841	if Combo.AutoCloseUp and (Items.IndexOf(SearchText) <> -1) then
1842	Combo.DroppedDown := False;
1843	{$ENDIF}
1844	// select item
1845	Combo.ItemIndex := Idx;
1846	// update edit
1847	if (TAccessCustomComboBox(Combo).Style in [csDropDown, csSimple]) then begin
1848	if UseDataEntryCase then begin
1849	// preserve case of characters as they are entered
1850	TntControl_SetText(Combo, SearchText + Copy(Items[Combo.ItemIndex], Length(SearchText) + 1, MaxInt));
1851	end else begin
1852	TntControl_SetText(Combo, Items[Idx]);
1853	end;
1854	// select the rest of the string
1855	TntCombo_SetSelStart(Combo, Length(SearchText));
1856	TntCombo_SetSelLength(Combo, Length(TntControl_GetText(Combo)) - TntCombo_GetSelStart(Combo));
1857	end;
1858	// notify events
1859	if ValueChange then begin
1860	TAccessCustomComboBox(Combo).Click;
1861	TAccessCustomComboBox(Combo).Select;
1862	end;
1863	end;
1864	end;
1865
1866	procedure TntCombo_AutoSearchKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
1867	Items: TTntStrings; var Message: TWMChar; var FFilter: WideString; var FLastTime: Cardinal);
1868	var
1869	Key: WideChar;
1870	begin
1871	if TAccessCustomComboBox(Combo).Style in [csSimple, csDropDown] then
1872	exit;
1873	if not Combo.AutoComplete then
1874	exit;
1875	Key := GetWideCharFromWMCharMsg(Message);
1876	try
1877	case Ord(Key) of
1878	VK_ESCAPE:
1879	exit;
1880	VK_TAB:
1881	if Combo.AutoDropDown and Combo.DroppedDown then
1882	Combo.DroppedDown := False;
1883	VK_BACK:
1884	Delete(FFilter, Length(FFilter), 1);
1885	else begin
1886	if Combo.AutoDropDown and (not Combo.DroppedDown) then
1887	Combo.DroppedDown := True;
1888	// reset FFilter if it's been too long (1.25 sec) { Windows XP is actually 2 seconds! }
1889	if GetTickCount - FLastTime >= 1250 then
1890	FFilter := '';
1891	FLastTime := GetTickCount;
1892	// if AutoSelect works, remember new FFilter
1893	if TntCombo_AutoSelect(Combo, Items, FFilter + Key, False, True) then begin
1894	FFilter := FFilter + Key;
1895	Key := #0;
1896	end;
1897	end;
1898	end;
1899	finally
1900	SetWideCharForWMCharMsg(Message, Key);
1901	end;
1902	end;
1903
1904	procedure TntCombo_AutoCompleteKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
1905	Items: TTntStrings; var Message: TWMChar;
1906	AutoComplete_UniqueMatchOnly, AutoComplete_PreserveDataEntryCase: Boolean);
1907	var
1908	Key: WideChar;
1909	FindText: WideString;
1910	begin
1911	Assert(TAccessCustomComboBox(Combo).Style in [csSimple, csDropDown], 'Internal Error: TntCombo_AutoCompleteKeyPress is only for csSimple and csDropDown style combo boxes.');
1912	if not Combo.AutoComplete then exit;
1913	Key := GetWideCharFromWMCharMsg(Message);
1914	try
1915	case Ord(Key) of
1916	VK_ESCAPE:
1917	exit;
1918	VK_TAB:
1919	if Combo.AutoDropDown and Combo.DroppedDown then
1920	Combo.DroppedDown := False;
1921	VK_BACK:
1922	exit;
1923	else begin
1924	if Combo.AutoDropDown and (not Combo.DroppedDown) then
1925	TntCombo_DropDown_PreserveSelection(Combo);
1926	// AutoComplete only if the selection is at the very end
1927	if ((TntCombo_GetSelStart(Combo) + TntCombo_GetSelLength(Combo))
1928	= Length(TntControl_GetText(Combo))) then
1929	begin
1930	FindText := Copy(TntControl_GetText(Combo), 1, TntCombo_GetSelStart(Combo)) + Key;
1931	if TntCombo_AutoSelect(Combo, Items, FindText, AutoComplete_UniqueMatchOnly, AutoComplete_PreserveDataEntryCase) then
1932	begin
1933	Key := #0;
1934	end;
1935	end;
1936	end;
1937	end;
1938	finally
1939	SetWideCharForWMCharMsg(Message, Key);
1940	end;
1941	end;
1942
1943	//--
1944	constructor TTntCustomComboBox.Create(AOwner: TComponent);
1945	begin
1946	inherited;
1947	FItems := TTntComboBoxStrings.Create;
1948	TTntComboBoxStrings(FItems).ComboBox := Self;
1949	end;
1950
1951	destructor TTntCustomComboBox.Destroy;
1952	begin
1953	FreeAndNil(FItems);
1954	FreeAndNil(FSaveItems);
1955	inherited;
1956	end;
1957
1958	procedure TTntCustomComboBox.CreateWindowHandle(const Params: TCreateParams);
1959	begin
1960	CreateUnicodeHandle(Self, Params, 'COMBOBOX');
1961	end;
1962
1963	procedure TTntCustomComboBox.DefineProperties(Filer: TFiler);
1964	begin
1965	inherited;
1966	TntPersistent_AfterInherited_DefineProperties(Filer, Self);
1967	end;
1968
1969	procedure TTntCustomComboBox.CreateWnd;
1970	var
1971	PreInheritedAnsiText: AnsiString;
1972	begin
1973	PreInheritedAnsiText := TAccessCustomComboBox(Self).Text;
1974	inherited;
1975	TntCombo_AfterInherited_CreateWnd(Self, Items, FSaveItems, FSaveItemIndex, PreInheritedAnsiText);
1976	end;
1977
1978	procedure TTntCustomComboBox.DestroyWnd;
1979	var
1980	SavedText: WideString;
1981	begin
1982	if not (csDestroyingHandle in ControlState) then begin { avoid recursion when parent is TToolBar and system font changes. }
1983	TntCombo_BeforeInherited_DestroyWnd(Self, Items, FSaveItems, ItemIndex, FSaveItemIndex, SavedText);
1984	inherited;
1985	TntControl_SetStoredText(Self, SavedText);
1986	end;
1987	end;
1988
1989	procedure TTntCustomComboBox.ComboWndProc(var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer);
1990	begin
1991	if not TntCombo_ComboWndProc(Self, Message, ComboWnd, ComboProc, DoEditCharMsg) then
1992	inherited;
1993	end;
1994
1995	procedure TTntCustomComboBox.KeyPress(var Key: AnsiChar);
1996	var
1997	SaveAutoComplete: Boolean;
1998	begin
1999	TntCombo_BeforeKeyPress(Self, SaveAutoComplete);
2000	try
2001	inherited;
2002	finally
2003	TntCombo_AfterKeyPress(Self, SaveAutoComplete);
2004	end;
2005	end;
2006
2007	procedure TTntCustomComboBox.DoEditCharMsg(var Message: TWMChar);
2008	begin
2009	TntCombo_AutoCompleteKeyPress(Self, Items, Message,
2010	GetAutoComplete_UniqueMatchOnly, GetAutoComplete_PreserveDataEntryCase);
2011	end;
2012
2013	procedure TTntCustomComboBox.WMChar(var Message: TWMChar);
2014	begin
2015	TntCombo_AutoSearchKeyPress(Self, Items, Message, FFilter, FLastTime);
2016	if Message.CharCode <> 0 then
2017	inherited;
2018	end;
2019
2020	procedure TntCombo_DefaultDrawItem(Canvas: TCanvas; Index: Integer; Rect: TRect;
2021	State: TOwnerDrawState; Items: TTntStrings);
2022	begin
2023	Canvas.FillRect(Rect);
2024	if Index >= 0 then
2025	WideCanvasTextOut(Canvas, Rect.Left + 2, Rect.Top, Items[Index]);
2026	end;
2027
2028	procedure TTntCustomComboBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
2029	begin
2030	TControlCanvas(Canvas).UpdateTextFlags;
2031	if Assigned(OnDrawItem) then
2032	OnDrawItem(Self, Index, Rect, State)
2033	else
2034	TntCombo_DefaultDrawItem(Canvas, Index, Rect, State, Items);
2035	end;
2036
2037	function TTntCustomComboBox.GetItems: TTntStrings;
2038	begin
2039	Result := FItems;
2040	end;
2041
2042	procedure TTntCustomComboBox.SetItems(const Value: TTntStrings);
2043	begin
2044	FItems.Assign(Value);
2045	end;
2046
2047	function TTntCustomComboBox.GetSelStart: Integer;
2048	begin
2049	Result := TntCombo_GetSelStart(Self);
2050	end;
2051
2052	procedure TTntCustomComboBox.SetSelStart(const Value: Integer);
2053	begin
2054	TntCombo_SetSelStart(Self, Value);
2055	end;
2056
2057	function TTntCustomComboBox.GetSelLength: Integer;
2058	begin
2059	Result := TntCombo_GetSelLength(Self);
2060	end;
2061
2062	procedure TTntCustomComboBox.SetSelLength(const Value: Integer);
2063	begin
2064	TntCombo_SetSelLength(Self, Value);
2065	end;
2066
2067	function TTntCustomComboBox.GetSelText: WideString;
2068	begin
2069	Result := TntCombo_GetSelText(Self);
2070	end;
2071
2072	procedure TTntCustomComboBox.SetSelText(const Value: WideString);
2073	begin
2074	TntCombo_SetSelText(Self, Value);
2075	end;
2076
2077	function TTntCustomComboBox.GetText: WideString;
2078	begin
2079	Result := TntControl_GetText(Self);
2080	end;
2081
2082	procedure TTntCustomComboBox.SetText(const Value: WideString);
2083	begin
2084	TntControl_SetText(Self, Value);
2085	end;
2086
2087	procedure TTntCustomComboBox.CNCommand(var Message: TWMCommand);
2088	begin
2089	if not TntCombo_CNCommand(Self, Items, Message) then
2090	inherited;
2091	end;
2092
2093	function TTntCustomComboBox.GetAutoComplete_PreserveDataEntryCase: Boolean;
2094	begin
2095	Result := True;
2096	end;
2097
2098	function TTntCustomComboBox.GetAutoComplete_UniqueMatchOnly: Boolean;
2099	begin
2100	Result := False;
2101	end;
2102
2103	function TTntCustomComboBox.IsHintStored: Boolean;
2104	begin
2105	Result := TntControl_IsHintStored(Self)
2106	end;
2107
2108	function TTntCustomComboBox.GetHint: WideString;
2109	begin
2110	Result := TntControl_GetHint(Self)
2111	end;
2112
2113	procedure TTntCustomComboBox.SetHint(const Value: WideString);
2114	begin
2115	TntControl_SetHint(Self, Value);
2116	end;
2117
2118	procedure TTntCustomComboBox.AddItem(const Item: WideString; AObject: TObject);
2119	begin
2120	TntComboBox_AddItem(Items, Item, AObject);
2121	end;
2122
2123	procedure TTntCustomComboBox.CopySelection(Destination: TCustomListControl);
2124	begin
2125	TntComboBox_CopySelection(Items, ItemIndex, Destination);
2126	end;
2127
2128	procedure TTntCustomComboBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
2129	begin
2130	TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
2131	inherited;
2132	end;
2133
2134	function TTntCustomComboBox.GetActionLinkClass: TControlActionLinkClass;
2135	begin
2136	Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
2137	end;
2138
2139	{$IFDEF DELPHI_7} // fix for Delphi 7 only
2140	function TTntCustomComboBox.GetItemsClass: TCustomComboBoxStringsClass;
2141	begin
2142	Result := TD7PatchedComboBoxStrings;
2143	end;
2144	{$ENDIF}
2145
2146	{ TTntListBoxStrings }
2147
2148	function TTntListBoxStrings.GetListBox: TCustomListBox{TNT-ALLOW TCustomListBox};
2149	begin
2150	Result := TCustomListBox{TNT-ALLOW TCustomListBox}(FListBox);
2151	end;
2152
2153	procedure TTntListBoxStrings.SetListBox(const Value: TCustomListBox{TNT-ALLOW TCustomListBox});
2154	begin
2155	FListBox := TAccessCustomListBox(Value);
2156	end;
2157
2158	function TTntListBoxStrings.GetCount: Integer;
2159	begin
2160	Result := ListBox.Items.Count;
2161	end;
2162
2163	function TTntListBoxStrings.Get(Index: Integer): WideString;
2164	var
2165	Len: Integer;
2166	begin
2167	if (not IsWindowUnicode(ListBox.Handle)) then
2168	Result := ListBox.Items[Index]
2169	else begin
2170	Len := SendMessageW(ListBox.Handle, LB_GETTEXTLEN, Index, 0);
2171	if Len = LB_ERR then
2172	Error(SListIndexError, Index)
2173	else begin
2174	SetLength(Result, Len + 1);
2175	Len := SendMessageW(ListBox.Handle, LB_GETTEXT, Index, Longint(PWideChar(Result)));
2176	if Len = LB_ERR then
2177	Result := ''
2178	else
2179	Result := PWideChar(Result);
2180	end;
2181	end;
2182	end;
2183
2184	function TTntListBoxStrings.GetObject(Index: Integer): TObject;
2185	begin
2186	Result := ListBox.Items.Objects[Index];
2187	end;
2188
2189	procedure TTntListBoxStrings.Put(Index: Integer; const S: WideString);
2190	var
2191	I: Integer;
2192	TempData: Longint;
2193	begin
2194	I := ListBox.ItemIndex;
2195	TempData := FListBox.InternalGetItemData(Index);
2196	// Set the Item to 0 in case it is an object that gets freed during Delete
2197	FListBox.InternalSetItemData(Index, 0);
2198	Delete(Index);
2199	InsertObject(Index, S, nil);
2200	FListBox.InternalSetItemData(Index, TempData);
2201	ListBox.ItemIndex := I;
2202	end;
2203
2204	procedure TTntListBoxStrings.PutObject(Index: Integer; AObject: TObject);
2205	begin
2206	ListBox.Items.Objects[Index] := AObject;
2207	end;
2208
2209	function TTntListBoxStrings.Add(const S: WideString): Integer;
2210	begin
2211	if (not IsWindowUnicode(ListBox.Handle)) then
2212	Result := ListBox.Items.Add(S)
2213	else begin
2214	Result := SendMessageW(ListBox.Handle, LB_ADDSTRING, 0, Longint(PWideChar(S)));
2215	if Result < 0 then
2216	raise EOutOfResources.Create(SInsertLineError);
2217	end;
2218	end;
2219
2220	procedure TTntListBoxStrings.Insert(Index: Integer; const S: WideString);
2221	begin
2222	if (not IsWindowUnicode(ListBox.Handle)) then
2223	ListBox.Items.Insert(Index, S)
2224	else begin
2225	if SendMessageW(ListBox.Handle, LB_INSERTSTRING, Index, Longint(PWideChar(S))) < 0 then
2226	raise EOutOfResources.Create(SInsertLineError);
2227	end;
2228	end;
2229
2230	procedure TTntListBoxStrings.Delete(Index: Integer);
2231	begin
2232	FListBox.DeleteString(Index);
2233	end;
2234
2235	procedure TTntListBoxStrings.Exchange(Index1, Index2: Integer);
2236	var
2237	TempData: Longint;
2238	TempString: WideString;
2239	begin
2240	BeginUpdate;
2241	try
2242	TempString := Strings[Index1];
2243	TempData := FListBox.InternalGetItemData(Index1);
2244	Strings[Index1] := Strings[Index2];
2245	FListBox.InternalSetItemData(Index1, FListBox.InternalGetItemData(Index2));
2246	Strings[Index2] := TempString;
2247	FListBox.InternalSetItemData(Index2, TempData);
2248	if ListBox.ItemIndex = Index1 then
2249	ListBox.ItemIndex := Index2
2250	else if ListBox.ItemIndex = Index2 then
2251	ListBox.ItemIndex := Index1;
2252	finally
2253	EndUpdate;
2254	end;
2255	end;
2256
2257	procedure TTntListBoxStrings.Clear;
2258	begin
2259	FListBox.ResetContent;
2260	end;
2261
2262	procedure TTntListBoxStrings.SetUpdateState(Updating: Boolean);
2263	begin
2264	TAccessStrings(ListBox.Items).SetUpdateState(Updating);
2265	end;
2266
2267	function TTntListBoxStrings.IndexOf(const S: WideString): Integer;
2268	begin
2269	if (not IsWindowUnicode(ListBox.Handle)) then
2270	Result := ListBox.Items.IndexOf(S)
2271	else
2272	Result := SendMessageW(ListBox.Handle, LB_FINDSTRINGEXACT, -1, LongInt(PWideChar(S)));
2273	end;
2274
2275	procedure TTntListBoxStrings.Move(CurIndex, NewIndex: Integer);
2276	var
2277	TempData: Longint;
2278	TempString: WideString;
2279	begin
2280	BeginUpdate;
2281	FListBox.FMoving := True;
2282	try
2283	if CurIndex <> NewIndex then
2284	begin
2285	TempString := Get(CurIndex);
2286	TempData := FListBox.InternalGetItemData(CurIndex);
2287	FListBox.InternalSetItemData(CurIndex, 0);
2288	Delete(CurIndex);
2289	Insert(NewIndex, TempString);
2290	FListBox.InternalSetItemData(NewIndex, TempData);
2291	end;
2292	finally
2293	FListBox.FMoving := False;
2294	EndUpdate;
2295	end;
2296	end;
2297
2298	//-- list box helper procs
2299
2300	procedure TntListBox_AfterInherited_CreateWnd(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox};
2301	var FSaveItems: TTntStrings; FItems: TTntStrings; FSaveTopIndex, FSaveItemIndex: Integer);
2302	begin
2303	if FSaveItems <> nil then
2304	begin
2305	FItems.Assign(FSaveItems);
2306	FreeAndNil(FSaveItems);
2307	ListBox.TopIndex := FSaveTopIndex;
2308	ListBox.ItemIndex := FSaveItemIndex;
2309	end;
2310	end;
2311
2312	procedure TntListBox_BeforeInherited_DestroyWnd(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox};
2313	var FSaveItems: TTntStrings; const FItems: TTntStrings; var FSaveTopIndex, FSaveItemIndex: Integer);
2314	begin
2315	if (FItems.Count > 0)
2316	and (not (TAccessCustomListBox(ListBox).Style in [lbVirtual, lbVirtualOwnerDraw]))
2317	then begin
2318	FSaveItems := TTntStringList.Create;
2319	FSaveItems.Assign(FItems);
2320	FSaveTopIndex := ListBox.TopIndex;
2321	FSaveItemIndex := ListBox.ItemIndex;
2322	ListBox.Items.Clear; { This keeps TCustomListBox from creating its own FSaveItems. (this kills the original ItemIndex) }
2323	end;
2324	end;
2325
2326	procedure TntListBox_DrawItem_Text(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox}; Items: TTntStrings; Index: Integer; Rect: TRect);
2327	var
2328	Flags: Integer;
2329	Canvas: TCanvas;
2330	begin
2331	Canvas := TAccessCustomListBox(ListBox).Canvas;
2332	Canvas.FillRect(Rect);
2333	if Index < Items.Count then
2334	begin
2335	Flags := ListBox.DrawTextBiDiModeFlags(DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
2336	if not ListBox.UseRightToLeftAlignment then
2337	Inc(Rect.Left, 2)
2338	else
2339	Dec(Rect.Right, 2);
2340	Tnt_DrawTextW(Canvas.Handle, PWideChar(Items[Index]), Length(Items[Index]), Rect, Flags);
2341	end;
2342	end;
2343
2344	procedure TntListBox_AddItem(Items: TTntStrings; const Item: WideString; AObject: TObject);
2345	begin
2346	Items.AddObject(PWideChar(Item), AObject);
2347	end;
2348
2349	procedure TntListBox_CopySelection(ListBox: TCustomListbox{TNT-ALLOW TCustomListbox};
2350	Items: TTntStrings; Destination: TCustomListControl);
2351	var
2352	I: Integer;
2353	begin
2354	if ListBox.MultiSelect then
2355	begin
2356	for I := 0 to Items.Count - 1 do
2357	if ListBox.Selected[I] then
2358	WideListControl_AddItem(Destination, PWideChar(Items[I]), Items.Objects[I]);
2359	end
2360	else
2361	if Listbox.ItemIndex <> -1 then
2362	WideListControl_AddItem(Destination, PWideChar(Items[ListBox.ItemIndex]), Items.Objects[ListBox.ItemIndex]);
2363	end;
2364
2365	function TntCustomListBox_GetOwnerData(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox}; OnData: TLBGetWideDataEvent; Index: Integer; out Data: WideString): Boolean;
2366	var
2367	AnsiData: AnsiString;
2368	begin
2369	Result := False;
2370	Data := '';
2371	if (Index > -1) and (Index < ListBox.Count) then begin
2372	if Assigned(OnData) then begin
2373	OnData(ListBox, Index, Data);
2374	Result := True;
2375	end else if Assigned(TAccessCustomListBox(ListBox).OnData) then begin
2376	AnsiData := '';
2377	TAccessCustomListBox(ListBox).OnData(ListBox, Index, AnsiData);
2378	Data := AnsiData;
2379	Result := True;
2380	end;
2381	end;
2382	end;
2383
2384	function TntCustomListBox_LBGetText(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox}; OnData: TLBGetWideDataEvent; var Message: TMessage): Boolean;
2385	var
2386	S: WideString;
2387	AnsiS: AnsiString;
2388	begin
2389	if TAccessCustomListBox(ListBox).Style in [lbVirtual, lbVirtualOwnerDraw] then
2390	begin
2391	Result := True;
2392	if TntCustomListBox_GetOwnerData(ListBox, OnData, Message.WParam, S) then begin
2393	if Win32PlatformIsUnicode then begin
2394	WStrCopy(PWideChar(Message.LParam), PWideChar(S));
2395	Message.Result := Length(S);
2396	end else begin
2397	AnsiS := S;
2398	StrCopy{TNT-ALLOW StrCopy}(PAnsiChar(Message.LParam), PAnsiChar(AnsiS));
2399	Message.Result := Length(AnsiS);
2400	end;
2401	end
2402	else
2403	Message.Result := LB_ERR;
2404	end
2405	else
2406	Result := False;
2407	end;
2408
2409	function TntCustomListBox_LBGetTextLen(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox}; OnData: TLBGetWideDataEvent; var Message: TMessage): Boolean;
2410	var
2411	S: WideString;
2412	begin
2413	if TAccessCustomListBox(ListBox).Style in [lbVirtual, lbVirtualOwnerDraw] then
2414	begin
2415	Result := True;
2416	if TntCustomListBox_GetOwnerData(ListBox, OnData, Message.WParam, S) then begin
2417	if Win32PlatformIsUnicode then
2418	Message.Result := Length(S)
2419	else
2420	Message.Result := Length(AnsiString(S));
2421	end else
2422	Message.Result := LB_ERR;
2423	end
2424	else
2425	Result := False;
2426	end;
2427
2428	{ TTntCustomListBox }
2429
2430	constructor TTntCustomListBox.Create(AOwner: TComponent);
2431	begin
2432	inherited;
2433	FItems := TTntListBoxStrings.Create;
2434	TTntListBoxStrings(FItems).ListBox := Self;
2435	end;
2436
2437	destructor TTntCustomListBox.Destroy;
2438	begin
2439	FreeAndNil(FItems);
2440	FreeAndNil(FSaveItems);
2441	inherited;
2442	end;
2443
2444	procedure TTntCustomListBox.CreateWindowHandle(const Params: TCreateParams);
2445	begin
2446	CreateUnicodeHandle(Self, Params, 'LISTBOX');
2447	end;
2448
2449	procedure TTntCustomListBox.DefineProperties(Filer: TFiler);
2450	begin
2451	inherited;
2452	TntPersistent_AfterInherited_DefineProperties(Filer, Self);
2453	end;
2454
2455	procedure TTntCustomListBox.CreateWnd;
2456	begin
2457	inherited;
2458	TntListBox_AfterInherited_CreateWnd(Self, FSaveItems, FItems, FSaveTopIndex, FSaveItemIndex);
2459	end;
2460
2461	procedure TTntCustomListBox.DestroyWnd;
2462	begin
2463	TntListBox_BeforeInherited_DestroyWnd(Self, FSaveItems, FItems, FSaveTopIndex, FSaveItemIndex);
2464	inherited;
2465	end;
2466
2467	procedure TTntCustomListBox.SetItems(const Value: TTntStrings);
2468	begin
2469	FItems.Assign(Value);
2470	end;
2471
2472	procedure TTntCustomListBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
2473	begin
2474	if Assigned(OnDrawItem) then
2475	OnDrawItem(Self, Index, Rect, State)
2476	else
2477	TntListBox_DrawItem_Text(Self, Items, Index, Rect);
2478	end;
2479
2480	function TTntCustomListBox.IsHintStored: Boolean;
2481	begin
2482	Result := TntControl_IsHintStored(Self)
2483	end;
2484
2485	function TTntCustomListBox.GetHint: WideString;
2486	begin
2487	Result := TntControl_GetHint(Self)
2488	end;
2489
2490	procedure TTntCustomListBox.SetHint(const Value: WideString);
2491	begin
2492	TntControl_SetHint(Self, Value);
2493	end;
2494
2495	procedure TTntCustomListBox.AddItem(const Item: WideString; AObject: TObject);
2496	begin
2497	TntListBox_AddItem(Items, Item, AObject);
2498	end;
2499
2500	procedure TTntCustomListBox.CopySelection(Destination: TCustomListControl);
2501	begin
2502	TntListBox_CopySelection(Self, Items, Destination);
2503	end;
2504
2505	procedure TTntCustomListBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
2506	begin
2507	TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
2508	inherited;
2509	end;
2510
2511	function TTntCustomListBox.GetActionLinkClass: TControlActionLinkClass;
2512	begin
2513	Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
2514	end;
2515
2516	procedure TTntCustomListBox.LBGetText(var Message: TMessage);
2517	begin
2518	if not TntCustomListBox_LBGetText(Self, OnData, Message) then
2519	inherited;
2520	end;
2521
2522	procedure TTntCustomListBox.LBGetTextLen(var Message: TMessage);
2523	begin
2524	if not TntCustomListBox_LBGetTextLen(Self, OnData, Message) then
2525	inherited;
2526	end;
2527
2528	// --- label helper procs
2529
2530	type TAccessCustomLabel = class(TCustomLabel{TNT-ALLOW TCustomLabel});
2531
2532	function TntLabel_DoDrawText(Control: TCustomLabel{TNT-ALLOW TCustomLabel}; var Rect: TRect; Flags: Integer; const GetLabelText: WideString): Boolean;
2533	{$IFDEF COMPILER_9_UP}
2534	const
2535	EllipsisStr = '...';
2536	Ellipsis: array[TEllipsisPosition] of Longint = (0, DT_PATH_ELLIPSIS,
2537	DT_END_ELLIPSIS, DT_WORD_ELLIPSIS);
2538	{$ENDIF}
2539	var
2540	Text: WideString;
2541	ShowAccelChar: Boolean;
2542	Canvas: TCanvas;
2543	{$IFDEF COMPILER_9_UP}
2544	DText: WideString;
2545	NewRect: TRect;
2546	Height: Integer;
2547	Delim: Integer;
2548	{$ENDIF}
2549	begin
2550	Result := False;
2551	if Win32PlatformIsUnicode then begin
2552	Result := True;
2553	Text := GetLabelText;
2554	ShowAccelChar := TAccessCustomLabel(Control).ShowAccelChar;
2555	Canvas := Control.Canvas;
2556	if (Flags and DT_CALCRECT <> 0) and ((Text = '') or ShowAccelChar and
2557	(Text[1] = '&') and (Text[2] = #0)) then Text := Text + ' ';
2558	if not ShowAccelChar then Flags := Flags or DT_NOPREFIX;
2559	Flags := Control.DrawTextBiDiModeFlags(Flags);
2560	Canvas.Font := TAccessCustomLabel(Control).Font;
2561	{$IFDEF COMPILER_9_UP}
2562	if (TAccessCustomLabel(Control).EllipsisPosition <> epNone)
2563	and (not TAccessCustomLabel(Control).AutoSize) then
2564	begin
2565	DText := Text;
2566	Flags := Flags and not (DT_EXPANDTABS or DT_CALCRECT);
2567	Flags := Flags or Ellipsis[TAccessCustomLabel(Control).EllipsisPosition];
2568	if TAccessCustomLabel(Control).WordWrap
2569	and (TAccessCustomLabel(Control).EllipsisPosition in [epEndEllipsis, epWordEllipsis]) then
2570	begin
2571	repeat
2572	NewRect := Rect;
2573	Dec(NewRect.Right, WideCanvasTextWidth(Canvas, EllipsisStr));
2574	Tnt_DrawTextW(Canvas.Handle, PWideChar(DText), Length(DText), NewRect, Flags or DT_CALCRECT);
2575	Height := NewRect.Bottom - NewRect.Top;
2576	if (Height > TAccessCustomLabel(Control).ClientHeight)
2577	and (Height > Canvas.Font.Height) then
2578	begin
2579	Delim := WideLastDelimiter(' '#9, Text);
2580	if Delim = 0 then
2581	Delim := Length(Text);
2582	Dec(Delim);
2583	Text := Copy(Text, 1, Delim);
2584	DText := Text + EllipsisStr;
2585	if Text = '' then
2586	Break;
2587	end else
2588	Break;
2589	until False;
2590	end;
2591	if Text <> '' then
2592	Text := DText;
2593	end;
2594	{$ENDIF}
2595	if not Control.Enabled then
2596	begin
2597	OffsetRect(Rect, 1, 1);
2598	Canvas.Font.Color := clBtnHighlight;
2599	Tnt_DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), Rect, Flags);
2600	OffsetRect(Rect, -1, -1);
2601	Canvas.Font.Color := clBtnShadow;
2602	Tnt_DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), Rect, Flags);
2603	end
2604	else
2605	Tnt_DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), Rect, Flags);
2606	end;
2607	end;
2608
2609	procedure TntLabel_CMDialogChar(Control: TCustomLabel{TNT-ALLOW TCustomLabel}; var Message: TCMDialogChar; const Caption: WideString);
2610	var
2611	FocusControl: TWinControl;
2612	ShowAccelChar: Boolean;
2613	begin
2614	FocusControl := TAccessCustomLabel(Control).FocusControl;
2615	ShowAccelChar := TAccessCustomLabel(Control).ShowAccelChar;
2616	if (FocusControl <> nil) and Control.Enabled and ShowAccelChar and
2617	IsWideCharAccel(Message.CharCode, Caption) then
2618	with FocusControl do
2619	if CanFocus then
2620	begin
2621	SetFocus;
2622	Message.Result := 1;
2623	end;
2624	end;
2625
2626	{ TTntCustomLabel }
2627
2628	procedure TTntCustomLabel.CMDialogChar(var Message: TCMDialogChar);
2629	begin
2630	TntLabel_CMDialogChar(Self, Message, Caption);
2631	end;
2632
2633	function TTntCustomLabel.IsCaptionStored: Boolean;
2634	begin
2635	Result := TntControl_IsCaptionStored(Self)
2636	end;
2637
2638	function TTntCustomLabel.GetCaption: TWideCaption;
2639	begin
2640	Result := TntControl_GetText(Self);
2641	end;
2642
2643	procedure TTntCustomLabel.SetCaption(const Value: TWideCaption);
2644	begin
2645	TntControl_SetText(Self, Value);
2646	end;
2647
2648	procedure TTntCustomLabel.DefineProperties(Filer: TFiler);
2649	begin
2650	inherited;
2651	TntPersistent_AfterInherited_DefineProperties(Filer, Self);
2652	end;
2653
2654	function TTntCustomLabel.GetLabelText: WideString;
2655	begin
2656	Result := Caption;
2657	end;
2658
2659	procedure TTntCustomLabel.DoDrawText(var Rect: TRect; Flags: Integer);
2660	begin
2661	if not TntLabel_DoDrawText(Self, Rect, Flags, GetLabelText) then
2662	inherited;
2663	end;
2664
2665	function TTntCustomLabel.IsHintStored: Boolean;
2666	begin
2667	Result := TntControl_IsHintStored(Self)
2668	end;
2669
2670	function TTntCustomLabel.GetHint: WideString;
2671	begin
2672	Result := TntControl_GetHint(Self)
2673	end;
2674
2675	procedure TTntCustomLabel.SetHint(const Value: WideString);
2676	begin
2677	TntControl_SetHint(Self, Value);
2678	end;
2679
2680	procedure TTntCustomLabel.CMHintShow(var Message: TMessage);
2681	begin
2682	ProcessCMHintShowMsg(Message);
2683	inherited;
2684	end;
2685
2686	procedure TTntCustomLabel.ActionChange(Sender: TObject; CheckDefaults: Boolean);
2687	begin
2688	TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
2689	inherited;
2690	end;
2691
2692	function TTntCustomLabel.GetActionLinkClass: TControlActionLinkClass;
2693	begin
2694	Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
2695	end;
2696
2697	{ TTntButton }
2698
2699	procedure TntButton_CMDialogChar(Button: TButton{TNT-ALLOW TButton}; var Message: TCMDialogChar);
2700	begin
2701	with Message do
2702	if IsWideCharAccel(Message.CharCode, TntControl_GetText(Button))
2703	and Button.CanFocus then
2704	begin
2705	Button.Click;
2706	Result := 1;
2707	end else
2708	Button.Broadcast(Message);
2709	end;
2710
2711	procedure TTntButton.CreateWindowHandle(const Params: TCreateParams);
2712	begin
2713	CreateUnicodeHandle(Self, Params, 'BUTTON');
2714	end;
2715
2716	procedure TTntButton.DefineProperties(Filer: TFiler);
2717	begin
2718	inherited;
2719	TntPersistent_AfterInherited_DefineProperties(Filer, Self);
2720	end;
2721
2722	procedure TTntButton.CMDialogChar(var Message: TCMDialogChar);
2723	begin
2724	TntButton_CMDialogChar(Self, Message);
2725	end;
2726
2727	function TTntButton.IsCaptionStored: Boolean;
2728	begin
2729	Result := TntControl_IsCaptionStored(Self)
2730	end;
2731
2732	function TTntButton.GetCaption: TWideCaption;
2733	begin
2734	Result := TntControl_GetText(Self)
2735	end;
2736
2737	procedure TTntButton.SetCaption(const Value: TWideCaption);
2738	begin
2739	TntControl_SetText(Self, Value);
2740	end;
2741
2742	function TTntButton.IsHintStored: Boolean;
2743	begin
2744	Result := TntControl_IsHintStored(Self)
2745	end;
2746
2747	function TTntButton.GetHint: WideString;
2748	begin
2749	Result := TntControl_GetHint(Self)
2750	end;
2751
2752	procedure TTntButton.SetHint(const Value: WideString);
2753	begin
2754	TntControl_SetHint(Self, Value);
2755	end;
2756
2757	procedure TTntButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
2758	begin
2759	TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
2760	inherited;
2761	end;
2762
2763	function TTntButton.GetActionLinkClass: TControlActionLinkClass;
2764	begin
2765	Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
2766	end;
2767
2768	{ TTntCustomCheckBox }
2769
2770	procedure TTntCustomCheckBox.CreateWindowHandle(const Params: TCreateParams);
2771	begin
2772	CreateUnicodeHandle(Self, Params, 'BUTTON');
2773	end;
2774
2775	procedure TTntCustomCheckBox.DefineProperties(Filer: TFiler);
2776	begin
2777	inherited;
2778	TntPersistent_AfterInherited_DefineProperties(Filer, Self);
2779	end;
2780
2781	procedure TTntCustomCheckBox.CMDialogChar(var Message: TCMDialogChar);
2782	begin
2783	with Message do
2784	if IsWideCharAccel(Message.CharCode, Caption)
2785	and CanFocus then
2786	begin
2787	SetFocus;
2788	if Focused then Toggle;
2789	Result := 1;
2790	end else
2791	Broadcast(Message);
2792	end;
2793
2794	function TTntCustomCheckBox.IsCaptionStored: Boolean;
2795	begin
2796	Result := TntControl_IsCaptionStored(Self)
2797	end;
2798
2799	function TTntCustomCheckBox.GetCaption: TWideCaption;
2800	begin
2801	Result := TntControl_GetText(Self)
2802	end;
2803
2804	procedure TTntCustomCheckBox.SetCaption(const Value: TWideCaption);
2805	begin
2806	TntControl_SetText(Self, Value);
2807	end;
2808
2809	function TTntCustomCheckBox.IsHintStored: Boolean;
2810	begin
2811	Result := TntControl_IsHintStored(Self)
2812	end;
2813
2814	function TTntCustomCheckBox.GetHint: WideString;
2815	begin
2816	Result := TntControl_GetHint(Self)
2817	end;
2818
2819	procedure TTntCustomCheckBox.SetHint(const Value: WideString);
2820	begin
2821	TntControl_SetHint(Self, Value);
2822	end;
2823
2824	procedure TTntCustomCheckBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
2825	begin
2826	TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
2827	inherited;
2828	end;
2829
2830	function TTntCustomCheckBox.GetActionLinkClass: TControlActionLinkClass;
2831	begin
2832	Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
2833	end;
2834
2835	{ TTntRadioButton }
2836
2837	procedure TTntRadioButton.CreateWindowHandle(const Params: TCreateParams);
2838	begin
2839	CreateUnicodeHandle(Self, Params, 'BUTTON');
2840	end;
2841
2842	procedure TTntRadioButton.DefineProperties(Filer: TFiler);
2843	begin
2844	inherited;
2845	TntPersistent_AfterInherited_DefineProperties(Filer, Self);
2846	end;
2847
2848	procedure TTntRadioButton.CMDialogChar(var Message: TCMDialogChar);
2849	begin
2850	with Message do
2851	if IsWideCharAccel(Message.CharCode, Caption)
2852	and CanFocus then
2853	begin
2854	SetFocus;
2855	Result := 1;
2856	end else
2857	Broadcast(Message);
2858	end;
2859
2860	function TTntRadioButton.IsCaptionStored: Boolean;
2861	begin
2862	Result := TntControl_IsCaptionStored(Self);
2863	end;
2864
2865	function TTntRadioButton.GetCaption: TWideCaption;
2866	begin
2867	Result := TntControl_GetText(Self)
2868	end;
2869
2870	procedure TTntRadioButton.SetCaption(const Value: TWideCaption);
2871	begin
2872	TntControl_SetText(Self, Value);
2873	end;
2874
2875	function TTntRadioButton.IsHintStored: Boolean;
2876	begin
2877	Result := TntControl_IsHintStored(Self)
2878	end;
2879
2880	function TTntRadioButton.GetHint: WideString;
2881	begin
2882	Result := TntControl_GetHint(Self)
2883	end;
2884
2885	procedure TTntRadioButton.SetHint(const Value: WideString);
2886	begin
2887	TntControl_SetHint(Self, Value);
2888	end;
2889
2890	procedure TTntRadioButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
2891	begin
2892	TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
2893	inherited;
2894	end;
2895
2896	function TTntRadioButton.GetActionLinkClass: TControlActionLinkClass;
2897	begin
2898	Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
2899	end;
2900
2901	{ TTntScrollBar }
2902
2903	procedure TTntScrollBar.CreateWindowHandle(const Params: TCreateParams);
2904	begin
2905	CreateUnicodeHandle(Self, Params, 'SCROLLBAR');
2906	end;
2907
2908	procedure TTntScrollBar.DefineProperties(Filer: TFiler);
2909	begin
2910	inherited;
2911	TntPersistent_AfterInherited_DefineProperties(Filer, Self);
2912	end;
2913
2914	function TTntScrollBar.IsHintStored: Boolean;
2915	begin
2916	Result := TntControl_IsHintStored(Self)
2917	end;
2918
2919	function TTntScrollBar.GetHint: WideString;
2920	begin
2921	Result := TntControl_GetHint(Self)
2922	end;
2923
2924	procedure TTntScrollBar.SetHint(const Value: WideString);
2925	begin
2926	TntControl_SetHint(Self, Value);
2927	end;
2928
2929	procedure TTntScrollBar.ActionChange(Sender: TObject; CheckDefaults: Boolean);
2930	begin
2931	TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
2932	inherited;
2933	end;
2934
2935	function TTntScrollBar.GetActionLinkClass: TControlActionLinkClass;
2936	begin
2937	Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
2938	end;
2939
2940	{ TTntCustomGroupBox }
2941
2942	procedure TTntCustomGroupBox.CreateWindowHandle(const Params: TCreateParams);
2943	begin
2944	CreateUnicodeHandle(Self, Params, '');
2945	end;
2946
2947	procedure TTntCustomGroupBox.DefineProperties(Filer: TFiler);
2948	begin
2949	inherited;
2950	TntPersistent_AfterInherited_DefineProperties(Filer, Self);
2951	end;
2952
2953	procedure TTntCustomGroupBox.CMDialogChar(var Message: TCMDialogChar);
2954	begin
2955	with Message do
2956	if IsWideCharAccel(Message.CharCode, Caption)
2957	and CanFocus then
2958	begin
2959	SelectFirst;
2960	Result := 1;
2961	end else
2962	Broadcast(Message);
2963	end;
2964
2965	function TTntCustomGroupBox.IsCaptionStored: Boolean;
2966	begin
2967	Result := TntControl_IsCaptionStored(Self);
2968	end;
2969
2970	function TTntCustomGroupBox.GetCaption: TWideCaption;
2971	begin
2972	Result := TntControl_GetText(Self)
2973	end;
2974
2975	procedure TTntCustomGroupBox.SetCaption(const Value: TWideCaption);
2976	begin
2977	TntControl_SetText(Self, Value);
2978	end;
2979
2980	procedure TTntCustomGroupBox.Paint;
2981
2982	{$IFDEF THEME_7_UP}
2983	procedure PaintThemedGroupBox;
2984	var
2985	CaptionRect: TRect;
2986	OuterRect: TRect;
2987	Size: TSize;
2988	Box: TThemedButton;
2989	Details: TThemedElementDetails;
2990	begin
2991	with Canvas do begin
2992	if Caption <> '' then
2993	begin
2994	GetTextExtentPoint32W(Handle, PWideChar(Caption), Length(Caption), Size);
2995	CaptionRect := Rect(0, 0, Size.cx, Size.cy);
2996	if not UseRightToLeftAlignment then
2997	OffsetRect(CaptionRect, 8, 0)
2998	else
2999	OffsetRect(CaptionRect, Width - 8 - CaptionRect.Right, 0);
3000	end
3001	else
3002	CaptionRect := Rect(0, 0, 0, 0);
3003
3004	OuterRect := ClientRect;
3005	OuterRect.Top := (CaptionRect.Bottom - CaptionRect.Top) div 2;
3006	with CaptionRect do
3007	ExcludeClipRect(Handle, Left, Top, Right, Bottom);
3008	if Enabled then
3009	Box := tbGroupBoxNormal
3010	else
3011	Box := tbGroupBoxDisabled;
3012	Details := ThemeServices.GetElementDetails(Box);
3013	ThemeServices.DrawElement(Handle, Details, OuterRect);
3014
3015	SelectClipRgn(Handle, 0);
3016	if Text <> '' then
3017	ThemeServices.DrawText{TNT-ALLOW DrawText}(Handle, Details, Caption, CaptionRect, DT_LEFT, 0);
3018	end;
3019	end;
3020	{$ENDIF}
3021
3022	procedure PaintGroupBox;
3023	var
3024	H: Integer;
3025	R: TRect;
3026	Flags: Longint;
3027	begin
3028	with Canvas do begin
3029	H := WideCanvasTextHeight(Canvas, '0');
3030	R := Rect(0, H div 2 - 1, Width, Height);
3031	if Ctl3D then
3032	begin
3033	Inc(R.Left);
3034	Inc(R.Top);
3035	Brush.Color := clBtnHighlight;
3036	FrameRect(R);
3037	OffsetRect(R, -1, -1);
3038	Brush.Color := clBtnShadow;
3039	end else
3040	Brush.Color := clWindowFrame;
3041	FrameRect(R);
3042	if Caption <> '' then
3043	begin
3044	if not UseRightToLeftAlignment then
3045	R := Rect(8, 0, 0, H)
3046	else
3047	R := Rect(R.Right - WideCanvasTextWidth(Canvas, Caption) - 8, 0, 0, H);
3048	Flags := DrawTextBiDiModeFlags(DT_SINGLELINE);
3049	Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), R, Flags or DT_CALCRECT);
3050	Brush.Color := Color;
3051	Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), R, Flags);
3052	end;
3053	end;
3054	end;
3055
3056	begin
3057	if (not Win32PlatformIsUnicode) then
3058	inherited
3059	else
3060	begin
3061	Canvas.Font := Self.Font;
3062	{$IFDEF THEME_7_UP}
3063	if ThemeServices.ThemesEnabled then
3064	PaintThemedGroupBox
3065	else
3066	PaintGroupBox;
3067	{$ELSE}
3068	PaintGroupBox;
3069	{$ENDIF}
3070	end;
3071	end;
3072
3073	function TTntCustomGroupBox.IsHintStored: Boolean;
3074	begin
3075	Result := TntControl_IsHintStored(Self)
3076	end;
3077
3078	function TTntCustomGroupBox.GetHint: WideString;
3079	begin
3080	Result := TntControl_GetHint(Self);
3081	end;
3082
3083	procedure TTntCustomGroupBox.SetHint(const Value: WideString);
3084	begin
3085	TntControl_SetHint(Self, Value);
3086	end;
3087
3088	procedure TTntCustomGroupBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
3089	begin
3090	TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
3091	inherited;
3092	end;
3093
3094	function TTntCustomGroupBox.GetActionLinkClass: TControlActionLinkClass;
3095	begin
3096	Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
3097	end;
3098
3099	{ TTntCustomStaticText }
3100
3101	constructor TTntCustomStaticText.Create(AOwner: TComponent);
3102	begin
3103	inherited;
3104	AdjustBounds;
3105	end;
3106
3107	procedure TTntCustomStaticText.CMFontChanged(var Message: TMessage);
3108	begin
3109	inherited;
3110	AdjustBounds;
3111	end;
3112
3113	procedure TTntCustomStaticText.CMTextChanged(var Message: TMessage);
3114	begin
3115	inherited;
3116	AdjustBounds;
3117	end;
3118
3119	procedure TTntCustomStaticText.Loaded;
3120	begin
3121	inherited;
3122	AdjustBounds;
3123	end;
3124
3125	procedure TTntCustomStaticText.SetAutoSize(AValue: boolean);
3126	begin
3127	inherited;
3128	if AValue then
3129	AdjustBounds;
3130	end;
3131
3132	procedure TTntCustomStaticText.CreateWindowHandle(const Params: TCreateParams);
3133	begin
3134	CreateUnicodeHandle(Self, Params, 'STATIC');
3135	end;
3136
3137	procedure TTntCustomStaticText.DefineProperties(Filer: TFiler);
3138	begin
3139	inherited;
3140	TntPersistent_AfterInherited_DefineProperties(Filer, Self);
3141	end;
3142
3143	procedure TTntCustomStaticText.CMDialogChar(var Message: TCMDialogChar);
3144	begin
3145	if (FocusControl <> nil) and Enabled and ShowAccelChar and
3146	IsWideCharAccel(Message.CharCode, Caption) then
3147	with FocusControl do
3148	if CanFocus then
3149	begin
3150	SetFocus;
3151	Message.Result := 1;
3152	end;
3153	end;
3154
3155	function TTntCustomStaticText.IsCaptionStored: Boolean;
3156	begin
3157	Result := TntControl_IsCaptionStored(Self)
3158	end;
3159
3160	procedure TTntCustomStaticText.AdjustBounds;
3161	var
3162	DC: HDC;
3163	SaveFont: HFont;
3164	TextSize: TSize;
3165	begin
3166	if not (csReading in ComponentState) and AutoSize then
3167	begin
3168	DC := GetDC(0);
3169	SaveFont := SelectObject(DC, Font.Handle);
3170	GetTextExtentPoint32W(DC, PWideChar(Caption), Length(Caption), TextSize);
3171	SelectObject(DC, SaveFont);
3172	ReleaseDC(0, DC);
3173	SetBounds(Left, Top,
3174	TextSize.cx + (GetSystemMetrics(SM_CXBORDER) * 4),
3175	TextSize.cy + (GetSystemMetrics(SM_CYBORDER) * 4));
3176	end;
3177	end;
3178
3179	function TTntCustomStaticText.GetCaption: TWideCaption;
3180	begin
3181	Result := TntControl_GetText(Self)
3182	end;
3183
3184	procedure TTntCustomStaticText.SetCaption(const Value: TWideCaption);
3185	begin
3186	TntControl_SetText(Self, Value);
3187	end;
3188
3189	function TTntCustomStaticText.IsHintStored: Boolean;
3190	begin
3191	Result := TntControl_IsHintStored(Self)
3192	end;
3193
3194	function TTntCustomStaticText.GetHint: WideString;
3195	begin
3196	Result := TntControl_GetHint(Self)
3197	end;
3198
3199	procedure TTntCustomStaticText.SetHint(const Value: WideString);
3200	begin
3201	TntControl_SetHint(Self, Value);
3202	end;
3203
3204	procedure TTntCustomStaticText.ActionChange(Sender: TObject; CheckDefaults: Boolean);
3205	begin
3206	TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
3207	inherited;
3208	end;
3209
3210	function TTntCustomStaticText.GetActionLinkClass: TControlActionLinkClass;
3211	begin
3212	Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
3213	end;
3214
3215	end.

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: cprs/branches/tmg-cprs/TMG_Extra/tntUniCode/Source/TntStdCtrls.pas@ 1083

Download in other formats: