Source/TntExtCtrls.pas

   1
   2 {*****************************************************************************}
   3 {                                                                             }
   4 {    Tnt Delphi Unicode Controls                                              }
   5 {      http://www.tntware.com/delphicontrols/unicode/                         }
   6 {        Version: 2.3.0                                                       }
   7 {                                                                             }
   8 {    Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com)       }
   9 {                                                                             }
  10 {*****************************************************************************}
  11
  12 unit TntExtCtrls;
  13
  14 {$INCLUDE TntCompilers.inc}
  15
  16 interface
  17
  18 uses
  19   Classes, Messages, Controls, ExtCtrls, TntClasses, TntControls, TntStdCtrls, TntGraphics;
  20
  21 type
  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
 391 implementation
 392
 393 uses
 394   Windows, Graphics, Forms, {$IFDEF THEME_7_UP} Themes, {$ENDIF}
 395   TntSysUtils, TntWindows, TntActnList;
 396
 397 { TTntShape }
 398
 399 procedure TTntShape.DefineProperties(Filer: TFiler);
 400 begin
 401   inherited;
 402   TntPersistent_AfterInherited_DefineProperties(Filer, Self);
 403 end;
 404
 405 function TTntShape.IsHintStored: Boolean;
 406 begin
 407   Result := TntControl_IsHintStored(Self)
 408 end;
 409
 410 function TTntShape.GetHint: WideString;
 411 begin
 412   Result := TntControl_GetHint(Self)
 413 end;
 414
 415 procedure TTntShape.SetHint(const Value: WideString);
 416 begin
 417   TntControl_SetHint(Self, Value);
 418 end;
 419
 420 procedure TTntShape.CMHintShow(var Message: TMessage);
 421 begin
 422   ProcessCMHintShowMsg(Message);
 423   inherited;
 424 end;
 425
 426 procedure TTntShape.ActionChange(Sender: TObject; CheckDefaults: Boolean);
 427 begin
 428   TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
 429   inherited;
 430 end;
 431
 432 function TTntShape.GetActionLinkClass: TControlActionLinkClass;
 433 begin
 434   Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
 435 end;
 436
 437 { TTntPaintBox }
 438
 439 procedure TTntPaintBox.DefineProperties(Filer: TFiler);
 440 begin
 441   inherited;
 442   TntPersistent_AfterInherited_DefineProperties(Filer, Self);
 443 end;
 444
 445 function TTntPaintBox.IsHintStored: Boolean;
 446 begin
 447   Result := TntControl_IsHintStored(Self)
 448 end;
 449
 450 function TTntPaintBox.GetHint: WideString;
 451 begin
 452   Result := TntControl_GetHint(Self)
 453 end;
 454
 455 procedure TTntPaintBox.SetHint(const Value: WideString);
 456 begin
 457   TntControl_SetHint(Self, Value);
 458 end;
 459
 460 procedure TTntPaintBox.CMHintShow(var Message: TMessage);
 461 begin
 462   ProcessCMHintShowMsg(Message);
 463   inherited;
 464 end;
 465
 466 procedure TTntPaintBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
 467 begin
 468   TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
 469   inherited;
 470 end;
 471
 472 function TTntPaintBox.GetActionLinkClass: TControlActionLinkClass;
 473 begin
 474   Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
 475 end;
 476
 477 type
 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
 505 constructor TTntImage.Create(AOwner: TComponent);
 506 var
 507   OldPicture: TPicture{TNT-ALLOW TPicture};
 508 begin
 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;
 515 end;
 516
 517 function TTntImage.GetPicture: TTntPicture;
 518 begin
 519   Result := inherited Picture as TTntPicture;
 520 end;
 521
 522 procedure TTntImage.SetPicture(const Value: TTntPicture);
 523 begin
 524   inherited Picture := Value;
 525 end;
 526
 527 procedure TTntImage.DefineProperties(Filer: TFiler);
 528 begin
 529   inherited;
 530   TntPersistent_AfterInherited_DefineProperties(Filer, Self);
 531 end;
 532
 533 function TTntImage.IsHintStored: Boolean;
 534 begin
 535   Result := TntControl_IsHintStored(Self)
 536 end;
 537
 538 function TTntImage.GetHint: WideString;
 539 begin
 540   Result := TntControl_GetHint(Self)
 541 end;
 542
 543 procedure TTntImage.SetHint(const Value: WideString);
 544 begin
 545   TntControl_SetHint(Self, Value);
 546 end;
 547
 548 procedure TTntImage.CMHintShow(var Message: TMessage);
 549 begin
 550   ProcessCMHintShowMsg(Message);
 551   inherited;
 552 end;
 553
 554 procedure TTntImage.ActionChange(Sender: TObject; CheckDefaults: Boolean);
 555 begin
 556   TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
 557   inherited;
 558 end;
 559
 560 function TTntImage.GetActionLinkClass: TControlActionLinkClass;
 561 begin
 562   Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
 563 end;
 564
 565 { TTntBevel }
 566
 567 procedure TTntBevel.DefineProperties(Filer: TFiler);
 568 begin
 569   inherited;
 570   TntPersistent_AfterInherited_DefineProperties(Filer, Self);
 571 end;
 572
 573 function TTntBevel.IsHintStored: Boolean;
 574 begin
 575   Result := TntControl_IsHintStored(Self)
 576 end;
 577
 578 function TTntBevel.GetHint: WideString;
 579 begin
 580   Result := TntControl_GetHint(Self)
 581 end;
 582
 583 procedure TTntBevel.SetHint(const Value: WideString);
 584 begin
 585   TntControl_SetHint(Self, Value);
 586 end;
 587
 588 procedure TTntBevel.CMHintShow(var Message: TMessage);
 589 begin
 590   ProcessCMHintShowMsg(Message);
 591   inherited;
 592 end;
 593
 594 procedure TTntBevel.ActionChange(Sender: TObject; CheckDefaults: Boolean);
 595 begin
 596   TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
 597   inherited;
 598 end;
 599
 600 function TTntBevel.GetActionLinkClass: TControlActionLinkClass;
 601 begin
 602   Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
 603 end;
 604
 605 { TTntCustomPanel }
 606
 607 procedure TTntCustomPanel.CreateWindowHandle(const Params: TCreateParams);
 608 begin
 609   CreateUnicodeHandle(Self, Params, '');
 610 end;
 611
 612 procedure TTntCustomPanel.DefineProperties(Filer: TFiler);
 613 begin
 614   inherited;
 615   TntPersistent_AfterInherited_DefineProperties(Filer, Self);
 616 end;
 617
 618 function TTntCustomPanel.IsCaptionStored: Boolean;
 619 begin
 620   Result := TntControl_IsCaptionStored(Self);
 621 end;
 622
 623 function TTntCustomPanel.GetCaption: TWideCaption;
 624 begin
 625   Result := TntControl_GetText(Self)
 626 end;
 627
 628 procedure TTntCustomPanel.SetCaption(const Value: TWideCaption);
 629 begin
 630   TntControl_SetText(Self, Value);
 631 end;
 632
 633 procedure TTntCustomPanel.Paint;
 634 const
 635   Alignments: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
 636 var
 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
 650 begin
 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;
 695 end;
 696
 697 function TTntCustomPanel.IsHintStored: Boolean;
 698 begin
 699   Result := TntControl_IsHintStored(Self)
 700 end;
 701
 702 function TTntCustomPanel.GetHint: WideString;
 703 begin
 704   Result := TntControl_GetHint(Self);
 705 end;
 706
 707 procedure TTntCustomPanel.SetHint(const Value: WideString);
 708 begin
 709   TntControl_SetHint(Self, Value);
 710 end;
 711
 712 procedure TTntCustomPanel.ActionChange(Sender: TObject; CheckDefaults: Boolean);
 713 begin
 714   TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
 715   inherited;
 716 end;
 717
 718 function TTntCustomPanel.GetActionLinkClass: TControlActionLinkClass;
 719 begin
 720   Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
 721 end;
 722
 723 { TTntCustomControlBar }
 724
 725 procedure TTntCustomControlBar.CreateWindowHandle(const Params: TCreateParams);
 726 begin
 727   CreateUnicodeHandle(Self, Params, '');
 728 end;
 729
 730 procedure TTntCustomControlBar.DefineProperties(Filer: TFiler);
 731 begin
 732   inherited;
 733   TntPersistent_AfterInherited_DefineProperties(Filer, Self);
 734 end;
 735
 736 function TTntCustomControlBar.IsHintStored: Boolean;
 737 begin
 738   Result := TntControl_IsHintStored(Self);
 739 end;
 740
 741 function TTntCustomControlBar.GetHint: WideString;
 742 begin
 743   Result := TntControl_GetHint(Self);
 744 end;
 745
 746 procedure TTntCustomControlBar.SetHint(const Value: WideString);
 747 begin
 748   TntControl_SetHint(Self, Value);
 749 end;
 750
 751 procedure TTntCustomControlBar.ActionChange(Sender: TObject; CheckDefaults: Boolean);
 752 begin
 753   TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
 754   inherited;
 755 end;
 756
 757 function TTntCustomControlBar.GetActionLinkClass: TControlActionLinkClass;
 758 begin
 759   Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
 760 end;
 761
 762 { TTntGroupButton }
 763
 764 type
 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
 777 constructor TTntGroupButton.InternalCreate(RadioGroup: TTntCustomRadioGroup);
 778 begin
 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;
 786 end;
 787
 788 destructor TTntGroupButton.Destroy;
 789 begin
 790   TTntCustomRadioGroup(Owner).FButtons.Remove(Self);
 791   inherited Destroy;
 792 end;
 793
 794 procedure TTntGroupButton.CNCommand(var Message: TWMCommand);
 795 begin
 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;
 809 end;
 810
 811 procedure TTntGroupButton.KeyPress(var Key: Char{TNT-ALLOW Char});
 812 begin
 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;
 819 end;
 820
 821 procedure TTntGroupButton.KeyDown(var Key: Word; Shift: TShiftState);
 822 begin
 823   inherited KeyDown(Key, Shift);
 824   TTntCustomRadioGroup(Parent).KeyDown(Key, Shift);
 825 end;
 826
 827 { TTntCustomRadioGroup }
 828
 829 constructor TTntCustomRadioGroup.Create(AOwner: TComponent);
 830 begin
 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;
 838 end;
 839
 840 destructor TTntCustomRadioGroup.Destroy;
 841 begin
 842   SetButtonCount(0);
 843   TTntStringList(FItems).OnChange := nil;
 844   FItems.Free;
 845   FButtons.Free;
 846   inherited Destroy;
 847 end;
 848
 849 procedure TTntCustomRadioGroup.FlipChildren(AllLevels: Boolean);
 850 begin
 851   { The radio buttons are flipped using BiDiMode }
 852 end;
 853
 854 procedure TTntCustomRadioGroup.ArrangeButtons;
 855 var
 856   ButtonsPerCol, ButtonWidth, ButtonHeight, TopMargin, I: Integer;
 857   DC: HDC;
 858   SaveFont: HFont;
 859   Metrics: TTextMetric;
 860   DeferHandle: THandle;
 861   ALeft: Integer;
 862 begin
 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;
 895 end;
 896
 897 procedure TTntCustomRadioGroup.ButtonClick(Sender: TObject);
 898 begin
 899   if not FUpdating then
 900   begin
 901     FItemIndex := FButtons.IndexOf(Sender);
 902     Changed;
 903     Click;
 904   end;
 905 end;
 906
 907 procedure TTntCustomRadioGroup.ItemsChange(Sender: TObject);
 908 begin
 909   if not FReading then
 910   begin
 911     if FItemIndex >= FItems.Count then FItemIndex := FItems.Count - 1;
 912     UpdateButtons;
 913   end;
 914 end;
 915
 916 procedure TTntCustomRadioGroup.Loaded;
 917 begin
 918   inherited Loaded;
 919   ArrangeButtons;
 920 end;
 921
 922 procedure TTntCustomRadioGroup.ReadState(Reader: TReader);
 923 begin
 924   FReading := True;
 925   inherited ReadState(Reader);
 926   FReading := False;
 927   UpdateButtons;
 928 end;
 929
 930 procedure TTntCustomRadioGroup.SetButtonCount(Value: Integer);
 931 begin
 932   while FButtons.Count < Value do TTntGroupButton.InternalCreate(Self);
 933   while FButtons.Count > Value do TTntGroupButton(FButtons.Last).Free;
 934 end;
 935
 936 procedure TTntCustomRadioGroup.SetColumns(Value: Integer);
 937 begin
 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;
 946 end;
 947
 948 procedure TTntCustomRadioGroup.SetItemIndex(Value: Integer);
 949 begin
 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;
 963 end;
 964
 965 procedure TTntCustomRadioGroup.SetItems(Value: TTntStrings);
 966 begin
 967   FItems.Assign(Value);
 968 end;
 969
 970 procedure TTntCustomRadioGroup.UpdateButtons;
 971 var
 972   I: Integer;
 973 begin
 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;
 985 end;
 986
 987 procedure TTntCustomRadioGroup.CMEnabledChanged(var Message: TMessage);
 988 var
 989   I: Integer;
 990 begin
 991   inherited;
 992   for I := 0 to FButtons.Count - 1 do
 993     TTntGroupButton(FButtons[I]).Enabled := Enabled;
 994 end;
 995
 996 procedure TTntCustomRadioGroup.CMFontChanged(var Message: TMessage);
 997 begin
 998   inherited;
 999   ArrangeButtons;
