source: cprs/branches/tmg-cprs/TntWare/Delphi Unicode Controls/Source/TntExtCtrls.pas@ 895

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

Initial upload of TMG-CPRS 1.0.26.69
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.