source: cprs/branches/tmg-cprs/TMG_Extra/tntUniCode/Source/TntExtCtrls.pas

Last change on this file was 672, checked in by Kevin Toppenberg, 9 years ago

Adding source to tntControls for compilation

File size: 29.0 KB
Line 
1
2{*****************************************************************************}
3{                                                                             }
4{    Tnt Delphi Unicode Controls                                              }
5{      http://www.tntware.com/delphicontrols/unicode/                         }
6{        Version: 2.3.0                                                       }
7{                                                                             }
8{    Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com)       }
9{                                                                             }
10{*****************************************************************************}
11
12unit TntExtCtrls;
13
14{$INCLUDE TntCompilers.inc}
15
16interface
17
18uses
19  Classes, Messages, Controls, ExtCtrls, TntClasses, TntControls, TntStdCtrls, TntGraphics;
20
21type
22{TNT-WARN TShape}
23  TTntShape = class(TShape{TNT-ALLOW TShape})
24  private
25    function GetHint: WideString;
26    procedure SetHint(const Value: WideString);
27    function IsHintStored: Boolean;
28    procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
29  protected
30    procedure DefineProperties(Filer: TFiler); override;
31    function GetActionLinkClass: TControlActionLinkClass; override;
32    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
33  published
34    property Hint: WideString read GetHint write SetHint stored IsHintStored;
35  end;
36
37{TNT-WARN TPaintBox}
38  TTntPaintBox = class(TPaintBox{TNT-ALLOW TPaintBox})
39  private
40    function GetHint: WideString;
41    procedure SetHint(const Value: WideString);
42    function IsHintStored: Boolean;
43    procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
44  protected
45    procedure DefineProperties(Filer: TFiler); override;
46    function GetActionLinkClass: TControlActionLinkClass; override;
47    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
48  published
49    property Hint: WideString read GetHint write SetHint stored IsHintStored;
50  end;
51
52{TNT-WARN TImage}
53  TTntImage = class(TImage{TNT-ALLOW TImage})
54  private
55    function GetHint: WideString;
56    procedure SetHint(const Value: WideString);
57    function IsHintStored: Boolean;
58    procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
59    function GetPicture: TTntPicture;
60    procedure SetPicture(const Value: TTntPicture);
61  protected
62    procedure DefineProperties(Filer: TFiler); override;
63    function GetActionLinkClass: TControlActionLinkClass; override;
64    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
65  public
66    constructor Create(AOwner: TComponent); override;
67  published
68    property Hint: WideString read GetHint write SetHint stored IsHintStored;
69    property Picture: TTntPicture read GetPicture write SetPicture;
70  end;
71
72{TNT-WARN TBevel}
73  TTntBevel = class(TBevel{TNT-ALLOW TBevel})
74  private
75    function GetHint: WideString;
76    procedure SetHint(const Value: WideString);
77    function IsHintStored: Boolean;
78    procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
79  protected
80    procedure DefineProperties(Filer: TFiler); override;
81    function GetActionLinkClass: TControlActionLinkClass; override;
82    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
83  published
84    property Hint: WideString read GetHint write SetHint stored IsHintStored;
85  end;
86
87{TNT-WARN TCustomPanel}
88  TTntCustomPanel = class(TCustomPanel{TNT-ALLOW TCustomPanel})
89  private
90    function GetCaption: TWideCaption;
91    procedure SetCaption(const Value: TWideCaption);
92    function GetHint: WideString;
93    procedure SetHint(const Value: WideString);
94    function IsCaptionStored: Boolean;
95    function IsHintStored: Boolean;
96  protected
97    procedure Paint; override;
98    procedure CreateWindowHandle(const Params: TCreateParams); override;
99    procedure DefineProperties(Filer: TFiler); override;
100    function GetActionLinkClass: TControlActionLinkClass; override;
101    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
102    property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
103  published
104    property Hint: WideString read GetHint write SetHint stored IsHintStored;
105  end;
106
107{TNT-WARN TPanel}
108  TTntPanel = class(TTntCustomPanel)
109  public
110    property DockManager;
111  published
112    property Align;
113    property Alignment;
114    property Anchors;
115    property AutoSize;
116    property BevelEdges;
117    property BevelInner;
118    property BevelKind;
119    property BevelOuter;
120    property BevelWidth;
121    property BiDiMode;
122    property BorderWidth;
123    property BorderStyle;
124    property Caption;
125    property Color;
126    property Constraints;
127    property Ctl3D;
128    property UseDockManager default True;
129    property DockSite;
130    property DragCursor;
131    property DragKind;
132    property DragMode;
133    property Enabled;
134    property FullRepaint;
135    property Font;
136    property Locked;
137    {$IFDEF COMPILER_10_UP}
138    property Padding;
139    {$ENDIF}
140    property ParentBiDiMode;
141    {$IFDEF COMPILER_7_UP}
142    property ParentBackground;
143    {$ENDIF}
144    property ParentColor;
145    property ParentCtl3D;
146    property ParentFont;
147    property ParentShowHint;
148    property PopupMenu;
149    property ShowHint;
150    property TabOrder;
151    property TabStop;
152    {$IFDEF COMPILER_9_UP}
153    property VerticalAlignment;
154    {$ENDIF}
155    property Visible;
156    {$IFDEF COMPILER_9_UP}
157    property OnAlignInsertBefore;
158    property OnAlignPosition;
159    {$ENDIF}
160    property OnCanResize;
161    property OnClick;
162    property OnConstrainedResize;
163    property OnContextPopup;
164    property OnDockDrop;
165    property OnDockOver;
166    property OnDblClick;
167    property OnDragDrop;
168    property OnDragOver;
169    property OnEndDock;
170    property OnEndDrag;
171    property OnEnter;
172    property OnExit;
173    property OnGetSiteInfo;
174    {$IFDEF COMPILER_9_UP}
175    property OnMouseActivate;
176    {$ENDIF}
177    property OnMouseDown;
178    {$IFDEF COMPILER_10_UP}
179    property OnMouseEnter;
180    property OnMouseLeave;
181    {$ENDIF}
182    property OnMouseMove;
183    property OnMouseUp;
184    property OnResize;
185    property OnStartDock;
186    property OnStartDrag;
187    property OnUnDock;
188  end;
189
190{TNT-WARN TCustomControlBar}
191  TTntCustomControlBar = class(TCustomControlBar{TNT-ALLOW TCustomControlBar})
192  private
193    function IsHintStored: Boolean;
194    function GetHint: WideString;
195    procedure SetHint(const Value: WideString);
196  protected
197    procedure CreateWindowHandle(const Params: TCreateParams); override;
198    procedure DefineProperties(Filer: TFiler); override;
199    function GetActionLinkClass: TControlActionLinkClass; override;
200    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
201  published
202    property Hint: WideString read GetHint write SetHint stored IsHintStored;
203  end;
204
205{TNT-WARN TControlBar}
206  TTntControlBar = class(TTntCustomControlBar)
207  public
208    property Canvas;
209  published
210    property Align;
211    property Anchors;
212    property AutoDock;
213    property AutoDrag;
214    property AutoSize;
215    property BevelEdges;
216    property BevelInner;
217    property BevelOuter;
218    property BevelKind;
219    property BevelWidth;
220    property BorderWidth;
221    property Color {$IFDEF COMPILER_7_UP} nodefault {$ENDIF};
222    property Constraints;
223    {$IFDEF COMPILER_10_UP}
224    property CornerEdge;
225    {$ENDIF}
226    property DockSite;
227    property DragCursor;
228    property DragKind;
229    property DragMode;
230    {$IFDEF COMPILER_10_UP}
231    property DrawingStyle;
232    {$ENDIF}
233    property Enabled;
234    {$IFDEF COMPILER_10_UP}
235    property GradientDirection;
236    property GradientEndColor;
237    property GradientStartColor;
238    {$ENDIF}
239    {$IFDEF COMPILER_7_UP}
240    property ParentBackground default True;
241    {$ENDIF}
242    property ParentColor;
243    property ParentCtl3D;
244    property ParentFont;
245    property ParentShowHint;
246    property Picture;
247    property PopupMenu;
248    property RowSize;
249    property RowSnap;
250    property ShowHint;
251    property TabOrder;
252    property TabStop;
253    property Visible;
254    {$IFDEF COMPILER_9_UP}
255    property OnAlignInsertBefore;
256    property OnAlignPosition;
257    {$ENDIF}
258    property OnBandDrag;
259    property OnBandInfo;
260    property OnBandMove;
261    property OnBandPaint;
262    {$IFDEF COMPILER_9_UP}
263    property OnBeginBandMove;
264    property OnEndBandMove;
265    {$ENDIF}
266    property OnCanResize;
267    property OnClick;
268    property OnConstrainedResize;
269    property OnContextPopup;
270    property OnDockDrop;
271    property OnDockOver;
272    property OnDblClick;
273    property OnDragDrop;
274    property OnDragOver;
275    property OnEndDock;
276    property OnEndDrag;
277    property OnEnter;
278    property OnExit;
279    property OnGetSiteInfo;
280    {$IFDEF COMPILER_9_UP}
281    property OnMouseActivate;
282    {$ENDIF}
283    property OnMouseDown;
284    {$IFDEF COMPILER_10_UP}
285    property OnMouseEnter;
286    property OnMouseLeave;
287    {$ENDIF}
288    property OnMouseMove;
289    property OnMouseUp;
290    property OnPaint;
291    property OnResize;
292    property OnStartDock;
293    property OnStartDrag;
294    property OnUnDock;
295  end;
296
297{TNT-WARN TCustomRadioGroup}
298  TTntCustomRadioGroup = class(TTntCustomGroupBox)
299  private
300    FButtons: TList;
301    FItems: TTntStrings;
302    FItemIndex: Integer;
303    FColumns: Integer;
304    FReading: Boolean;
305    FUpdating: Boolean;
306    function GetButtons(Index: Integer): TTntRadioButton;
307    procedure ArrangeButtons;
308    procedure ButtonClick(Sender: TObject);
309    procedure ItemsChange(Sender: TObject);
310    procedure SetButtonCount(Value: Integer);
311    procedure SetColumns(Value: Integer);
312    procedure SetItemIndex(Value: Integer);
313    procedure SetItems(Value: TTntStrings);
314    procedure UpdateButtons;
315    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
316    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
317    procedure WMSize(var Message: TWMSize); message WM_SIZE;
318  protected
319    procedure Loaded; override;
320    procedure ReadState(Reader: TReader); override;
321    function CanModify: Boolean; virtual;
322    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
323    property Columns: Integer read FColumns write SetColumns default 1;
324    property ItemIndex: Integer read FItemIndex write SetItemIndex default -1;
325    property Items: TTntStrings read FItems write SetItems;
326  public
327    constructor Create(AOwner: TComponent); override;
328    destructor Destroy; override;
329    procedure FlipChildren(AllLevels: Boolean); override;
330    property Buttons[Index: Integer]: TTntRadioButton read GetButtons;
331  end;
332
333{TNT-WARN TRadioGroup}
334  TTntRadioGroup = class(TTntCustomRadioGroup)
335  published
336    property Align;
337    property Anchors;
338    property BiDiMode;
339    property Caption;
340    property Color;
341    property Columns;
342    property Ctl3D;
343    property DragCursor;
344    property DragKind;
345    property DragMode;
346    property Enabled;
347    property Font;
348    property ItemIndex;
349    property Items;
350    property Constraints;
351    property ParentBiDiMode;
352    {$IFDEF COMPILER_7_UP}
353    property ParentBackground default True;
354    {$ENDIF}
355    property ParentColor;
356    property ParentCtl3D;
357    property ParentFont;
358    property ParentShowHint;
359    property PopupMenu;
360    property ShowHint;
361    property TabOrder;
362    property TabStop;
363    property Visible;
364    property OnClick;
365    property OnContextPopup;
366    property OnDragDrop;
367    property OnDragOver;
368    property OnEndDock;
369    property OnEndDrag;
370    property OnEnter;
371    property OnExit;
372    property OnStartDock;
373    property OnStartDrag;
374  end;
375
376{TNT-WARN TSplitter}
377  TTntSplitter = class(TSplitter{TNT-ALLOW TSplitter})
378  private
379    function GetHint: WideString;
380    procedure SetHint(const Value: WideString);
381    function IsHintStored: Boolean;
382    procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
383  protected
384    procedure DefineProperties(Filer: TFiler); override;
385    function GetActionLinkClass: TControlActionLinkClass; override;
386    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
387  published
388    property Hint: WideString read GetHint write SetHint stored IsHintStored;
389  end;
390
391implementation
392
393uses
394  Windows, Graphics, Forms, {$IFDEF THEME_7_UP} Themes, {$ENDIF}
395  TntSysUtils, TntWindows, TntActnList;
396
397{ TTntShape }
398
399procedure TTntShape.DefineProperties(Filer: TFiler);
400begin
401  inherited;
402  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
403end;
404
405function TTntShape.IsHintStored: Boolean;
406begin
407  Result := TntControl_IsHintStored(Self)
408end;
409
410function TTntShape.GetHint: WideString;
411begin
412  Result := TntControl_GetHint(Self)
413end;
414
415procedure TTntShape.SetHint(const Value: WideString);
416begin
417  TntControl_SetHint(Self, Value);
418end;
419
420procedure TTntShape.CMHintShow(var Message: TMessage);
421begin
422  ProcessCMHintShowMsg(Message);
423  inherited;
424end;
425
426procedure TTntShape.ActionChange(Sender: TObject; CheckDefaults: Boolean);
427begin
428  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
429  inherited;
430end;
431
432function TTntShape.GetActionLinkClass: TControlActionLinkClass;
433begin
434  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
435end;
436
437{ TTntPaintBox }
438
439procedure TTntPaintBox.DefineProperties(Filer: TFiler);
440begin
441  inherited;
442  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
443end;
444
445function TTntPaintBox.IsHintStored: Boolean;
446begin
447  Result := TntControl_IsHintStored(Self)
448end;
449
450function TTntPaintBox.GetHint: WideString;
451begin
452  Result := TntControl_GetHint(Self)
453end;
454
455procedure TTntPaintBox.SetHint(const Value: WideString);
456begin
457  TntControl_SetHint(Self, Value);
458end;
459
460procedure TTntPaintBox.CMHintShow(var Message: TMessage);
461begin
462  ProcessCMHintShowMsg(Message);
463  inherited;
464end;
465
466procedure TTntPaintBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
467begin
468  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
469  inherited;
470end;
471
472function TTntPaintBox.GetActionLinkClass: TControlActionLinkClass;
473begin
474  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
475end;
476
477type
478{$IFDEF COMPILER_6}    // verified against VCL source in Delphi 6 and BCB 6
479  THackImage = class(TGraphicControl)
480  protected
481    FPicture: TPicture{TNT-ALLOW TPicture};
482  end;
483{$ENDIF}
484{$IFDEF DELPHI_7}      // verified against VCL source in Delphi 7
485  THackImage = class(TGraphicControl)
486  protected
487    FPicture: TPicture{TNT-ALLOW TPicture};
488  end;
489{$ENDIF}
490{$IFDEF DELPHI_9}      // verified against VCL source in Delphi 9
491  THackImage = class(TGraphicControl)
492  private
493    FPicture: TPicture{TNT-ALLOW TPicture};
494  end;
495{$ENDIF}
496{$IFDEF DELPHI_10}      // verified against VCL source in Delphi 10
497  THackImage = class(TGraphicControl)
498  private
499    FPicture: TPicture{TNT-ALLOW TPicture};
500  end;
501{$ENDIF}
502
503{ TTntImage }
504
505constructor TTntImage.Create(AOwner: TComponent);
506var
507  OldPicture: TPicture{TNT-ALLOW TPicture};
508begin
509  inherited;
510  OldPicture := THackImage(Self).FPicture;
511  THackImage(Self).FPicture := TTntPicture.Create;
512  Picture.OnChange := OldPicture.OnChange;
513  Picture.OnProgress := OldPicture.OnProgress;
514  OldPicture.Free;
515end;
516
517function TTntImage.GetPicture: TTntPicture;
518begin
519  Result := inherited Picture as TTntPicture;
520end;
521
522procedure TTntImage.SetPicture(const Value: TTntPicture);
523begin
524  inherited Picture := Value;
525end;
526
527procedure TTntImage.DefineProperties(Filer: TFiler);
528begin
529  inherited;
530  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
531end;
532
533function TTntImage.IsHintStored: Boolean;
534begin
535  Result := TntControl_IsHintStored(Self)
536end;
537
538function TTntImage.GetHint: WideString;
539begin
540  Result := TntControl_GetHint(Self)
541end;
542
543procedure TTntImage.SetHint(const Value: WideString);
544begin
545  TntControl_SetHint(Self, Value);
546end;
547
548procedure TTntImage.CMHintShow(var Message: TMessage);
549begin
550  ProcessCMHintShowMsg(Message);
551  inherited;
552end;
553
554procedure TTntImage.ActionChange(Sender: TObject; CheckDefaults: Boolean);
555begin
556  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
557  inherited;
558end;
559
560function TTntImage.GetActionLinkClass: TControlActionLinkClass;
561begin
562  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
563end;
564
565{ TTntBevel }
566
567procedure TTntBevel.DefineProperties(Filer: TFiler);
568begin
569  inherited;
570  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
571end;
572
573function TTntBevel.IsHintStored: Boolean;
574begin
575  Result := TntControl_IsHintStored(Self)
576end;
577
578function TTntBevel.GetHint: WideString;
579begin
580  Result := TntControl_GetHint(Self)
581end;
582
583procedure TTntBevel.SetHint(const Value: WideString);
584begin
585  TntControl_SetHint(Self, Value);
586end;
587
588procedure TTntBevel.CMHintShow(var Message: TMessage);
589begin
590  ProcessCMHintShowMsg(Message);
591  inherited;
592end;
593
594procedure TTntBevel.ActionChange(Sender: TObject; CheckDefaults: Boolean);
595begin
596  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
597  inherited;
598end;
599
600function TTntBevel.GetActionLinkClass: TControlActionLinkClass;
601begin
602  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
603end;
604
605{ TTntCustomPanel }
606
607procedure TTntCustomPanel.CreateWindowHandle(const Params: TCreateParams);
608begin
609  CreateUnicodeHandle(Self, Params, '');
610end;
611
612procedure TTntCustomPanel.DefineProperties(Filer: TFiler);
613begin
614  inherited;
615  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
616end;
617
618function TTntCustomPanel.IsCaptionStored: Boolean;
619begin
620  Result := TntControl_IsCaptionStored(Self);
621end;
622
623function TTntCustomPanel.GetCaption: TWideCaption;
624begin
625  Result := TntControl_GetText(Self)
626end;
627
628procedure TTntCustomPanel.SetCaption(const Value: TWideCaption);
629begin
630  TntControl_SetText(Self, Value);
631end;
632
633procedure TTntCustomPanel.Paint;
634const
635  Alignments: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
636var
637  Rect: TRect;
638  TopColor, BottomColor: TColor;
639  FontHeight: Integer;
640  Flags: Longint;
641
642  procedure AdjustColors(Bevel: TPanelBevel);
643  begin
644    TopColor := clBtnHighlight;
645    if Bevel = bvLowered then TopColor := clBtnShadow;
646    BottomColor := clBtnShadow;
647    if Bevel = bvLowered then BottomColor := clBtnHighlight;
648  end;
649
650begin
651  if (not Win32PlatformIsUnicode) then
652    inherited
653  else begin
654    Rect := GetClientRect;
655    if BevelOuter <> bvNone then
656    begin
657      AdjustColors(BevelOuter);
658      Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
659    end;
660    {$IFDEF THEME_7_UP}
661    if ThemeServices.ThemesEnabled {$IFDEF COMPILER_7_UP} and ParentBackground {$ENDIF} then
662      InflateRect(Rect, -BorderWidth, -BorderWidth)
663    else
664    {$ENDIF}
665    begin
666      Frame3D(Canvas, Rect, Color, Color, BorderWidth);
667    end;
668    if BevelInner <> bvNone then
669    begin
670      AdjustColors(BevelInner);
671      Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
672    end;
673    with Canvas do
674    begin
675      {$IFDEF THEME_7_UP}
676      if not ThemeServices.ThemesEnabled {$IFDEF COMPILER_7_UP} or not ParentBackground {$ENDIF} then
677      {$ENDIF}
678      begin
679        Brush.Color := Color;
680        FillRect(Rect);
681      end;
682      Brush.Style := bsClear;
683      Font := Self.Font;
684      FontHeight := WideCanvasTextHeight(Canvas, 'W');
685      with Rect do
686      begin
687        Top := ((Bottom + Top) - FontHeight) div 2;
688        Bottom := Top + FontHeight;
689      end;
690      Flags := DT_EXPANDTABS or DT_VCENTER or Alignments[Alignment];
691      Flags := DrawTextBiDiModeFlags(Flags);
692      Tnt_DrawTextW(Handle, PWideChar(Caption), -1, Rect, Flags);
693    end;
694  end;
695end;
696
697function TTntCustomPanel.IsHintStored: Boolean;
698begin
699  Result := TntControl_IsHintStored(Self)
700end;
701
702function TTntCustomPanel.GetHint: WideString;
703begin
704  Result := TntControl_GetHint(Self);
705end;
706
707procedure TTntCustomPanel.SetHint(const Value: WideString);
708begin
709  TntControl_SetHint(Self, Value);
710end;
711
712procedure TTntCustomPanel.ActionChange(Sender: TObject; CheckDefaults: Boolean);
713begin
714  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
715  inherited;
716end;
717
718function TTntCustomPanel.GetActionLinkClass: TControlActionLinkClass;
719begin
720  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
721end;
722
723{ TTntCustomControlBar }
724
725procedure TTntCustomControlBar.CreateWindowHandle(const Params: TCreateParams);
726begin
727  CreateUnicodeHandle(Self, Params, '');
728end;
729
730procedure TTntCustomControlBar.DefineProperties(Filer: TFiler);
731begin
732  inherited;
733  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
734end;
735
736function TTntCustomControlBar.IsHintStored: Boolean;
737begin
738  Result := TntControl_IsHintStored(Self);
739end;
740
741function TTntCustomControlBar.GetHint: WideString;
742begin
743  Result := TntControl_GetHint(Self);
744end;
745
746procedure TTntCustomControlBar.SetHint(const Value: WideString);
747begin
748  TntControl_SetHint(Self, Value);
749end;
750
751procedure TTntCustomControlBar.ActionChange(Sender: TObject; CheckDefaults: Boolean);
752begin
753  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
754  inherited;
755end;
756
757function TTntCustomControlBar.GetActionLinkClass: TControlActionLinkClass;
758begin
759  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
760end;
761
762{ TTntGroupButton }
763
764type
765  TTntGroupButton = class(TTntRadioButton)
766  private
767    FInClick: Boolean;
768    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
769  protected
770    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
771    procedure KeyPress(var Key: Char{TNT-ALLOW Char}); override;
772  public
773    constructor InternalCreate(RadioGroup: TTntCustomRadioGroup);
774    destructor Destroy; override;
775  end;
776
777constructor TTntGroupButton.InternalCreate(RadioGroup: TTntCustomRadioGroup);
778begin
779  inherited Create(RadioGroup);
780  RadioGroup.FButtons.Add(Self);
781  Visible := False;
782  Enabled := RadioGroup.Enabled;
783  ParentShowHint := False;
784  OnClick := RadioGroup.ButtonClick;
785  Parent := RadioGroup;
786end;
787
788destructor TTntGroupButton.Destroy;
789begin
790  TTntCustomRadioGroup(Owner).FButtons.Remove(Self);
791  inherited Destroy;
792end;
793
794procedure TTntGroupButton.CNCommand(var Message: TWMCommand);
795begin
796  if not FInClick then
797  begin
798    FInClick := True;
799    try
800      if ((Message.NotifyCode = BN_CLICKED) or
801        (Message.NotifyCode = BN_DOUBLECLICKED)) and
802        TTntCustomRadioGroup(Parent).CanModify then
803        inherited;
804    except
805      Application.HandleException(Self);
806    end;
807    FInClick := False;
808  end;
809end;
810
811procedure TTntGroupButton.KeyPress(var Key: Char{TNT-ALLOW Char});
812begin
813  inherited KeyPress(Key);
814  TTntCustomRadioGroup(Parent).KeyPress(Key);
815  if (Key = #8) or (Key = ' ') then
816  begin
817    if not TTntCustomRadioGroup(Parent).CanModify then Key := #0;
818  end;
819end;
820
821procedure TTntGroupButton.KeyDown(var Key: Word; Shift: TShiftState);
822begin
823  inherited KeyDown(Key, Shift);
824  TTntCustomRadioGroup(Parent).KeyDown(Key, Shift);
825end;
826
827{ TTntCustomRadioGroup }
828
829constructor TTntCustomRadioGroup.Create(AOwner: TComponent);
830begin
831  inherited Create(AOwner);
832  ControlStyle := [csSetCaption, csDoubleClicks {$IFDEF COMPILER_7_UP}, csParentBackground {$ENDIF}];
833  FButtons := TList.Create;
834  FItems := TTntStringList.Create;
835  TTntStringList(FItems).OnChange := ItemsChange;
836  FItemIndex := -1;
837  FColumns := 1;
838end;
839
840destructor TTntCustomRadioGroup.Destroy;
841begin
842  SetButtonCount(0);
843  TTntStringList(FItems).OnChange := nil;
844  FItems.Free;
845  FButtons.Free;
846  inherited Destroy;
847end;
848
849procedure TTntCustomRadioGroup.FlipChildren(AllLevels: Boolean);
850begin
851  { The radio buttons are flipped using BiDiMode }
852end;
853
854procedure TTntCustomRadioGroup.ArrangeButtons;
855var
856  ButtonsPerCol, ButtonWidth, ButtonHeight, TopMargin, I: Integer;
857  DC: HDC;
858  SaveFont: HFont;
859  Metrics: TTextMetric;
860  DeferHandle: THandle;
861  ALeft: Integer;
862begin
863  if (FButtons.Count <> 0) and not FReading then
864  begin
865    DC := GetDC(0);
866    SaveFont := SelectObject(DC, Font.Handle);
867    GetTextMetrics(DC, Metrics);
868    SelectObject(DC, SaveFont);
869    ReleaseDC(0, DC);
870    ButtonsPerCol := (FButtons.Count + FColumns - 1) div FColumns;
871    ButtonWidth := (Width - 10) div FColumns;
872    I := Height - Metrics.tmHeight - 5;
873    ButtonHeight := I div ButtonsPerCol;
874    TopMargin := Metrics.tmHeight + 1 + (I mod ButtonsPerCol) div 2;
875    DeferHandle := BeginDeferWindowPos(FButtons.Count);
876    try
877      for I := 0 to FButtons.Count - 1 do
878        with TTntGroupButton(FButtons[I]) do
879        begin
880          BiDiMode := Self.BiDiMode;
881          ALeft := (I div ButtonsPerCol) * ButtonWidth + 8;
882          if UseRightToLeftAlignment then
883            ALeft := Self.ClientWidth - ALeft - ButtonWidth;
884          DeferHandle := DeferWindowPos(DeferHandle, Handle, 0,
885            ALeft,
886            (I mod ButtonsPerCol) * ButtonHeight + TopMargin,
887            ButtonWidth, ButtonHeight,
888            SWP_NOZORDER or SWP_NOACTIVATE);
889          Visible := True;
890        end;
891    finally
892      EndDeferWindowPos(DeferHandle);
893    end;
894  end;
895end;
896
897procedure TTntCustomRadioGroup.ButtonClick(Sender: TObject);
898begin
899  if not FUpdating then
900  begin
901    FItemIndex := FButtons.IndexOf(Sender);
902    Changed;
903    Click;
904  end;
905end;
906
907procedure TTntCustomRadioGroup.ItemsChange(Sender: TObject);
908begin
909  if not FReading then
910  begin
911    if FItemIndex >= FItems.Count then FItemIndex := FItems.Count - 1;
912    UpdateButtons;
913  end;
914end;
915
916procedure TTntCustomRadioGroup.Loaded;
917begin
918  inherited Loaded;
919  ArrangeButtons;
920end;
921
922procedure TTntCustomRadioGroup.ReadState(Reader: TReader);
923begin
924  FReading := True;
925  inherited ReadState(Reader);
926  FReading := False;
927  UpdateButtons;
928end;
929
930procedure TTntCustomRadioGroup.SetButtonCount(Value: Integer);
931begin
932  while FButtons.Count < Value do TTntGroupButton.InternalCreate(Self);
933  while FButtons.Count > Value do TTntGroupButton(FButtons.Last).Free;
934end;
935
936procedure TTntCustomRadioGroup.SetColumns(Value: Integer);
937begin
938  if Value < 1 then Value := 1;
939  if Value > 16 then Value := 16;
940  if FColumns <> Value then
941  begin
942    FColumns := Value;
943    ArrangeButtons;
944    Invalidate;
945  end;
946end;
947
948procedure TTntCustomRadioGroup.SetItemIndex(Value: Integer);
949begin
950  if FReading then FItemIndex := Value else
951  begin
952    if Value < -1 then Value := -1;
953    if Value >= FButtons.Count then Value := FButtons.Count - 1;
954    if FItemIndex <> Value then
955    begin
956      if FItemIndex >= 0 then
957        TTntGroupButton(FButtons[FItemIndex]).Checked := False;
958      FItemIndex := Value;
959      if FItemIndex >= 0 then
960        TTntGroupButton(FButtons[FItemIndex]).Checked := True;
961    end;
962  end;
963end;
964
965procedure TTntCustomRadioGroup.SetItems(Value: TTntStrings);
966begin
967  FItems.Assign(Value);
968end;
969
970procedure TTntCustomRadioGroup.UpdateButtons;
971var
972  I: Integer;
973begin
974  SetButtonCount(FItems.Count);
975  for I := 0 to FButtons.Count - 1 do
976    TTntGroupButton(FButtons[I]).Caption := FItems[I];
977  if FItemIndex >= 0 then
978  begin
979    FUpdating := True;
980    TTntGroupButton(FButtons[FItemIndex]).Checked := True;
981    FUpdating := False;
982  end;
983  ArrangeButtons;
984  Invalidate;
985end;
986
987procedure TTntCustomRadioGroup.CMEnabledChanged(var Message: TMessage);
988var
989  I: Integer;
990begin
991  inherited;
992  for I := 0 to FButtons.Count - 1 do
993    TTntGroupButton(FButtons[I]).Enabled := Enabled;
994end;
995
996procedure TTntCustomRadioGroup.CMFontChanged(var Message: TMessage);
997begin
998  inherited;
999  ArrangeButtons;
1000end;
1001
1002procedure TTntCustomRadioGroup.WMSize(var Message: TWMSize);
1003begin
1004  inherited;
1005  ArrangeButtons;
1006end;
1007
1008function TTntCustomRadioGroup.CanModify: Boolean;
1009begin
1010  Result := True;
1011end;
1012
1013procedure TTntCustomRadioGroup.GetChildren(Proc: TGetChildProc; Root: TComponent);
1014begin
1015end;
1016
1017function TTntCustomRadioGroup.GetButtons(Index: Integer): TTntRadioButton;
1018begin
1019  Result := TTntRadioButton(FButtons[Index]);
1020end;
1021
1022{ TTntSplitter }
1023
1024procedure TTntSplitter.DefineProperties(Filer: TFiler);
1025begin
1026  inherited;
1027  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
1028end;
1029
1030function TTntSplitter.IsHintStored: Boolean;
1031begin
1032  Result := TntControl_IsHintStored(Self)
1033end;
1034
1035function TTntSplitter.GetHint: WideString;
1036begin
1037  Result := TntControl_GetHint(Self)
1038end;
1039
1040procedure TTntSplitter.SetHint(const Value: WideString);
1041begin
1042  TntControl_SetHint(Self, Value);
1043end;
1044
1045procedure TTntSplitter.CMHintShow(var Message: TMessage);
1046begin
1047  ProcessCMHintShowMsg(Message);
1048  inherited;
1049end;
1050
1051procedure TTntSplitter.ActionChange(Sender: TObject; CheckDefaults: Boolean);
1052begin
1053  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
1054  inherited;
1055end;
1056
1057function TTntSplitter.GetActionLinkClass: TControlActionLinkClass;
1058begin
1059  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
1060end;
1061
1062end.
Note: See TracBrowser for help on using the repository browser.