source: cprs/branches/tmg-cprs/TntWare/Delphi Unicode Controls/Source/TntStdCtrls.pas@ 541

Last change on this file since 541 was 453, checked in by Kevin Toppenberg, 16 years ago

Initial upload of TMG-CPRS 1.0.26.69
File size: 98.6 KB
RevLine 
[453]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
12unit TntStdCtrls;
13
14{$INCLUDE TntCompilers.inc}
15
16interface
17
18{ TODO: Implement TCustomListBox.KeyPress, OnDataFind. }
19
20uses
21 Windows, Messages, Classes, Controls, TntControls, StdCtrls, Graphics,
22 TntClasses, TntSysUtils;
23
24{TNT-WARN TCustomEdit}
25type
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
126type
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
265type
266 TWMCharMsgHandler = procedure(var Message: TWMChar) of object;
267
268{$IFDEF DELPHI_7} // fix for Delphi 7 only
269{ TD7PatchedComboBoxStrings }
270type
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
280type
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}
287type
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}
444type
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
927procedure TntCombo_AfterInherited_CreateWnd(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
928 Items: TTntStrings; var FSaveItems: TTntStrings; FSaveItemIndex: integer; PreInheritedAnsiText: AnsiString);
929procedure TntCombo_BeforeInherited_DestroyWnd(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
930 Items: TTntStrings; var FSaveItems: TTntStrings; ItemIndex: integer; var FSaveItemIndex: integer;
931 var SavedText: WideString);
932function TntCombo_ComboWndProc(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
933 var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer; DoEditCharMsg: TWMCharMsgHandler): Boolean;
934function TntCombo_CNCommand(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; Items: TTntStrings; var Message: TWMCommand): Boolean;
935function TntCombo_GetSelStart(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}): Integer;
936procedure TntCombo_SetSelStart(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; const Value: Integer);
937function TntCombo_GetSelLength(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}): Integer;
938procedure TntCombo_SetSelLength(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; const Value: Integer);
939function TntCombo_GetSelText(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}): WideString;
940procedure TntCombo_SetSelText(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; const Value: WideString);
941procedure TntCombo_BeforeKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; var SaveAutoComplete: Boolean);
942procedure TntCombo_AfterKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; var SaveAutoComplete: Boolean);
943procedure TntCombo_DropDown_PreserveSelection(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox});
944procedure TntComboBox_AddItem(Items: TTntStrings; const Item: WideString; AObject: TObject);
945procedure TntComboBox_CopySelection(Items: TTntStrings; ItemIndex: Integer;
946 Destination: TCustomListControl);
947procedure TntCombo_AutoSearchKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
948 Items: TTntStrings; var Message: TWMChar; var FFilter: WideString; var FLastTime: Cardinal);
949procedure TntCombo_AutoCompleteKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
950 Items: TTntStrings; var Message: TWMChar;
951 AutoComplete_UniqueMatchOnly, AutoComplete_PreserveDataEntryCase: Boolean);
952procedure TntCombo_DefaultDrawItem(Canvas: TCanvas; Index: Integer; Rect: TRect;
953 State: TOwnerDrawState; Items: TTntStrings);
954
955procedure TntCustomEdit_CreateWindowHandle(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Params: TCreateParams);
956procedure TntCustomEdit_AfterInherited_CreateWnd(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; var FPasswordChar: WideChar);
957function TntCustomEdit_GetSelStart(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}): Integer;
958procedure TntCustomEdit_SetSelStart(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Value: Integer);
959function TntCustomEdit_GetSelLength(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}): Integer;
960procedure TntCustomEdit_SetSelLength(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Value: Integer);
961function TntCustomEdit_GetSelText(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}): WideString;
962procedure TntCustomEdit_SetSelText(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Value: WideString);
963function TntCustomEdit_GetPasswordChar(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; var FPasswordChar: WideChar): WideChar;
964procedure TntCustomEdit_SetPasswordChar(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; var FPasswordChar: WideChar; const Value: WideChar);
965
966
967function TntMemo_LineStart(Handle: THandle; Index: Integer): Integer;
968function TntMemo_LineLength(Handle: THandle; Index: Integer; StartPos: Integer = -1): Integer;
969
970procedure TntListBox_AfterInherited_CreateWnd(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox};
971 var FSaveItems: TTntStrings; FItems: TTntStrings; FSaveTopIndex, FSaveItemIndex: Integer);
972procedure TntListBox_BeforeInherited_DestroyWnd(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox};
973 var FSaveItems: TTntStrings; const FItems: TTntStrings; var FSaveTopIndex, FSaveItemIndex: Integer);
974procedure TntListBox_DrawItem_Text(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox}; Items: TTntStrings; Index: Integer; Rect: TRect);
975procedure TntListBox_AddItem(Items: TTntStrings; const Item: WideString; AObject: TObject);
976procedure TntListBox_CopySelection(ListBox: TCustomListbox{TNT-ALLOW TCustomListbox};
977 Items: TTntStrings; Destination: TCustomListControl);
978function TntCustomListBox_LBGetText(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox}; OnData: TLBGetWideDataEvent; var Message: TMessage): Boolean;
979function TntCustomListBox_LBGetTextLen(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox}; OnData: TLBGetWideDataEvent; var Message: TMessage): Boolean;
980
981function TntLabel_DoDrawText(Control: TCustomLabel{TNT-ALLOW TCustomLabel}; var Rect: TRect; Flags: Integer; const GetLabelText: WideString): Boolean;
982procedure TntLabel_CMDialogChar(Control: TCustomLabel{TNT-ALLOW TCustomLabel}; var Message: TCMDialogChar; const Caption: WideString);
983
984procedure TntButton_CMDialogChar(Button: TButton{TNT-ALLOW TButton}; var Message: TCMDialogChar);
985
986implementation
987
988uses
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
996procedure TntCustomEdit_CreateWindowHandle(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Params: TCreateParams);
997var
998 P: TCreateParams;
999begin
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');
1011end;
1012
1013procedure TntCustomEdit_AfterInherited_CreateWnd(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; var FPasswordChar: WideChar);
1014var
1015 PasswordChar: WideChar;
1016begin
1017 PasswordChar := TntCustomEdit_GetPasswordChar(Edit, FPasswordChar);
1018 if Win32PlatformIsUnicode then
1019 SendMessageW(Edit.Handle, EM_SETPASSWORDCHAR, Ord(PasswordChar), 0);
1020end;
1021
1022function TntCustomEdit_GetSelStart(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}): Integer;
1023begin
1024 if Win32PlatformIsUnicode then
1025 Result := Edit.SelStart
1026 else
1027 Result := Length(WideString(Copy(Edit.Text, 1, Edit.SelStart)));
1028end;
1029
1030procedure TntCustomEdit_SetSelStart(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Value: Integer);
1031begin
1032 if Win32PlatformIsUnicode then
1033 Edit.SelStart := Value
1034 else
1035 Edit.SelStart := Length(AnsiString(Copy(TntControl_GetText(Edit), 1, Value)));
1036end;
1037
1038function TntCustomEdit_GetSelLength(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}): Integer;
1039begin
1040 if Win32PlatformIsUnicode then
1041 Result := Edit.SelLength
1042 else
1043 Result := Length(TntCustomEdit_GetSelText(Edit));
1044end;
1045
1046procedure TntCustomEdit_SetSelLength(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Value: Integer);
1047var
1048 StartPos: Integer;
1049begin
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;
1056end;
1057
1058function TntCustomEdit_GetSelText(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}): WideString;
1059begin
1060 if Win32PlatformIsUnicode then
1061 Result := Copy(TntControl_GetText(Edit), Edit.SelStart + 1, Edit.SelLength)
1062 else
1063 Result := Edit.SelText
1064end;
1065
1066procedure TntCustomEdit_SetSelText(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; const Value: WideString);
1067begin
1068 if Win32PlatformIsUnicode then
1069 SendMessageW(Edit.Handle, EM_REPLACESEL, 0, Longint(PWideChar(Value)))
1070 else
1071 Edit.SelText := Value;
1072end;
1073
1074function WideCharToAnsiChar(const C: WideChar): AnsiChar;
1075begin
1076 if C <= High(AnsiChar) then
1077 Result := AnsiChar(C)
1078 else
1079 Result := '*';
1080end;
1081
1082type TAccessCustomEdit = class(TCustomEdit{TNT-ALLOW TCustomEdit});
1083
1084function TntCustomEdit_GetPasswordChar(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; var FPasswordChar: WideChar): WideChar;
1085begin
1086 if TAccessCustomEdit(Edit).PasswordChar <> WideCharToAnsiChar(FPasswordChar) then
1087 FPasswordChar := WideChar(TAccessCustomEdit(Edit).PasswordChar);
1088 Result := FPasswordChar;
1089end;
1090
1091procedure TntCustomEdit_SetPasswordChar(Edit: TCustomEdit{TNT-ALLOW TCustomEdit}; var FPasswordChar: WideChar; const Value: WideChar);
1092var
1093 SaveWindowHandle: Integer;
1094 PasswordCharSetHere: Boolean;
1095begin
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;
1116end;
1117
1118procedure TTntCustomEdit.CreateWindowHandle(const Params: TCreateParams);
1119begin
1120 TntCustomEdit_CreateWindowHandle(Self, Params);
1121end;
1122
1123procedure TTntCustomEdit.CreateWnd;
1124begin
1125 inherited;
1126 TntCustomEdit_AfterInherited_CreateWnd(Self, FPasswordChar);
1127end;
1128
1129procedure TTntCustomEdit.DefineProperties(Filer: TFiler);
1130begin
1131 inherited;
1132 TntPersistent_AfterInherited_DefineProperties(Filer, Self);
1133end;
1134
1135function TTntCustomEdit.GetSelStart: Integer;
1136begin
1137 Result := TntCustomEdit_GetSelStart(Self);
1138end;
1139
1140procedure TTntCustomEdit.SetSelStart(const Value: Integer);
1141begin
1142 TntCustomEdit_SetSelStart(Self, Value);
1143end;
1144
1145function TTntCustomEdit.GetSelLength: Integer;
1146begin
1147 Result := TntCustomEdit_GetSelLength(Self);
1148end;
1149
1150procedure TTntCustomEdit.SetSelLength(const Value: Integer);
1151begin
1152 TntCustomEdit_SetSelLength(Self, Value);
1153end;
1154
1155function TTntCustomEdit.GetSelText: WideString;
1156begin
1157 Result := TntCustomEdit_GetSelText(Self);
1158end;
1159
1160procedure TTntCustomEdit.SetSelText(const Value: WideString);
1161begin
1162 TntCustomEdit_SetSelText(Self, Value);
1163end;
1164
1165function TTntCustomEdit.GetPasswordChar: WideChar;
1166begin
1167 Result := TntCustomEdit_GetPasswordChar(Self, FPasswordChar);
1168end;
1169
1170procedure TTntCustomEdit.SetPasswordChar(const Value: WideChar);
1171begin
1172 TntCustomEdit_SetPasswordChar(Self, FPasswordChar, Value);
1173end;
1174
1175function TTntCustomEdit.GetText: WideString;
1176begin
1177 Result := TntControl_GetText(Self);
1178end;
1179
1180procedure TTntCustomEdit.SetText(const Value: WideString);
1181begin
1182 TntControl_SetText(Self, Value);
1183end;
1184
1185function TTntCustomEdit.IsHintStored: Boolean;
1186begin
1187 Result := TntControl_IsHintStored(Self);
1188end;
1189
1190function TTntCustomEdit.GetHint: WideString;
1191begin
1192 Result := TntControl_GetHint(Self)
1193end;
1194
1195procedure TTntCustomEdit.SetHint(const Value: WideString);
1196begin
1197 TntControl_SetHint(Self, Value);
1198end;
1199
1200procedure TTntCustomEdit.ActionChange(Sender: TObject; CheckDefaults: Boolean);
1201begin
1202 TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
1203 inherited;
1204end;
1205
1206function TTntCustomEdit.GetActionLinkClass: TControlActionLinkClass;
1207begin
1208 Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
1209end;
1210
1211{ TTntMemoStrings }
1212
1213constructor TTntMemoStrings.Create;
1214begin
1215 inherited;
1216 FLineBreakStyle := tlbsCRLF;
1217end;
1218
1219function TTntMemoStrings.GetCount: Integer;
1220begin
1221 Result := FMemoLines.Count;
1222end;
1223
1224function TntMemo_LineStart(Handle: THandle; Index: Integer): Integer;
1225begin
1226 Assert(Win32PlatformIsUnicode);
1227 Result := SendMessageW(Handle, EM_LINEINDEX, Index, 0);
1228end;
1229
1230function TntMemo_LineLength(Handle: THandle; Index: Integer; StartPos: Integer = -1): Integer;
1231begin
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);
1239end;
1240
1241function TTntMemoStrings.Get(Index: Integer): WideString;
1242var
1243 Len: Integer;
1244begin
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;
1257end;
1258
1259procedure TTntMemoStrings.Put(Index: Integer; const S: WideString);
1260var
1261 StartPos: Integer;
1262begin
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;
1273end;
1274
1275procedure 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
1285var
1286 StartPos, LineLen: Integer;
1287 Line: WideString;
1288begin
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;
1323end;
1324
1325procedure TTntMemoStrings.Delete(Index: Integer);
1326begin
1327 FMemoLines.Delete(Index);
1328end;
1329
1330procedure TTntMemoStrings.Clear;
1331begin
1332 FMemoLines.Clear;
1333end;
1334
1335type TAccessStrings = class(TStrings{TNT-ALLOW TStrings});
1336
1337procedure TTntMemoStrings.SetUpdateState(Updating: Boolean);
1338begin
1339 TAccessStrings(FMemoLines).SetUpdateState(Updating);
1340end;
1341
1342function TTntMemoStrings.GetTextStr: WideString;
1343begin
1344 if (not FRichEditMode) then
1345 Result := TntControl_GetText(FMemo)
1346 else
1347 Result := inherited GetTextStr;
1348end;
1349
1350procedure TTntMemoStrings.SetTextStr(const Value: WideString);
1351var
1352 NewText: WideString;
1353begin
1354 NewText := TntAdjustLineBreaks(Value, FLineBreakStyle);
1355 if NewText <> GetTextStr then begin
1356 FMemo.HandleNeeded;
1357 TntControl_SetText(FMemo, NewText);
1358 end;
1359end;
1360
1361{ TTntCustomMemo }
1362
1363constructor TTntCustomMemo.Create(AOwner: TComponent);
1364begin
1365 inherited;
1366 FLines := TTntMemoStrings.Create;
1367 TTntMemoStrings(FLines).FMemo := Self;
1368 TTntMemoStrings(FLines).FMemoLines := TCustomMemo{TNT-ALLOW TCustomMemo}(Self).Lines;
1369end;
1370
1371destructor TTntCustomMemo.Destroy;
1372begin
1373 FreeAndNil(FLines);
1374 inherited;
1375end;
1376
1377procedure TTntCustomMemo.SetLines(const Value: TTntStrings);
1378begin
1379 FLines.Assign(Value);
1380end;
1381
1382procedure TTntCustomMemo.CreateWindowHandle(const Params: TCreateParams);
1383begin
1384 TntCustomEdit_CreateWindowHandle(Self, Params);
1385end;
1386
1387procedure TTntCustomMemo.DefineProperties(Filer: TFiler);
1388begin
1389 inherited;
1390 TntPersistent_AfterInherited_DefineProperties(Filer, Self);
1391end;
1392
1393function TTntCustomMemo.GetSelStart: Integer;
1394begin
1395 Result := TntCustomEdit_GetSelStart(Self);
1396end;
1397
1398procedure TTntCustomMemo.SetSelStart(const Value: Integer);
1399begin
1400 TntCustomEdit_SetSelStart(Self, Value);
1401end;
1402
1403function TTntCustomMemo.GetSelLength: Integer;
1404begin
1405 Result := TntCustomEdit_GetSelLength(Self);
1406end;
1407
1408procedure TTntCustomMemo.SetSelLength(const Value: Integer);
1409begin
1410 TntCustomEdit_SetSelLength(Self, Value);
1411end;
1412
1413function TTntCustomMemo.GetSelText: WideString;
1414begin
1415 Result := TntCustomEdit_GetSelText(Self);
1416end;
1417
1418procedure TTntCustomMemo.SetSelText(const Value: WideString);
1419begin
1420 TntCustomEdit_SetSelText(Self, Value);
1421end;
1422
1423function TTntCustomMemo.GetText: WideString;
1424begin
1425 Result := TntControl_GetText(Self);
1426end;
1427
1428procedure TTntCustomMemo.SetText(const Value: WideString);
1429begin
1430 TntControl_SetText(Self, Value);
1431end;
1432
1433function TTntCustomMemo.IsHintStored: Boolean;
1434begin
1435 Result := TntControl_IsHintStored(Self);
1436end;
1437
1438function TTntCustomMemo.GetHint: WideString;
1439begin
1440 Result := TntControl_GetHint(Self)
1441end;
1442
1443procedure TTntCustomMemo.SetHint(const Value: WideString);
1444begin
1445 TntControl_SetHint(Self, Value);
1446end;
1447
1448procedure TTntCustomMemo.ActionChange(Sender: TObject; CheckDefaults: Boolean);
1449begin
1450 TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
1451 inherited;
1452end;
1453
1454function TTntCustomMemo.GetActionLinkClass: TControlActionLinkClass;
1455begin
1456 Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
1457end;
1458
1459{$IFDEF DELPHI_7} // fix for Delphi 7 only
1460function TD7PatchedComboBoxStrings.Get(Index: Integer): string{TNT-ALLOW string};
1461var
1462 Len: Integer;
1463begin
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);
1472end;
1473
1474function TD7PatchedComboBoxStrings.Add(const S: string{TNT-ALLOW string}): Integer;
1475begin
1476 Result := SendMessage(ComboBox.Handle, CB_ADDSTRING, 0, Longint(PChar{TNT-ALLOW PChar}(S)));
1477 if Result < 0 then
1478 raise EOutOfResources.Create(SInsertLineError);
1479end;
1480
1481procedure TD7PatchedComboBoxStrings.Insert(Index: Integer; const S: string{TNT-ALLOW string});
1482begin
1483 if SendMessage(ComboBox.Handle, CB_INSERTSTRING, Index,
1484 Longint(PChar{TNT-ALLOW PChar}(S))) < 0 then
1485 raise EOutOfResources.Create(SInsertLineError);
1486end;
1487{$ENDIF}
1488
1489{ TTntComboBoxStrings }
1490
1491function TTntComboBoxStrings.GetCount: Integer;
1492begin
1493 Result := ComboBox.Items.Count;
1494end;
1495
1496function TTntComboBoxStrings.Get(Index: Integer): WideString;
1497var
1498 Len: Integer;
1499begin
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;
1515end;
1516
1517function TTntComboBoxStrings.GetObject(Index: Integer): TObject;
1518begin
1519 Result := ComboBox.Items.Objects[Index];
1520end;
1521
1522procedure TTntComboBoxStrings.PutObject(Index: Integer; AObject: TObject);
1523begin
1524 ComboBox.Items.Objects[Index] := AObject;
1525end;
1526
1527function TTntComboBoxStrings.Add(const S: WideString): Integer;
1528begin
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;
1536end;
1537
1538procedure TTntComboBoxStrings.Insert(Index: Integer; const S: WideString);
1539begin
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;
1546end;
1547
1548procedure TTntComboBoxStrings.Delete(Index: Integer);
1549begin
1550 ComboBox.Items.Delete(Index);
1551end;
1552
1553procedure TTntComboBoxStrings.Clear;
1554var
1555 S: WideString;
1556begin
1557 S := TntControl_GetText(ComboBox);
1558 SendMessage(ComboBox.Handle, CB_RESETCONTENT, 0, 0);
1559 TntControl_SetText(ComboBox, S);
1560 ComboBox.Update;
1561end;
1562
1563procedure TTntComboBoxStrings.SetUpdateState(Updating: Boolean);
1564begin
1565 TAccessStrings(ComboBox.Items).SetUpdateState(Updating);
1566end;
1567
1568function TTntComboBoxStrings.IndexOf(const S: WideString): Integer;
1569begin
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)));
1574end;
1575
1576{ TTntCustomComboBox }
1577
1578type TAccessCustomComboBox = class(TCustomComboBox{TNT-ALLOW TCustomComboBox});
1579
1580procedure TntCombo_AfterInherited_CreateWnd(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
1581 Items: TTntStrings; var FSaveItems: TTntStrings; FSaveItemIndex: integer; PreInheritedAnsiText: AnsiString);
1582begin
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;
1609end;
1610
1611procedure TntCombo_BeforeInherited_DestroyWnd(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
1612 Items: TTntStrings; var FSaveItems: TTntStrings; ItemIndex: integer; var FSaveItemIndex: integer;
1613 var SavedText: WideString);
1614begin
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;
1626end;
1627
1628function 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
1647begin
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;
1688end;
1689
1690function TntCombo_CNCommand(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; Items: TTntStrings; var Message: TWMCommand): Boolean;
1691begin
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;
1699end;
1700
1701function TntCombo_GetSelStart(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}): Integer;
1702begin
1703 if Win32PlatformIsUnicode then
1704 Result := Combo.SelStart
1705 else
1706 Result := Length(WideString(Copy(TAccessCustomComboBox(Combo).Text, 1, Combo.SelStart)));
1707end;
1708
1709procedure TntCombo_SetSelStart(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; const Value: Integer);
1710begin
1711 if Win32PlatformIsUnicode then
1712 Combo.SelStart := Value
1713 else
1714 Combo.SelStart := Length(AnsiString(Copy(TntControl_GetText(Combo), 1, Value)));
1715end;
1716
1717function TntCombo_GetSelLength(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}): Integer;
1718begin
1719 if Win32PlatformIsUnicode then
1720 Result := Combo.SelLength
1721 else
1722 Result := Length(TntCombo_GetSelText(Combo));
1723end;
1724
1725procedure TntCombo_SetSelLength(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; const Value: Integer);
1726var
1727 StartPos: Integer;
1728begin
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;
1735end;
1736
1737function TntCombo_GetSelText(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}): WideString;
1738begin
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
1745end;
1746
1747procedure TntCombo_SetSelText(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; const Value: WideString);
1748begin
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
1757end;
1758
1759procedure TntCombo_BeforeKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; var SaveAutoComplete: Boolean);
1760begin
1761 SaveAutoComplete := TAccessCustomComboBox(Combo).AutoComplete;
1762 TAccessCustomComboBox(Combo).AutoComplete := False;
1763end;
1764
1765procedure TntCombo_AfterKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; var SaveAutoComplete: Boolean);
1766begin
1767 TAccessCustomComboBox(Combo).AutoComplete := SaveAutoComplete;
1768end;
1769
1770procedure TntCombo_DropDown_PreserveSelection(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox});
1771var
1772 OldSelStart, OldSelLength: Integer;
1773 OldText: WideString;
1774begin
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);
1782end;
1783
1784procedure TntComboBox_AddItem(Items: TTntStrings; const Item: WideString; AObject: TObject);
1785begin
1786 Items.AddObject(Item, AObject);
1787end;
1788
1789procedure TntComboBox_CopySelection(Items: TTntStrings; ItemIndex: Integer;
1790 Destination: TCustomListControl);
1791begin
1792 if ItemIndex <> -1 then
1793 WideListControl_AddItem(Destination, Items[ItemIndex], Items.Objects[ItemIndex]);
1794end;
1795
1796function TntCombo_FindString(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
1797 StartPos: Integer; const Text: WideString): Integer;
1798var
1799 ComboFindString: ITntComboFindString;
1800begin
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))))
1807end;
1808
1809function TntCombo_FindUniqueString(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
1810 StartPos: Integer; const Text: WideString): Integer;
1811var
1812 Match_1, Match_2: Integer;
1813begin
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;
1821end;
1822
1823function TntCombo_AutoSelect(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; Items: TTntStrings;
1824 const SearchText: WideString; UniqueMatchOnly: Boolean; UseDataEntryCase: Boolean): Boolean;
1825var
1826 Idx: Integer;
1827 ValueChange: Boolean;
1828begin
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;
1864end;
1865
1866procedure TntCombo_AutoSearchKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
1867 Items: TTntStrings; var Message: TWMChar; var FFilter: WideString; var FLastTime: Cardinal);
1868var
1869 Key: WideChar;
1870begin
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;
1902end;
1903
1904procedure TntCombo_AutoCompleteKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
1905 Items: TTntStrings; var Message: TWMChar;
1906 AutoComplete_UniqueMatchOnly, AutoComplete_PreserveDataEntryCase: Boolean);
1907var
1908 Key: WideChar;
1909 FindText: WideString;
1910begin
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;
1941end;
1942
1943//--
1944constructor TTntCustomComboBox.Create(AOwner: TComponent);
1945begin
1946 inherited;
1947 FItems := TTntComboBoxStrings.Create;
1948 TTntComboBoxStrings(FItems).ComboBox := Self;
1949end;
1950
1951destructor TTntCustomComboBox.Destroy;
1952begin
1953 FreeAndNil(FItems);
1954 FreeAndNil(FSaveItems);
1955 inherited;
1956end;
1957
1958procedure TTntCustomComboBox.CreateWindowHandle(const Params: TCreateParams);
1959begin
1960 CreateUnicodeHandle(Self, Params, 'COMBOBOX');
1961end;
1962
1963procedure TTntCustomComboBox.DefineProperties(Filer: TFiler);
1964begin
1965 inherited;
1966 TntPersistent_AfterInherited_DefineProperties(Filer, Self);
1967end;
1968
1969procedure TTntCustomComboBox.CreateWnd;
1970var
1971 PreInheritedAnsiText: AnsiString;
1972begin
1973 PreInheritedAnsiText := TAccessCustomComboBox(Self).Text;
1974 inherited;
1975 TntCombo_AfterInherited_CreateWnd(Self, Items, FSaveItems, FSaveItemIndex, PreInheritedAnsiText);
1976end;
1977
1978procedure TTntCustomComboBox.DestroyWnd;
1979var
1980 SavedText: WideString;
1981begin
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;
1987end;
1988
1989procedure TTntCustomComboBox.ComboWndProc(var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer);
1990begin
1991 if not TntCombo_ComboWndProc(Self, Message, ComboWnd, ComboProc, DoEditCharMsg) then
1992 inherited;
1993end;
1994
1995procedure TTntCustomComboBox.KeyPress(var Key: AnsiChar);
1996var
1997 SaveAutoComplete: Boolean;
1998begin
1999 TntCombo_BeforeKeyPress(Self, SaveAutoComplete);
2000 try
2001 inherited;
2002 finally
2003 TntCombo_AfterKeyPress(Self, SaveAutoComplete);
2004 end;
2005end;
2006
2007procedure TTntCustomComboBox.DoEditCharMsg(var Message: TWMChar);
2008begin
2009 TntCombo_AutoCompleteKeyPress(Self, Items, Message,
2010 GetAutoComplete_UniqueMatchOnly, GetAutoComplete_PreserveDataEntryCase);
2011end;
2012
2013procedure TTntCustomComboBox.WMChar(var Message: TWMChar);
2014begin
2015 TntCombo_AutoSearchKeyPress(Self, Items, Message, FFilter, FLastTime);
2016 if Message.CharCode <> 0 then
2017 inherited;
2018end;
2019
2020procedure TntCombo_DefaultDrawItem(Canvas: TCanvas; Index: Integer; Rect: TRect;
2021 State: TOwnerDrawState; Items: TTntStrings);
2022begin
2023 Canvas.FillRect(Rect);
2024 if Index >= 0 then
2025 WideCanvasTextOut(Canvas, Rect.Left + 2, Rect.Top, Items[Index]);
2026end;
2027
2028procedure TTntCustomComboBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
2029begin
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);
2035end;
2036
2037function TTntCustomComboBox.GetItems: TTntStrings;
2038begin
2039 Result := FItems;
2040end;
2041
2042procedure TTntCustomComboBox.SetItems(const Value: TTntStrings);
2043begin
2044 FItems.Assign(Value);
2045end;
2046
2047function TTntCustomComboBox.GetSelStart: Integer;
2048begin
2049 Result := TntCombo_GetSelStart(Self);
2050end;
2051
2052procedure TTntCustomComboBox.SetSelStart(const Value: Integer);
2053begin
2054 TntCombo_SetSelStart(Self, Value);
2055end;
2056
2057function TTntCustomComboBox.GetSelLength: Integer;
2058begin
2059 Result := TntCombo_GetSelLength(Self);
2060end;
2061
2062procedure TTntCustomComboBox.SetSelLength(const Value: Integer);
2063begin
2064 TntCombo_SetSelLength(Self, Value);
2065end;
2066
2067function TTntCustomComboBox.GetSelText: WideString;
2068begin
2069 Result := TntCombo_GetSelText(Self);
2070end;
2071
2072procedure TTntCustomComboBox.SetSelText(const Value: WideString);
2073begin
2074 TntCombo_SetSelText(Self, Value);
2075end;
2076
2077function TTntCustomComboBox.GetText: WideString;
2078begin
2079 Result := TntControl_GetText(Self);
2080end;
2081
2082procedure TTntCustomComboBox.SetText(const Value: WideString);
2083begin
2084 TntControl_SetText(Self, Value);
2085end;
2086
2087procedure TTntCustomComboBox.CNCommand(var Message: TWMCommand);
2088begin
2089 if not TntCombo_CNCommand(Self, Items, Message) then
2090 inherited;
2091end;
2092
2093function TTntCustomComboBox.GetAutoComplete_PreserveDataEntryCase: Boolean;
2094begin
2095 Result := True;
2096end;
2097
2098function TTntCustomComboBox.GetAutoComplete_UniqueMatchOnly: Boolean;
2099begin
2100 Result := False;
2101end;
2102
2103function TTntCustomComboBox.IsHintStored: Boolean;
2104begin
2105 Result := TntControl_IsHintStored(Self)
2106end;
2107
2108function TTntCustomComboBox.GetHint: WideString;
2109begin
2110 Result := TntControl_GetHint(Self)
2111end;
2112
2113procedure TTntCustomComboBox.SetHint(const Value: WideString);
2114begin
2115 TntControl_SetHint(Self, Value);
2116end;
2117
2118procedure TTntCustomComboBox.AddItem(const Item: WideString; AObject: TObject);
2119begin
2120 TntComboBox_AddItem(Items, Item, AObject);
2121end;
2122
2123procedure TTntCustomComboBox.CopySelection(Destination: TCustomListControl);
2124begin
2125 TntComboBox_CopySelection(Items, ItemIndex, Destination);
2126end;
2127
2128procedure TTntCustomComboBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
2129begin
2130 TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
2131 inherited;
2132end;
2133
2134function TTntCustomComboBox.GetActionLinkClass: TControlActionLinkClass;
2135begin
2136 Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
2137end;
2138
2139{$IFDEF DELPHI_7} // fix for Delphi 7 only
2140function TTntCustomComboBox.GetItemsClass: TCustomComboBoxStringsClass;
2141begin
2142 Result := TD7PatchedComboBoxStrings;
2143end;
2144{$ENDIF}
2145
2146{ TTntListBoxStrings }
2147
2148function TTntListBoxStrings.GetListBox: TCustomListBox{TNT-ALLOW TCustomListBox};
2149begin
2150 Result := TCustomListBox{TNT-ALLOW TCustomListBox}(FListBox);
2151end;
2152
2153procedure TTntListBoxStrings.SetListBox(const Value: TCustomListBox{TNT-ALLOW TCustomListBox});
2154begin
2155 FListBox := TAccessCustomListBox(Value);
2156end;
2157
2158function TTntListBoxStrings.GetCount: Integer;
2159begin
2160 Result := ListBox.Items.Count;
2161end;
2162
2163function TTntListBoxStrings.Get(Index: Integer): WideString;
2164var
2165 Len: Integer;
2166begin
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;
2182end;
2183
2184function TTntListBoxStrings.GetObject(Index: Integer): TObject;
2185begin
2186 Result := ListBox.Items.Objects[Index];
2187end;
2188
2189procedure TTntListBoxStrings.Put(Index: Integer; const S: WideString);
2190var
2191 I: Integer;
2192 TempData: Longint;
2193begin
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;
2202end;
2203
2204procedure TTntListBoxStrings.PutObject(Index: Integer; AObject: TObject);
2205begin
2206 ListBox.Items.Objects[Index] := AObject;
2207end;
2208
2209function TTntListBoxStrings.Add(const S: WideString): Integer;
2210begin
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;
2218end;
2219
2220procedure TTntListBoxStrings.Insert(Index: Integer; const S: WideString);
2221begin
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;
2228end;
2229
2230procedure TTntListBoxStrings.Delete(Index: Integer);
2231begin
2232 FListBox.DeleteString(Index);
2233end;
2234
2235procedure TTntListBoxStrings.Exchange(Index1, Index2: Integer);
2236var
2237 TempData: Longint;
2238 TempString: WideString;
2239begin
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;
2255end;
2256
2257procedure TTntListBoxStrings.Clear;
2258begin
2259 FListBox.ResetContent;
2260end;
2261
2262procedure TTntListBoxStrings.SetUpdateState(Updating: Boolean);
2263begin
2264 TAccessStrings(ListBox.Items).SetUpdateState(Updating);
2265end;
2266
2267function TTntListBoxStrings.IndexOf(const S: WideString): Integer;
2268begin
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)));
2273end;
2274
2275procedure TTntListBoxStrings.Move(CurIndex, NewIndex: Integer);
2276var
2277 TempData: Longint;
2278 TempString: WideString;
2279begin
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;
2296end;
2297
2298//-- list box helper procs
2299
2300procedure TntListBox_AfterInherited_CreateWnd(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox};
2301 var FSaveItems: TTntStrings; FItems: TTntStrings; FSaveTopIndex, FSaveItemIndex: Integer);
2302begin
2303 if FSaveItems <> nil then
2304 begin
2305 FItems.Assign(FSaveItems);
2306 FreeAndNil(FSaveItems);
2307 ListBox.TopIndex := FSaveTopIndex;
2308 ListBox.ItemIndex := FSaveItemIndex;
2309 end;
2310end;
2311
2312procedure TntListBox_BeforeInherited_DestroyWnd(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox};
2313 var FSaveItems: TTntStrings; const FItems: TTntStrings; var FSaveTopIndex, FSaveItemIndex: Integer);
2314begin
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;
2324end;
2325
2326procedure TntListBox_DrawItem_Text(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox}; Items: TTntStrings; Index: Integer; Rect: TRect);
2327var
2328 Flags: Integer;
2329 Canvas: TCanvas;
2330begin
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;
2342end;
2343
2344procedure TntListBox_AddItem(Items: TTntStrings; const Item: WideString; AObject: TObject);
2345begin
2346 Items.AddObject(PWideChar(Item), AObject);
2347end;
2348
2349procedure TntListBox_CopySelection(ListBox: TCustomListbox{TNT-ALLOW TCustomListbox};
2350 Items: TTntStrings; Destination: TCustomListControl);
2351var
2352 I: Integer;
2353begin
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]);
2363end;
2364
2365function TntCustomListBox_GetOwnerData(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox}; OnData: TLBGetWideDataEvent; Index: Integer; out Data: WideString): Boolean;
2366var
2367 AnsiData: AnsiString;
2368begin
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;
2382end;
2383
2384function TntCustomListBox_LBGetText(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox}; OnData: TLBGetWideDataEvent; var Message: TMessage): Boolean;
2385var
2386 S: WideString;
2387 AnsiS: AnsiString;
2388begin
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;
2407end;
2408
2409function TntCustomListBox_LBGetTextLen(ListBox: TCustomListBox{TNT-ALLOW TCustomListBox}; OnData: TLBGetWideDataEvent; var Message: TMessage): Boolean;
2410var
2411 S: WideString;
2412begin
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;
2426end;
2427
2428{ TTntCustomListBox }
2429
2430constructor TTntCustomListBox.Create(AOwner: TComponent);
2431begin
2432 inherited;
2433 FItems := TTntListBoxStrings.Create;
2434 TTntListBoxStrings(FItems).ListBox := Self;
2435end;
2436
2437destructor TTntCustomListBox.Destroy;
2438begin
2439 FreeAndNil(FItems);
2440 FreeAndNil(FSaveItems);
2441 inherited;
2442end;
2443
2444procedure TTntCustomListBox.CreateWindowHandle(const Params: TCreateParams);
2445begin
2446 CreateUnicodeHandle(Self, Params, 'LISTBOX');
2447end;
2448
2449procedure TTntCustomListBox.DefineProperties(Filer: TFiler);
2450begin
2451 inherited;
2452 TntPersistent_AfterInherited_DefineProperties(Filer, Self);
2453end;
2454
2455procedure TTntCustomListBox.CreateWnd;
2456begin
2457 inherited;
2458 TntListBox_AfterInherited_CreateWnd(Self, FSaveItems, FItems, FSaveTopIndex, FSaveItemIndex);
2459end;
2460
2461procedure TTntCustomListBox.DestroyWnd;
2462begin
2463 TntListBox_BeforeInherited_DestroyWnd(Self, FSaveItems, FItems, FSaveTopIndex, FSaveItemIndex);
2464 inherited;
2465end;
2466
2467procedure TTntCustomListBox.SetItems(const Value: TTntStrings);
2468begin
2469 FItems.Assign(Value);
2470end;
2471
2472procedure TTntCustomListBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
2473begin
2474 if Assigned(OnDrawItem) then
2475 OnDrawItem(Self, Index, Rect, State)
2476 else
2477 TntListBox_DrawItem_Text(Self, Items, Index, Rect);
2478end;
2479
2480function TTntCustomListBox.IsHintStored: Boolean;
2481begin
2482 Result := TntControl_IsHintStored(Self)
2483end;
2484
2485function TTntCustomListBox.GetHint: WideString;
2486begin
2487 Result := TntControl_GetHint(Self)
2488end;
2489
2490procedure TTntCustomListBox.SetHint(const Value: WideString);
2491begin
2492 TntControl_SetHint(Self, Value);
2493end;
2494
2495procedure TTntCustomListBox.AddItem(const Item: WideString; AObject: TObject);
2496begin
2497 TntListBox_AddItem(Items, Item, AObject);
2498end;
2499
2500procedure TTntCustomListBox.CopySelection(Destination: TCustomListControl);
2501begin
2502 TntListBox_CopySelection(Self, Items, Destination);
2503end;
2504
2505procedure TTntCustomListBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
2506begin
2507 TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
2508 inherited;
2509end;
2510
2511function TTntCustomListBox.GetActionLinkClass: TControlActionLinkClass;
2512begin
2513 Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
2514end;
2515
2516procedure TTntCustomListBox.LBGetText(var Message: TMessage);
2517begin
2518 if not TntCustomListBox_LBGetText(Self, OnData, Message) then
2519 inherited;
2520end;
2521
2522procedure TTntCustomListBox.LBGetTextLen(var Message: TMessage);
2523begin
2524 if not TntCustomListBox_LBGetTextLen(Self, OnData, Message) then
2525 inherited;
2526end;
2527
2528// --- label helper procs
2529
2530type TAccessCustomLabel = class(TCustomLabel{TNT-ALLOW TCustomLabel});
2531
2532function TntLabel_DoDrawText(Control: TCustomLabel{TNT-ALLOW TCustomLabel}; var Rect: TRect; Flags: Integer; const GetLabelText: WideString): Boolean;
2533{$IFDEF COMPILER_9_UP}
2534const
2535 EllipsisStr = '...';
2536 Ellipsis: array[TEllipsisPosition] of Longint = (0, DT_PATH_ELLIPSIS,
2537 DT_END_ELLIPSIS, DT_WORD_ELLIPSIS);
2538{$ENDIF}
2539var
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}
2549begin
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;
2607end;
2608
2609procedure TntLabel_CMDialogChar(Control: TCustomLabel{TNT-ALLOW TCustomLabel}; var Message: TCMDialogChar; const Caption: WideString);
2610var
2611 FocusControl: TWinControl;
2612 ShowAccelChar: Boolean;
2613begin
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;
2624end;
2625
2626{ TTntCustomLabel }
2627
2628procedure TTntCustomLabel.CMDialogChar(var Message: TCMDialogChar);
2629begin
2630 TntLabel_CMDialogChar(Self, Message, Caption);
2631end;
2632
2633function TTntCustomLabel.IsCaptionStored: Boolean;
2634begin
2635 Result := TntControl_IsCaptionStored(Self)
2636end;
2637
2638function TTntCustomLabel.GetCaption: TWideCaption;
2639begin
2640 Result := TntControl_GetText(Self);
2641end;
2642
2643procedure TTntCustomLabel.SetCaption(const Value: TWideCaption);
2644begin
2645 TntControl_SetText(Self, Value);
2646end;
2647
2648procedure TTntCustomLabel.DefineProperties(Filer: TFiler);
2649begin
2650 inherited;
2651 TntPersistent_AfterInherited_DefineProperties(Filer, Self);
2652end;
2653
2654function TTntCustomLabel.GetLabelText: WideString;
2655begin
2656 Result := Caption;
2657end;
2658
2659procedure TTntCustomLabel.DoDrawText(var Rect: TRect; Flags: Integer);
2660begin
2661 if not TntLabel_DoDrawText(Self, Rect, Flags, GetLabelText) then
2662 inherited;
2663end;
2664
2665function TTntCustomLabel.IsHintStored: Boolean;
2666begin
2667 Result := TntControl_IsHintStored(Self)
2668end;
2669
2670function TTntCustomLabel.GetHint: WideString;
2671begin
2672 Result := TntControl_GetHint(Self)
2673end;
2674
2675procedure TTntCustomLabel.SetHint(const Value: WideString);
2676begin
2677 TntControl_SetHint(Self, Value);
2678end;
2679
2680procedure TTntCustomLabel.CMHintShow(var Message: TMessage);
2681begin
2682 ProcessCMHintShowMsg(Message);
2683 inherited;
2684end;
2685
2686procedure TTntCustomLabel.ActionChange(Sender: TObject; CheckDefaults: Boolean);
2687begin
2688 TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
2689 inherited;
2690end;
2691
2692function TTntCustomLabel.GetActionLinkClass: TControlActionLinkClass;
2693begin
2694 Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
2695end;
2696
2697{ TTntButton }
2698
2699procedure TntButton_CMDialogChar(Button: TButton{TNT-ALLOW TButton}; var Message: TCMDialogChar);
2700begin
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);
2709end;
2710
2711procedure TTntButton.CreateWindowHandle(const Params: TCreateParams);
2712begin
2713 CreateUnicodeHandle(Self, Params, 'BUTTON');
2714end;
2715
2716procedure TTntButton.DefineProperties(Filer: TFiler);
2717begin
2718 inherited;
2719 TntPersistent_AfterInherited_DefineProperties(Filer, Self);
2720end;
2721
2722procedure TTntButton.CMDialogChar(var Message: TCMDialogChar);
2723begin
2724 TntButton_CMDialogChar(Self, Message);
2725end;
2726
2727function TTntButton.IsCaptionStored: Boolean;
2728begin
2729 Result := TntControl_IsCaptionStored(Self)
2730end;
2731
2732function TTntButton.GetCaption: TWideCaption;
2733begin
2734 Result := TntControl_GetText(Self)
2735end;
2736
2737procedure TTntButton.SetCaption(const Value: TWideCaption);
2738begin
2739 TntControl_SetText(Self, Value);
2740end;
2741
2742function TTntButton.IsHintStored: Boolean;
2743begin
2744 Result := TntControl_IsHintStored(Self)
2745end;
2746
2747function TTntButton.GetHint: WideString;
2748begin
2749 Result := TntControl_GetHint(Self)
2750end;
2751
2752procedure TTntButton.SetHint(const Value: WideString);
2753begin
2754 TntControl_SetHint(Self, Value);
2755end;
2756
2757procedure TTntButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
2758begin
2759 TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
2760 inherited;
2761end;
2762
2763function TTntButton.GetActionLinkClass: TControlActionLinkClass;
2764begin
2765 Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
2766end;
2767
2768{ TTntCustomCheckBox }
2769
2770procedure TTntCustomCheckBox.CreateWindowHandle(const Params: TCreateParams);
2771begin
2772 CreateUnicodeHandle(Self, Params, 'BUTTON');
2773end;
2774
2775procedure TTntCustomCheckBox.DefineProperties(Filer: TFiler);
2776begin
2777 inherited;
2778 TntPersistent_AfterInherited_DefineProperties(Filer, Self);
2779end;
2780
2781procedure TTntCustomCheckBox.CMDialogChar(var Message: TCMDialogChar);
2782begin
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);
2792end;
2793
2794function TTntCustomCheckBox.IsCaptionStored: Boolean;
2795begin
2796 Result := TntControl_IsCaptionStored(Self)
2797end;
2798
2799function TTntCustomCheckBox.GetCaption: TWideCaption;
2800begin
2801 Result := TntControl_GetText(Self)
2802end;
2803
2804procedure TTntCustomCheckBox.SetCaption(const Value: TWideCaption);
2805begin
2806 TntControl_SetText(Self, Value);
2807end;
2808
2809function TTntCustomCheckBox.IsHintStored: Boolean;
2810begin
2811 Result := TntControl_IsHintStored(Self)
2812end;
2813
2814function TTntCustomCheckBox.GetHint: WideString;
2815begin
2816 Result := TntControl_GetHint(Self)
2817end;
2818
2819procedure TTntCustomCheckBox.SetHint(const Value: WideString);
2820begin
2821 TntControl_SetHint(Self, Value);
2822end;
2823
2824procedure TTntCustomCheckBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
2825begin
2826 TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
2827 inherited;
2828end;
2829
2830function TTntCustomCheckBox.GetActionLinkClass: TControlActionLinkClass;
2831begin
2832 Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
2833end;
2834
2835{ TTntRadioButton }
2836
2837procedure TTntRadioButton.CreateWindowHandle(const Params: TCreateParams);
2838begin
2839 CreateUnicodeHandle(Self, Params, 'BUTTON');
2840end;
2841
2842procedure TTntRadioButton.DefineProperties(Filer: TFiler);
2843begin
2844 inherited;
2845 TntPersistent_AfterInherited_DefineProperties(Filer, Self);
2846end;
2847
2848procedure TTntRadioButton.CMDialogChar(var Message: TCMDialogChar);
2849begin
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);
2858end;
2859
2860function TTntRadioButton.IsCaptionStored: Boolean;
2861begin
2862 Result := TntControl_IsCaptionStored(Self);
2863end;
2864
2865function TTntRadioButton.GetCaption: TWideCaption;
2866begin
2867 Result := TntControl_GetText(Self)
2868end;
2869
2870procedure TTntRadioButton.SetCaption(const Value: TWideCaption);
2871begin
2872 TntControl_SetText(Self, Value);
2873end;
2874
2875function TTntRadioButton.IsHintStored: Boolean;
2876begin
2877 Result := TntControl_IsHintStored(Self)
2878end;
2879
2880function TTntRadioButton.GetHint: WideString;
2881begin
2882 Result := TntControl_GetHint(Self)
2883end;
2884
2885procedure TTntRadioButton.SetHint(const Value: WideString);
2886begin
2887 TntControl_SetHint(Self, Value);
2888end;
2889
2890procedure TTntRadioButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
2891begin
2892 TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
2893 inherited;
2894end;
2895
2896function TTntRadioButton.GetActionLinkClass: TControlActionLinkClass;
2897begin
2898 Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
2899end;
2900
2901{ TTntScrollBar }
2902
2903procedure TTntScrollBar.CreateWindowHandle(const Params: TCreateParams);
2904begin
2905 CreateUnicodeHandle(Self, Params, 'SCROLLBAR');
2906end;
2907
2908procedure TTntScrollBar.DefineProperties(Filer: TFiler);
2909begin
2910 inherited;
2911 TntPersistent_AfterInherited_DefineProperties(Filer, Self);
2912end;
2913
2914function TTntScrollBar.IsHintStored: Boolean;
2915begin
2916 Result := TntControl_IsHintStored(Self)
2917end;
2918
2919function TTntScrollBar.GetHint: WideString;
2920begin
2921 Result := TntControl_GetHint(Self)
2922end;
2923
2924procedure TTntScrollBar.SetHint(const Value: WideString);
2925begin
2926 TntControl_SetHint(Self, Value);
2927end;
2928
2929procedure TTntScrollBar.ActionChange(Sender: TObject; CheckDefaults: Boolean);
2930begin
2931 TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
2932 inherited;
2933end;
2934
2935function TTntScrollBar.GetActionLinkClass: TControlActionLinkClass;
2936begin
2937 Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
2938end;
2939
2940{ TTntCustomGroupBox }
2941
2942procedure TTntCustomGroupBox.CreateWindowHandle(const Params: TCreateParams);
2943begin
2944 CreateUnicodeHandle(Self, Params, '');
2945end;
2946
2947procedure TTntCustomGroupBox.DefineProperties(Filer: TFiler);
2948begin
2949 inherited;
2950 TntPersistent_AfterInherited_DefineProperties(Filer, Self);
2951end;
2952
2953procedure TTntCustomGroupBox.CMDialogChar(var Message: TCMDialogChar);
2954begin
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);
2963end;
2964
2965function TTntCustomGroupBox.IsCaptionStored: Boolean;
2966begin
2967 Result := TntControl_IsCaptionStored(Self);
2968end;
2969
2970function TTntCustomGroupBox.GetCaption: TWideCaption;
2971begin
2972 Result := TntControl_GetText(Self)
2973end;
2974
2975procedure TTntCustomGroupBox.SetCaption(const Value: TWideCaption);
2976begin
2977 TntControl_SetText(Self, Value);
2978end;
2979
2980procedure 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
3056begin
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;
3071end;
3072
3073function TTntCustomGroupBox.IsHintStored: Boolean;
3074begin
3075 Result := TntControl_IsHintStored(Self)
3076end;
3077
3078function TTntCustomGroupBox.GetHint: WideString;
3079begin
3080 Result := TntControl_GetHint(Self);
3081end;
3082
3083procedure TTntCustomGroupBox.SetHint(const Value: WideString);
3084begin
3085 TntControl_SetHint(Self, Value);
3086end;
3087
3088procedure TTntCustomGroupBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
3089begin
3090 TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
3091 inherited;
3092end;
3093
3094function TTntCustomGroupBox.GetActionLinkClass: TControlActionLinkClass;
3095begin
3096 Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
3097end;
3098
3099{ TTntCustomStaticText }
3100
3101constructor TTntCustomStaticText.Create(AOwner: TComponent);
3102begin
3103 inherited;
3104 AdjustBounds;
3105end;
3106
3107procedure TTntCustomStaticText.CMFontChanged(var Message: TMessage);
3108begin
3109 inherited;
3110 AdjustBounds;
3111end;
3112
3113procedure TTntCustomStaticText.CMTextChanged(var Message: TMessage);
3114begin
3115 inherited;
3116 AdjustBounds;
3117end;
3118
3119procedure TTntCustomStaticText.Loaded;
3120begin
3121 inherited;
3122 AdjustBounds;
3123end;
3124
3125procedure TTntCustomStaticText.SetAutoSize(AValue: boolean);
3126begin
3127 inherited;
3128 if AValue then
3129 AdjustBounds;
3130end;
3131
3132procedure TTntCustomStaticText.CreateWindowHandle(const Params: TCreateParams);
3133begin
3134 CreateUnicodeHandle(Self, Params, 'STATIC');
3135end;
3136
3137procedure TTntCustomStaticText.DefineProperties(Filer: TFiler);
3138begin
3139 inherited;
3140 TntPersistent_AfterInherited_DefineProperties(Filer, Self);
3141end;
3142
3143procedure TTntCustomStaticText.CMDialogChar(var Message: TCMDialogChar);
3144begin
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;
3153end;
3154
3155function TTntCustomStaticText.IsCaptionStored: Boolean;
3156begin
3157 Result := TntControl_IsCaptionStored(Self)
3158end;
3159
3160procedure TTntCustomStaticText.AdjustBounds;
3161var
3162 DC: HDC;
3163 SaveFont: HFont;
3164 TextSize: TSize;
3165begin
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;
3177end;
3178
3179function TTntCustomStaticText.GetCaption: TWideCaption;
3180begin
3181 Result := TntControl_GetText(Self)
3182end;
3183
3184procedure TTntCustomStaticText.SetCaption(const Value: TWideCaption);
3185begin
3186 TntControl_SetText(Self, Value);
3187end;
3188
3189function TTntCustomStaticText.IsHintStored: Boolean;
3190begin
3191 Result := TntControl_IsHintStored(Self)
3192end;
3193
3194function TTntCustomStaticText.GetHint: WideString;
3195begin
3196 Result := TntControl_GetHint(Self)
3197end;
3198
3199procedure TTntCustomStaticText.SetHint(const Value: WideString);
3200begin
3201 TntControl_SetHint(Self, Value);
3202end;
3203
3204procedure TTntCustomStaticText.ActionChange(Sender: TObject; CheckDefaults: Boolean);
3205begin
3206 TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
3207 inherited;
3208end;
3209
3210function TTntCustomStaticText.GetActionLinkClass: TControlActionLinkClass;
3211begin
3212 Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
3213end;
3214
3215end.
Note: See TracBrowser for help on using the repository browser.