1000 end;
1001
1002 procedure TTntCustomRadioGroup.WMSize(var Message: TWMSize);
1003 begin
1004   inherited;
1005   ArrangeButtons;
1006 end;
1007
1008 function TTntCustomRadioGroup.CanModify: Boolean;
1009 begin
1010   Result := True;
1011 end;
1012
1013 procedure TTntCustomRadioGroup.GetChildren(Proc: TGetChildProc; Root: TComponent);
1014 begin
1015 end;
1016
1017 function TTntCustomRadioGroup.GetButtons(Index: Integer): TTntRadioButton;
1018 begin
1019   Result := TTntRadioButton(FButtons[Index]);
1020 end;
1021
1022 { TTntSplitter }
1023
1024 procedure TTntSplitter.DefineProperties(Filer: TFiler);
1025 begin
1026   inherited;
1027   TntPersistent_AfterInherited_DefineProperties(Filer, Self);
1028 end;
1029
1030 function TTntSplitter.IsHintStored: Boolean;
1031 begin
1032   Result := TntControl_IsHintStored(Self)
1033 end;
1034
1035 function TTntSplitter.GetHint: WideString;
1036 begin
1037   Result := TntControl_GetHint(Self)
1038 end;
1039
1040 procedure TTntSplitter.SetHint(const Value: WideString);
1041 begin
1042   TntControl_SetHint(Self, Value);
1043 end;
1044
1045 procedure TTntSplitter.CMHintShow(var Message: TMessage);
1046 begin
1047   ProcessCMHintShowMsg(Message);
1048   inherited;
1049 end;
1050
1051 procedure TTntSplitter.ActionChange(Sender: TObject; CheckDefaults: Boolean);
1052 begin
1053   TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
1054   inherited;
1055 end;
1056
1057 function TTntSplitter.GetActionLinkClass: TControlActionLinkClass;
1058 begin
1059   Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
1060 end;
1061
1062 end.