Source/TntButtons.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 TntButtons;
  13
  14 {$INCLUDE TntCompilers.inc}
  15
  16 interface
  17
  18 uses
  19   Windows, Messages, Classes, Controls, Graphics, StdCtrls,
  20   ExtCtrls, CommCtrl, Buttons,
  21   TntControls;
  22
  23 type
  24   ITntGlyphButton = interface
  25     ['{15D7E501-1E33-4293-8B45-716FB3B14504}']
  26     function GetButtonGlyph: Pointer;
  27     procedure UpdateInternalGlyphList;
  28   end;
  29
  30 {TNT-WARN TSpeedButton}
  31   TTntSpeedButton = class(TSpeedButton {TNT-ALLOW TSpeedButton}, ITntGlyphButton)
  32   private
  33     FPaintInherited: Boolean;
  34     function GetCaption: TWideCaption;
  35     procedure SetCaption(const Value: TWideCaption);
  36     function GetHint: WideString;
  37     procedure SetHint(const Value: WideString);
  38     function IsCaptionStored: Boolean;
  39     function IsHintStored: Boolean;
  40     procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
  41     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  42   protected
  43     function GetButtonGlyph: Pointer;
  44     procedure UpdateInternalGlyphList; dynamic;
  45     procedure PaintButton; dynamic;
  46     procedure Paint; override;
  47     procedure DefineProperties(Filer: TFiler); override;
  48     function GetActionLinkClass: TControlActionLinkClass; override;
  49     procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
  50   published
  51     property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
  52     property Hint: WideString read GetHint write SetHint stored IsHintStored;
  53   end;
  54
  55 {TNT-WARN TBitBtn}
  56   TTntBitBtn = class(TBitBtn {TNT-ALLOW TBitBtn}, ITntGlyphButton)
  57   private
  58     FPaintInherited: Boolean;
  59     FMouseInControl: Boolean;
  60     function IsCaptionStored: Boolean;
  61     function GetCaption: TWideCaption;
  62     procedure SetCaption(const Value: TWideCaption);
  63     function IsHintStored: Boolean;
  64     function GetHint: WideString;
  65     procedure SetHint(const Value: WideString);
  66     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  67     procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
  68     procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
  69     procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  70   protected
  71     function GetButtonGlyph: Pointer;
  72     procedure UpdateInternalGlyphList; dynamic;
  73     procedure DrawItem(const DrawItemStruct: TDrawItemStruct); dynamic;
  74     procedure CreateWindowHandle(const Params: TCreateParams); override;
  75     procedure DefineProperties(Filer: TFiler); override;
  76     function GetActionLinkClass: TControlActionLinkClass; override;
  77     procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
  78   published
  79     property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
  80     property Hint: WideString read GetHint write SetHint stored IsHintStored;
  81   end;
  82
  83 procedure TButtonGlyph_CalcButtonLayout(Control: TControl; DC: HDC; const Client: TRect;
  84   const Offset: TPoint; const Caption: WideString; Layout: TButtonLayout;
  85     Margin, Spacing: Integer; var GlyphPos: TPoint; var TextBounds: TRect;
  86     BiDiFlags: Integer {$IFDEF COMPILER_7_UP}; WordWrap: Boolean {$ENDIF});
  87
  88 function TButtonGlyph_Draw(Control: TControl; Canvas: TCanvas; const Client: TRect;
  89   const Offset: TPoint; const Caption: WideString; Layout: TButtonLayout; Margin: Integer;
  90     Spacing: Integer; State: TButtonState; Transparent: Boolean;
  91     BiDiFlags: Longint {$IFDEF COMPILER_7_UP}; WordWrap: Boolean {$ENDIF}): TRect;
  92
  93 implementation
  94
  95 uses
  96   SysUtils, ActnList, TntForms, TntStdCtrls, TypInfo, RTLConsts, TntWindows,
  97   {$IFDEF THEME_7_UP} Themes, {$ENDIF} TntClasses, TntActnList, TntSysUtils;
  98
  99 type
 100   EAbortPaint = class(EAbort);
 101
 102 // Many routines in this unit are nearly the same as those found in Buttons.pas.  They are
 103 //   included here because the VCL implementation of TButtonGlyph is completetly inaccessible.
 104
 105 type
 106   THackButtonGlyph_D6_D7_D9 = class
 107   protected
 108     FOriginal: TBitmap;
 109     FGlyphList: TImageList;
 110     FIndexs: array[TButtonState] of Integer;
 111     FxxxxTransparentColor: TColor;
 112     FNumGlyphs: TNumGlyphs;
 113   end;
 114
 115   THackBitBtn_D6_D7_D9 = class(TButton{TNT-ALLOW TButton})
 116   protected
 117     FCanvas: TCanvas;
 118     FGlyph: Pointer;
 119     FxxxxStyle: TButtonStyle;
 120     FxxxxKind: TBitBtnKind;
 121     FxxxxLayout: TButtonLayout;
 122     FxxxxSpacing: Integer;
 123     FxxxxMargin: Integer;
 124     IsFocused: Boolean;
 125   end;
 126
 127   THackSpeedButton_D6_D7_D9 = class(TGraphicControl)
 128   protected
 129     FxxxxGroupIndex: Integer;
 130     FGlyph: Pointer;
 131     FxxxxDown: Boolean;
 132     FDragging: Boolean;
 133   end;
 134
 135   {$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
 136   THackButtonGlyph = THackButtonGlyph_D6_D7_D9;
 137   THackBitBtn      = THackBitBtn_D6_D7_D9;
 138   THackSpeedButton = THackSpeedButton_D6_D7_D9;
 139   {$ENDIF}
 140   {$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
 141   THackButtonGlyph = THackButtonGlyph_D6_D7_D9;
 142   THackBitBtn      = THackBitBtn_D6_D7_D9;
 143   THackSpeedButton = THackSpeedButton_D6_D7_D9;
 144   {$ENDIF}
 145   {$IFDEF DELPHI_9} // verified against VCL source in Delphi 9
 146   THackButtonGlyph = THackButtonGlyph_D6_D7_D9;
 147   THackBitBtn      = THackBitBtn_D6_D7_D9;
 148   THackSpeedButton = THackSpeedButton_D6_D7_D9;
 149   {$ENDIF}
 150   {$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
 151   THackButtonGlyph = THackButtonGlyph_D6_D7_D9;
 152   THackBitBtn      = THackBitBtn_D6_D7_D9;
 153   THackSpeedButton = THackSpeedButton_D6_D7_D9;
 154   {$ENDIF}
 155
 156 function GetButtonGlyph(Control: TControl): THackButtonGlyph;
 157 var
 158   GlyphButton: ITntGlyphButton;
 159 begin
 160   if Control.GetInterface(ITntGlyphButton, GlyphButton) then
 161     Result := GlyphButton.GetButtonGlyph
 162   else
 163     raise ETntInternalError.Create('Internal Error: Control does not support ITntGlyphButton.');
 164 end;
 165
 166 procedure UpdateInternalGlyphList(Control: TControl);
 167 var
 168   GlyphButton: ITntGlyphButton;
 169 begin
 170   if Control.GetInterface(ITntGlyphButton, GlyphButton) then
 171     GlyphButton.UpdateInternalGlyphList
 172   else
 173     raise ETntInternalError.Create('Internal Error: Control does not support ITntGlyphButton.');
 174 end;
 175
 176 function TButtonGlyph_CreateButtonGlyph(Control: TControl; State: TButtonState): Integer;
 177 var
 178   ButtonGlyph: THackButtonGlyph;
 179   NumGlyphs: Integer;
 180 begin
 181   ButtonGlyph := GetButtonGlyph(Control);
 182   NumGlyphs := ButtonGlyph.FNumGlyphs;
 183
 184   if (State = bsDown) and (NumGlyphs < 3) then State := bsUp;
 185   Result := ButtonGlyph.FIndexs[State];
 186   if (Result = -1) then begin
 187     UpdateInternalGlyphList(Control);
 188     Result := ButtonGlyph.FIndexs[State];
 189   end;
 190 end;
 191
 192 procedure TButtonGlyph_DrawButtonGlyph(Control: TControl; Canvas: TCanvas; const GlyphPos: TPoint;
 193   State: TButtonState; Transparent: Boolean);
 194 var
 195   ButtonGlyph: THackButtonGlyph;
 196   Glyph: TBitmap;
 197   GlyphList: TImageList;
 198   Index: Integer;
 199   {$IFDEF THEME_7_UP}
 200   Details: TThemedElementDetails;
 201   R: TRect;
 202   Button: TThemedButton;
 203   {$ENDIF}
 204 begin
 205   ButtonGlyph := GetButtonGlyph(Control);
 206   Glyph := ButtonGlyph.FOriginal;
 207   GlyphList := ButtonGlyph.FGlyphList;
 208   if Glyph = nil then Exit;
 209   if (Glyph.Width = 0) or (Glyph.Height = 0) then Exit;
 210   Index := TButtonGlyph_CreateButtonGlyph(Control, State);
 211   with GlyphPos do
 212   {$IFDEF THEME_7_UP}
 213   if ThemeServices.ThemesEnabled then begin
 214     R.TopLeft := GlyphPos;
 215     R.Right := R.Left + Glyph.Width div ButtonGlyph.FNumGlyphs;
 216     R.Bottom := R.Top + Glyph.Height;
 217     case State of
 218       bsDisabled:
 219         Button := tbPushButtonDisabled;
 220       bsDown,
 221       bsExclusive:
 222         Button := tbPushButtonPressed;
 223     else
 224       // bsUp
 225       Button := tbPushButtonNormal;
 226     end;
 227     Details := ThemeServices.GetElementDetails(Button);
 228     ThemeServices.DrawIcon(Canvas.Handle, Details, R, GlyphList.Handle, Index);
 229   end else
 230   {$ENDIF}
 231     if Transparent or (State = bsExclusive) then
 232       ImageList_DrawEx(GlyphList.Handle, Index, Canvas.Handle, X, Y, 0, 0,
 233         clNone, clNone, ILD_Transparent)
 234     else
 235       ImageList_DrawEx(GlyphList.Handle, Index, Canvas.Handle, X, Y, 0, 0,
 236         ColorToRGB(clBtnFace), clNone, ILD_Normal);
 237 end;
 238
 239 procedure TButtonGlyph_DrawButtonText(Canvas: TCanvas; const Caption: WideString;
 240   TextBounds: TRect; State: TButtonState;
 241     BiDiFlags: LongInt {$IFDEF COMPILER_7_UP}; WordWrap: Boolean {$ENDIF});
 242 begin
 243   with Canvas do
 244   begin
 245     Brush.Style := bsClear;
 246     if State = bsDisabled then
 247     begin
 248       OffsetRect(TextBounds, 1, 1);
 249       Font.Color := clBtnHighlight;
 250
 251       {$IFDEF COMPILER_7_UP}
 252       if WordWrap then
 253         Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), TextBounds,
 254           DT_CENTER or DT_VCENTER or BiDiFlags or DT_WORDBREAK)
 255       else
 256       {$ENDIF}
 257         Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), TextBounds,
 258           DT_CENTER or DT_VCENTER or BiDiFlags);
 259
 260       OffsetRect(TextBounds, -1, -1);
 261       Font.Color := clBtnShadow;
 262
 263       {$IFDEF COMPILER_7_UP}
 264       if WordWrap then
 265         Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), TextBounds,
 266           DT_CENTER or DT_WORDBREAK or BiDiFlags) { TODO: Figure out why DT_VCENTER is not used }
 267       else
 268       {$ENDIF}
 269         Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), TextBounds,
 270           DT_CENTER or DT_VCENTER or BiDiFlags);
 271
 272     end else
 273     begin
 274       {$IFDEF COMPILER_7_UP}
 275       if WordWrap then
 276         Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), TextBounds,
 277           DT_CENTER or DT_WORDBREAK or BiDiFlags) { TODO: Figure out why DT_VCENTER is not used }
 278       else
 279       {$ENDIF}
 280         Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), TextBounds,
 281           DT_CENTER or DT_VCENTER or BiDiFlags);
 282     end;
 283   end;
 284 end;
 285
 286 procedure TButtonGlyph_CalcButtonLayout(Control: TControl; DC: HDC; const Client: TRect;
 287   const Offset: TPoint; const Caption: WideString; Layout: TButtonLayout;
 288     Margin, Spacing: Integer; var GlyphPos: TPoint; var TextBounds: TRect;
 289       BiDiFlags: Integer {$IFDEF COMPILER_7_UP}; WordWrap: Boolean {$ENDIF});
 290 var
 291   TextPos: TPoint;
 292   ClientSize,
 293   GlyphSize,
 294   TextSize: TPoint;
 295   TotalSize: TPoint;
 296   Glyph: TBitmap;
 297   NumGlyphs: Integer;
 298   ButtonGlyph: THackButtonGlyph;
 299 begin
 300   ButtonGlyph := GetButtonGlyph(Control);
 301   Glyph := ButtonGlyph.FOriginal;
 302   NumGlyphs := ButtonGlyph.FNumGlyphs;
 303
 304   if (BiDiFlags and DT_RIGHT) = DT_RIGHT then
 305     if Layout = blGlyphLeft then
 306       Layout := blGlyphRight
 307     else
 308       if Layout = blGlyphRight then
 309         Layout := blGlyphLeft;
 310
 311   // Calculate the item sizes.
 312   ClientSize := Point(Client.Right - Client.Left, Client.Bottom - Client.Top);
 313
 314   if Assigned(Glyph) then
 315     GlyphSize := Point(Glyph.Width div NumGlyphs, Glyph.Height)
 316   else
 317     GlyphSize := Point(0, 0);
 318
 319   if Length(Caption) > 0 then
 320   begin
 321     {$IFDEF COMPILER_7_UP}
 322     TextBounds := Rect(0, 0, Client.Right - Client.Left - GlyphSize.X - 3, 0); { TODO: Figure out why GlyphSize.X is in here. }
 323     {$ELSE}
 324     TextBounds := Rect(0, 0, Client.Right - Client.Left, 0);
 325     {$ENDIF}
 326
 327     {$IFDEF COMPILER_7_UP}
 328     if WordWrap then
 329       Tnt_DrawTextW(DC, PWideChar(Caption), Length(Caption), TextBounds, DT_WORDBREAK
 330                                                                       or DT_CALCRECT or BiDiFlags)
 331     else
 332     {$ENDIF}
 333       Tnt_DrawTextW(DC, PWideChar(Caption), Length(Caption), TextBounds, DT_CALCRECT or BiDiFlags);
 334
 335     TextSize := Point(TextBounds.Right - TextBounds.Left, TextBounds.Bottom - TextBounds.Top);
 336   end
 337   else
 338   begin
 339     TextBounds := Rect(0, 0, 0, 0);
 340     TextSize := Point(0, 0);
 341   end;
 342
 343   // If the layout has the glyph on the right or the left, then both the text and the glyph are centered vertically.
 344   // If the glyph is on the top or the bottom, then both the text and the glyph are centered horizontally.
 345   if Layout in [blGlyphLeft, blGlyphRight] then
 346   begin
 347     GlyphPos.Y := (ClientSize.Y - GlyphSize.Y + 1) div 2;
 348     TextPos.Y := (ClientSize.Y - TextSize.Y + 1) div 2;
 349   end
 350   else
 351   begin
 352     GlyphPos.X := (ClientSize.X - GlyphSize.X + 1) div 2;
 353     TextPos.X := (ClientSize.X - TextSize.X + 1) div 2;
 354   end;
 355
 356   // If there is no text or no bitmap, then Spacing is irrelevant.
 357   if (TextSize.X = 0) or (GlyphSize.X = 0) then
 358     Spacing := 0;
 359
 360   // Adjust Margin and Spacing.
 361   if Margin = -1 then
 362   begin
 363     if Spacing = -1 then
 364     begin
 365       TotalSize := Point(GlyphSize.X + TextSize.X, GlyphSize.Y + TextSize.Y);
 366       if Layout in [blGlyphLeft, blGlyphRight] then
 367         Margin := (ClientSize.X - TotalSize.X) div 3
 368       else
 369         Margin := (ClientSize.Y - TotalSize.Y) div 3;
 370       Spacing := Margin;
 371     end
 372     else
 373     begin
 374       TotalSize := Point(GlyphSize.X + Spacing + TextSize.X, GlyphSize.Y + Spacing + TextSize.Y);
 375       if Layout in [blGlyphLeft, blGlyphRight] then
 376         Margin := (ClientSize.X - TotalSize.X + 1) div 2
 377       else
 378         Margin := (ClientSize.Y - TotalSize.Y + 1) div 2;
 379     end;
 380   end
 381   else
 382   begin
 383     if Spacing = -1 then
 384     begin
 385       TotalSize := Point(ClientSize.X - (Margin + GlyphSize.X), ClientSize.Y - (Margin + GlyphSize.Y));
 386       if Layout in [blGlyphLeft, blGlyphRight] then
 387         Spacing := (TotalSize.X - TextSize.X) div 2
 388       else
 389         Spacing := (TotalSize.Y - TextSize.Y) div 2;
 390     end;
 391   end;
 392
 393   case Layout of
 394     blGlyphLeft:
 395       begin
 396         GlyphPos.X := Margin;
 397         TextPos.X := GlyphPos.X + GlyphSize.X + Spacing;
 398       end;
 399     blGlyphRight:
 400       begin
 401         GlyphPos.X := ClientSize.X - Margin - GlyphSize.X;
 402         TextPos.X := GlyphPos.X - Spacing - TextSize.X;
 403       end;
 404     blGlyphTop:
 405       begin
 406         GlyphPos.Y := Margin;
 407         TextPos.Y := GlyphPos.Y + GlyphSize.Y + Spacing;
 408       end;
 409     blGlyphBottom:
 410       begin
 411         GlyphPos.Y := ClientSize.Y - Margin - GlyphSize.Y;
 412         TextPos.Y := GlyphPos.Y - Spacing - TextSize.Y;
 413       end;
 414   end;
 415
 416   // Fixup the Result variables.
 417   with GlyphPos do
 418   begin
 419     Inc(X, Client.Left + Offset.X);
 420     Inc(Y, Client.Top + Offset.Y);
 421   end;
 422
 423   {$IFDEF THEME_7_UP}
 424   { Themed text is not shifted, but gets a different color. }
 425   if ThemeServices.ThemesEnabled then
 426     OffsetRect(TextBounds, TextPos.X + Client.Left, TextPos.Y + Client.Top)
 427   else
 428   {$ENDIF}
 429     OffsetRect(TextBounds, TextPos.X + Client.Left + Offset.X, TextPos.Y + Client.Top + Offset.Y);
 430 end;
 431
 432 function TButtonGlyph_Draw(Control: TControl; Canvas: TCanvas; const Client: TRect;
 433   const Offset: TPoint; const Caption: WideString; Layout: TButtonLayout; Margin: Integer;
 434     Spacing: Integer; State: TButtonState; Transparent: Boolean;
 435       BiDiFlags: Longint {$IFDEF COMPILER_7_UP}; WordWrap: Boolean {$ENDIF}): TRect;
 436 var
 437   GlyphPos: TPoint;
 438 begin
 439   TButtonGlyph_CalcButtonLayout(Control, Canvas.Handle, Client, Offset, Caption, Layout, Margin,
 440     Spacing, GlyphPos, Result, BiDiFlags {$IFDEF COMPILER_7_UP}, WordWrap {$ENDIF});
 441   TButtonGlyph_DrawButtonGlyph(Control, Canvas, GlyphPos, State, Transparent);
 442   TButtonGlyph_DrawButtonText(Canvas, Caption, Result, State,
 443     BiDiFlags {$IFDEF COMPILER_7_UP}, WordWrap {$ENDIF});
 444 end;
 445
 446 { TTntSpeedButton }
 447
 448 procedure TTntSpeedButton.DefineProperties(Filer: TFiler);
 449 begin
 450   inherited;
 451   TntPersistent_AfterInherited_DefineProperties(Filer, Self);
 452 end;
 453
 454 function TTntSpeedButton.IsCaptionStored: Boolean;
 455 begin
 456   Result := TntControl_IsCaptionStored(Self)
 457 end;
 458
 459 function TTntSpeedButton.GetCaption: TWideCaption;
 460 begin
 461   Result := TntControl_GetText(Self);
 462 end;
 463
 464 procedure TTntSpeedButton.SetCaption(const Value: TWideCaption);
 465 begin
 466   TntControl_SetText(Self, Value);
 467 end;
 468
 469 function TTntSpeedButton.IsHintStored: Boolean;
 470 begin
 471   Result := TntControl_IsHintStored(Self)
 472 end;
 473
 474 function TTntSpeedButton.GetHint: WideString;
 475 begin
 476   Result := TntControl_GetHint(Self)
 477 end;
 478
 479 procedure TTntSpeedButton.SetHint(const Value: WideString);
 480 begin
 481   TntControl_SetHint(Self, Value);
 482 end;
 483
 484 procedure TTntSpeedButton.CMHintShow(var Message: TMessage);
 485 begin
 486   ProcessCMHintShowMsg(Message);
 487   inherited;
 488 end;
 489
 490 procedure TTntSpeedButton.CMDialogChar(var Message: TCMDialogChar);
 491 begin
 492   with Message do
 493     if IsWideCharAccel(CharCode, Caption) and Enabled and Visible and
 494       (Parent <> nil) and Parent.Showing then
 495     begin
 496       Click;
 497       Result := 1;
 498     end else
 499       inherited;
 500 end;
 501
 502 function TTntSpeedButton.GetButtonGlyph: Pointer;
 503 begin
 504   Result := THackSpeedButton(Self).FGlyph;
 505 end;
 506
 507 procedure TTntSpeedButton.UpdateInternalGlyphList;
 508 begin
 509   FPaintInherited := True;
 510   try
 511     Repaint;
 512   finally
 513     FPaintInherited := False;
 514   end;
 515   Invalidate;
 516   raise EAbortPaint.Create('');
 517 end;
 518
 519 procedure TTntSpeedButton.Paint;
 520 begin
 521   if FPaintInherited then
 522     inherited
 523   else
 524     PaintButton;
 525 end;
 526
 527 procedure TTntSpeedButton.PaintButton;
 528 const
 529   DownStyles: array[Boolean] of Integer = (BDR_RAISEDINNER, BDR_SUNKENOUTER);
 530   FillStyles: array[Boolean] of Integer = (BF_MIDDLE, 0);
 531 var
 532   PaintRect: TRect;
 533   DrawFlags: Integer;
 534   Offset: TPoint;
 535   {$IFDEF THEME_7_UP}
 536   Button: TThemedButton;
 537   ToolButton: TThemedToolBar;
 538   Details: TThemedElementDetails;
 539   {$ENDIF}
 540 begin
 541   try
 542     if not Enabled then
 543     begin
 544       FState := bsDisabled;
 545       THackSpeedButton(Self).FDragging := False;
 546     end
 547     else if FState = bsDisabled then
 548       if Down and (GroupIndex <> 0) then
 549         FState := bsExclusive
 550       else
 551         FState := bsUp;
 552     Canvas.Font := Self.Font;
 553
 554     {$IFDEF THEME_7_UP}
 555     if ThemeServices.ThemesEnabled then
 556     begin
 557       {$IFDEF COMPILER_7_UP}
 558       PerformEraseBackground(Self, Canvas.Handle);
 559       {$ENDIF}
 560       SelectObject(Canvas.Handle, Canvas.Font.Handle); { For some reason, PerformEraseBackground sometimes messes the font up. }
 561
 562       if not Enabled then
 563         Button := tbPushButtonDisabled
 564       else
 565         if FState in [bsDown, bsExclusive] then
 566           Button := tbPushButtonPressed
 567         else
 568           if MouseInControl then
 569             Button := tbPushButtonHot
 570           else
 571             Button := tbPushButtonNormal;
 572
 573       ToolButton := ttbToolbarDontCare;
 574       if Flat then
 575       begin
 576         case Button of
 577           tbPushButtonDisabled:
 578             Toolbutton := ttbButtonDisabled;
 579           tbPushButtonPressed:
 580             Toolbutton := ttbButtonPressed;
 581           tbPushButtonHot:
 582             Toolbutton := ttbButtonHot;
 583           tbPushButtonNormal:
 584             Toolbutton := ttbButtonNormal;
 585         end;
 586       end;
 587
 588       PaintRect := ClientRect;
 589       if ToolButton = ttbToolbarDontCare then
 590       begin
 591         Details := ThemeServices.GetElementDetails(Button);
 592         ThemeServices.DrawElement(Canvas.Handle, Details, PaintRect);
 593         PaintRect := ThemeServices.ContentRect(Canvas.Handle, Details, PaintRect);
 594       end
 595       else
 596       begin
 597         Details := ThemeServices.GetElementDetails(ToolButton);
 598         ThemeServices.DrawElement(Canvas.Handle, Details, PaintRect);
 599         PaintRect := ThemeServices.ContentRect(Canvas.Handle, Details, PaintRect);
 600       end;
 601
 602       if Button = tbPushButtonPressed then
 603       begin
 604         // A pressed speed button has a white text. This applies however only to flat buttons.
 605         if ToolButton <> ttbToolbarDontCare then
 606           Canvas.Font.Color := clHighlightText;
 607         Offset := Point(1, 0);
 608       end
 609       else
 610         Offset := Point(0, 0);
 611       TButtonGlyph_Draw(Self, Canvas, PaintRect, Offset, Caption, Layout, Margin, Spacing, FState,
 612         Transparent, DrawTextBiDiModeFlags(0) {$IFDEF COMPILER_7_UP}, False {$ENDIF});
 613     end
 614     else
 615     {$ENDIF}
 616     begin
 617       PaintRect := Rect(0, 0, Width, Height);
 618       if not Flat then
 619       begin
 620         DrawFlags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
 621         if FState in [bsDown, bsExclusive] then
 622           DrawFlags := DrawFlags or DFCS_PUSHED;
 623         DrawFrameControl(Canvas.Handle, PaintRect, DFC_BUTTON, DrawFlags);
 624       end
 625       else
 626       begin
 627         if (FState in [bsDown, bsExclusive]) or
 628           (MouseInControl and (FState <> bsDisabled)) or
 629           (csDesigning in ComponentState) then
 630           DrawEdge(Canvas.Handle, PaintRect, DownStyles[FState in [bsDown, bsExclusive]],
 631             FillStyles[Transparent] or BF_RECT)
 632         else if not Transparent then
 633         begin
 634           Canvas.Brush.Color := Color;
 635           Canvas.FillRect(PaintRect);
 636         end;
 637         InflateRect(PaintRect, -1, -1);
 638       end;
 639       if FState in [bsDown, bsExclusive] then
 640       begin
 641         if (FState = bsExclusive) and (not Flat or not MouseInControl) then
 642         begin
 643           Canvas.Brush.Bitmap := AllocPatternBitmap(clBtnFace, clBtnHighlight);
 644           Canvas.FillRect(PaintRect);
 645         end;
 646         Offset.X := 1;
 647         Offset.Y := 1;
 648       end
 649       else
 650       begin
 651         Offset.X := 0;
 652         Offset.Y := 0;
 653       end;
 654       TButtonGlyph_Draw(Self, Canvas, PaintRect, Offset, Caption,
 655         Layout, Margin, Spacing, FState, Transparent,
 656           DrawTextBiDiModeFlags(0) {$IFDEF COMPILER_7_UP}, False {$ENDIF});
 657     end;
 658   except
 659     on E: EAbortPaint do
 660       ;
 661     else
 662       raise;
 663   end;
 664 end;
 665
 666 function TTntSpeedButton.GetActionLinkClass: TControlActionLinkClass;
 667 begin
 668   Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
 669 end;
 670
 671 {$IFDEF COMPILER_10_UP}
 672 type
 673   TAccessGraphicControl = class(TGraphicControl);
 674 {$ENDIF}
 675
 676 procedure TTntSpeedButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
 677 {$IFDEF COMPILER_10_UP}
 678 // bug fix for VCL where ImageIndex on Action ALWAYS overrides the Glyph.
 679 type
 680   CallActionChange = procedure(Sender: TObject; CheckDefaults: Boolean) of object;
 681 var
 682   M: TMethod;
 683 {$ENDIF}
 684 begin
 685   TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
 686   {$IFNDEF COMPILER_10_UP}
 687   inherited;
 688   {$ELSE}
 689   // call TGraphicControl.ActionChange (bypass TSpeedButton.ActionChange)
 690   M.Code := @TAccessGraphicControl.ActionChange;
 691   M.Data := Self;
 692   CallActionChange(M)(Sender, CheckDefaults);
 693   // call Delphi2005's TSpeedButton.ActionChange
 694   if Sender is TCustomAction{TNT-ALLOW TCustomAction} then
 695     with TCustomAction{TNT-ALLOW TCustomAction}(Sender) do
 696     begin
 697       if CheckDefaults or (Self.GroupIndex = 0) then
 698         Self.GroupIndex := GroupIndex;
 699       { Copy image from action's imagelist }
 700       if (Glyph.Empty) and (ActionList <> nil) and (ActionList.Images <> nil) and
 701         (ImageIndex >= 0) and (ImageIndex < ActionList.Images.Count) then
 702         CopyImage(ActionList.Images, ImageIndex);
 703     end;
 704   {$ENDIF}
 705 end;
 706
 707 { TTntBitBtn }
 708
 709 procedure TTntBitBtn.CreateWindowHandle(const Params: TCreateParams);
 710 begin
 711   CreateUnicodeHandle(Self, Params, 'BUTTON');
 712 end;
 713
 714 procedure TTntBitBtn.DefineProperties(Filer: TFiler);
 715 begin
 716   inherited;
 717   TntPersistent_AfterInherited_DefineProperties(Filer, Self);
 718 end;
 719
 720 function TTntBitBtn.IsCaptionStored: Boolean;
 721 var
 722   BaseClass: TClass;
 723   PropInfo: PPropInfo;
 724 begin
 725   Assert(Self is TButton{TNT-ALLOW TButton});
 726   Assert(Self is TBitBtn{TNT-ALLOW TBitBtn});
 727   if Kind = bkCustom then
 728     // don't use TBitBtn, it's broken for Kind <> bkCustom
 729     BaseClass := TButton{TNT-ALLOW TButton}
 730   else begin
 731     //TBitBtn has it's own storage specifier, based upon the button kind
 732     BaseClass := TBitBtn{TNT-ALLOW TBitBtn};
 733   end;
 734   PropInfo := GetPropInfo(BaseClass, 'Caption');
 735   if PropInfo = nil then
 736     raise EPropertyError.CreateResFmt(PResStringRec(@SUnknownProperty), ['Caption']);
 737   Result := IsStoredProp(Self, PropInfo);
 738 end;
 739
 740 function TTntBitBtn.GetCaption: TWideCaption;
 741 begin
 742   Result := TntControl_GetText(Self)
 743 end;
 744
 745 procedure TTntBitBtn.SetCaption(const Value: TWideCaption);
 746 begin
 747   TntControl_SetText(Self, Value);
 748 end;
 749
 750 function TTntBitBtn.IsHintStored: Boolean;
 751 begin
 752   Result := TntControl_IsHintStored(Self)
 753 end;
 754
 755 function TTntBitBtn.GetHint: WideString;
 756 begin
 757   Result := TntControl_GetHint(Self)
 758 end;
 759
 760 procedure TTntBitBtn.SetHint(const Value: WideString);
 761 begin
 762   TntControl_SetHint(Self, Value);
 763 end;
 764
 765 procedure TTntBitBtn.CMDialogChar(var Message: TCMDialogChar);
 766 begin
 767   TntButton_CMDialogChar(Self, Message);
 768 end;
 769
 770 function TTntBitBtn.GetButtonGlyph: Pointer;
 771 begin
 772   Result := THackBitBtn(Self).FGlyph;
 773 end;
 774
 775 procedure TTntBitBtn.UpdateInternalGlyphList;
 776 begin
 777   FPaintInherited := True;
 778   try
 779     Repaint;
 780   finally
 781     FPaintInherited := False;
 782   end;
 783   Invalidate;
 784   raise EAbortPaint.Create('');
 785 end;
 786
 787 procedure TTntBitBtn.CNDrawItem(var Message: TWMDrawItem);
 788 begin
 789   if FPaintInherited then
 790     inherited
 791   else
 792     DrawItem(Message.DrawItemStruct^);
 793 end;
 794
 795 procedure TTntBitBtn.DrawItem(const DrawItemStruct: TDrawItemStruct);
 796 var
 797   IsDown, IsDefault: Boolean;
 798   State: TButtonState;
 799   R: TRect;
 800   Flags: Longint;
 801   FCanvas: TCanvas;
 802   IsFocused: Boolean;
 803   {$IFDEF THEME_7_UP}
 804   Details: TThemedElementDetails;
 805   Button: TThemedButton;
 806   Offset: TPoint;
 807   {$ENDIF}
 808 begin
 809   try
 810     FCanvas := THackBitBtn(Self).FCanvas;
 811     IsFocused := THackBitBtn(Self).IsFocused;
 812     FCanvas.Handle := DrawItemStruct.hDC;
 813     R := ClientRect;
 814
 815     with DrawItemStruct do
 816     begin
 817       FCanvas.Handle := hDC;
 818       FCanvas.Font := Self.Font;
 819       IsDown := itemState and ODS_SELECTED <> 0;
 820       IsDefault := itemState and ODS_FOCUS <> 0;
 821
 822       if not Enabled then State := bsDisabled
 823       else if IsDown then State := bsDown
 824       else State := bsUp;
 825     end;
 826
 827     {$IFDEF THEME_7_UP}
 828     if ThemeServices.ThemesEnabled then
 829     begin
 830       if not Enabled then
 831         Button := tbPushButtonDisabled
 832       else
 833         if IsDown then
 834           Button := tbPushButtonPressed
 835         else
 836           if FMouseInControl then
 837             Button := tbPushButtonHot
 838           else
 839             if IsFocused or IsDefault then
 840               Button := tbPushButtonDefaulted
 841             else
 842               Button := tbPushButtonNormal;
 843
 844       Details := ThemeServices.GetElementDetails(Button);
 845       // Parent background.
 846       ThemeServices.DrawParentBackground(Handle, DrawItemStruct.hDC, @Details, True);
 847       // Button shape.
 848       ThemeServices.DrawElement(DrawItemStruct.hDC, Details, DrawItemStruct.rcItem);
 849       R := ThemeServices.ContentRect(FCanvas.Handle, Details, DrawItemStruct.rcItem);
 850
 851       if Button = tbPushButtonPressed then
 852         Offset := Point(1, 0)
 853       else
 854         Offset := Point(0, 0);
 855       TButtonGlyph_Draw(Self, FCanvas, R, Offset, Caption, Layout, Margin, Spacing, State, False,
 856         DrawTextBiDiModeFlags(0) {$IFDEF COMPILER_7_UP}, Self.WordWrap {$ENDIF});
 857
 858       if IsFocused and IsDefault then
 859       begin
 860         FCanvas.Pen.Color := clWindowFrame;
 861         FCanvas.Brush.Color := clBtnFace;
 862         DrawFocusRect(FCanvas.Handle, R);
 863       end;
 864     end
 865     else
 866     {$ENDIF}
 867     begin
 868       R := ClientRect;
 869
 870       Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
 871       if IsDown then Flags := Flags or DFCS_PUSHED;
 872       if DrawItemStruct.itemState and ODS_DISABLED <> 0 then
 873         Flags := Flags or DFCS_INACTIVE;
 874
 875       { DrawFrameControl doesn't allow for drawing a button as the
 876           default button, so it must be done here. }
 877       if IsFocused or IsDefault then
 878       begin
 879         FCanvas.Pen.Color := clWindowFrame;
 880         FCanvas.Pen.Width := 1;
 881         FCanvas.Brush.Style := bsClear;
 882         FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
 883
 884         { DrawFrameControl must draw within this border }
 885         InflateRect(R, -1, -1);
 886       end;
 887
 888       { DrawFrameControl does not draw a pressed button correctly }
 889       if IsDown then
 890       begin
 891         FCanvas.Pen.Color := clBtnShadow;
 892         FCanvas.Pen.Width := 1;
 893         FCanvas.Brush.Color := clBtnFace;
 894         FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
 895         InflateRect(R, -1, -1);
 896       end
 897       else
 898         DrawFrameControl(DrawItemStruct.hDC, R, DFC_BUTTON, Flags);
 899
 900       if IsFocused then
 901       begin
 902         R := ClientRect;
 903         InflateRect(R, -1, -1);
 904       end;
 905
 906       FCanvas.Font := Self.Font;
 907       if IsDown then
 908         OffsetRect(R, 1, 1);
 909
 910       TButtonGlyph_Draw(Self, FCanvas, R, Point(0, 0), Caption, Layout, Margin, Spacing, State,
 911         False, DrawTextBiDiModeFlags(0) {$IFDEF COMPILER_7_UP}, Self.WordWrap {$ENDIF});
 912
 913       if IsFocused and IsDefault then
 914       begin
 915         R := ClientRect;
 916         InflateRect(R, -4, -4);
 917         FCanvas.Pen.Color := clWindowFrame;
 918         FCanvas.Brush.Color := clBtnFace;
 919         DrawFocusRect(FCanvas.Handle, R);
 920       end;
 921     end;
 922     FCanvas.Handle := 0;
 923   except
 924     on E: EAbortPaint do
 925       ;
 926     else
 927       raise;
 928   end;
 929 end;
 930
 931 procedure TTntBitBtn.CMMouseEnter(var Message: TMessage);
 932 begin
 933   FMouseInControl := True;
 934   inherited;
 935 end;
 936
 937 procedure TTntBitBtn.CMMouseLeave(var Message: TMessage);
 938 begin
 939   FMouseInControl := False;
 940   inherited;
 941 end;
 942
 943 {$IFDEF COMPILER_10_UP}
 944 type
 945   TAccessButton = class(TButton{TNT-ALLOW TButton});
 946 {$ENDIF}
 947
 948 procedure TTntBitBtn.ActionChange(Sender: TObject; CheckDefaults: Boolean);
 949 {$IFDEF COMPILER_10_UP}
 950 // bug fix for VCL where ImageIndex on Action ALWAYS overrides the Glyph.
 951 type
 952   CallActionChange = procedure(Sender: TObject; CheckDefaults: Boolean) of object;
 953 var
 954   M: TMethod;
 955 {$ENDIF}
 956 begin
 957   TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
 958   {$IFNDEF COMPILER_10_UP}
 959   inherited;
 960   {$ELSE}
 961   // call TButton.ActionChange (bypass TBitBtn.ActionChange)
 962   M.Code := @TAccessButton.ActionChange;
 963   M.Data := Self;
 964   CallActionChange(M)(Sender, CheckDefaults);
 965   // call Delphi2005's TBitBtn.ActionChange
 966   if Sender is TCustomAction{TNT-ALLOW TCustomAction} then
 967     with TCustomAction{TNT-ALLOW TCustomAction}(Sender) do
 968     begin
 969       { Copy image from action's imagelist }
 970       if (Glyph.Empty) and (ActionList <> nil) and (ActionList.Images <> nil) and
 971         (ImageIndex >= 0) and (ImageIndex < ActionList.Images.Count) then
 972         CopyImage(ActionList.Images, ImageIndex);
 973     end;
 974   {$ENDIF}
 975 end;
 976
 977 function TTntBitBtn.GetActionLinkClass: TControlActionLinkClass;
 978 begin
 979   Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
 980 end;
 981
 982 end.