tntbuttons.pas

TNTUniCtrlsWithExceptions UniCode 国际化语言

{*****************************************************************************}
{                                                                             }
{    Tnt Delphi Unicode Controls                                              }
{      http://www.tntware.com/delphicontrols/unicode/                         }
{        Version: 2.3.0                                                       }
{                                                                             }
{    Copyright (c) 2002-2007, Troy Wolbrink ([e-mail])       }
{                                                                             }
{*****************************************************************************}

unit TntButtons;

{$INCLUDE TntCompilers.inc}

interface

uses
  Windows, Messages, Classes, Controls, Graphics, StdCtrls,
  ExtCtrls, CommCtrl, Buttons,
  TntControls;

type
  ITntGlyphButton = interface
    ['{15D7E501-1E33-4293-8B45-716FB3B14504}']
    function GetButtonGlyph: Pointer;
    procedure UpdateInternalGlyphList;
  end;

{TNT-WARN TSpeedButton}
  TTntSpeedButton = class(TSpeedButton {TNT-ALLOW TSpeedButton}, ITntGlyphButton)
  private
    FPaintInherited: Boolean;
    function GetCaption: TWideCaption;
    procedure SetCaption(const Value: TWideCaption);
    function GetHint: WideString;
    procedure SetHint(const Value: WideString);
    function IsCaptionStored: Boolean;
    function IsHintStored: Boolean;
    procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  protected
    function GetButtonGlyph: Pointer;
    procedure UpdateInternalGlyphList; dynamic;
    procedure PaintButton; dynamic;
    procedure Paint; override;
    procedure DefineProperties(Filer: TFiler); override;
    function GetActionLinkClass: TControlActionLinkClass; override;
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
  published
    property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
    property Hint: WideString read GetHint write SetHint stored IsHintStored;
  end;

{TNT-WARN TBitBtn}
  TTntBitBtn = class(TBitBtn {TNT-ALLOW TBitBtn}, ITntGlyphButton)
  private
    FPaintInherited: Boolean;
    FMouseInControl: Boolean;
    function IsCaptionStored: Boolean;
    function GetCaption: TWideCaption;
    procedure SetCaption(const Value: TWideCaption);
    function IsHintStored: Boolean;
    function GetHint: WideString;
    procedure SetHint(const Value: WideString);
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  protected
    function GetButtonGlyph: Pointer;
    procedure UpdateInternalGlyphList; dynamic;
    procedure DrawItem(const DrawItemStruct: TDrawItemStruct); dynamic;
    procedure CreateWindowHandle(const Params: TCreateParams); override;
    procedure DefineProperties(Filer: TFiler); override;
    function GetActionLinkClass: TControlActionLinkClass; override;
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
  published
    property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
    property Hint: WideString read GetHint write SetHint stored IsHintStored;
  end;

procedure TButtonGlyph_CalcButtonLayout(Control: TControl; DC: HDC; const Client: TRect;
  const Offset: TPoint; const Caption: WideString; Layout: TButtonLayout;
    Margin, Spacing: Integer; var GlyphPos: TPoint; var TextBounds: TRect;
    BiDiFlags: Integer {$IFDEF COMPILER_7_UP}; WordWrap: Boolean {$ENDIF});

function TButtonGlyph_Draw(Control: TControl; Canvas: TCanvas; const Client: TRect;
  const Offset: TPoint; const Caption: WideString; Layout: TButtonLayout; Margin: Integer;
    Spacing: Integer; State: TButtonState; Transparent: Boolean;
    BiDiFlags: Longint {$IFDEF COMPILER_7_UP}; WordWrap: Boolean {$ENDIF}): TRect;

implementation

uses                                      
  SysUtils, ActnList, TntForms, TntStdCtrls, TypInfo, RTLConsts, TntWindows,
  {$IFDEF THEME_7_UP} Themes, {$ENDIF} TntClasses, TntActnList, TntSysUtils;

type
  EAbortPaint = class(EAbort);

// Many routines in this unit are nearly the same as those found in Buttons.pas.  They are
//   included here because the VCL implementation of TButtonGlyph is completetly inaccessible.

type
  THackButtonGlyph_D6_D7_D9 = class
  protected
    FOriginal: TBitmap;
    FGlyphList: TImageList;
    FIndexs: array[TButtonState] of Integer;
    FxxxxTransparentColor: TColor;
    FNumGlyphs: TNumGlyphs;
  end;

  THackBitBtn_D6_D7_D9 = class(TButton{TNT-ALLOW TButton})
  protected
    FCanvas: TCanvas;
    FGlyph: Pointer;
    FxxxxStyle: TButtonStyle;
    FxxxxKind: TBitBtnKind;
    FxxxxLayout: TButtonLayout;
    FxxxxSpacing: Integer;
    FxxxxMargin: Integer;
    IsFocused: Boolean;
  end;

  THackSpeedButton_D6_D7_D9 = class(TGraphicControl)
  protected
    FxxxxGroupIndex: Integer;
    FGlyph: Pointer;
    FxxxxDown: Boolean;
    FDragging: Boolean;
  end;

  {$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
  THackButtonGlyph = THackButtonGlyph_D6_D7_D9;
  THackBitBtn      = THackBitBtn_D6_D7_D9;
  THackSpeedButton = THackSpeedButton_D6_D7_D9;
  {$ENDIF}
  {$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
  THackButtonGlyph = THackButtonGlyph_D6_D7_D9;
  THackBitBtn      = THackBitBtn_D6_D7_D9;
  THackSpeedButton = THackSpeedButton_D6_D7_D9;
  {$ENDIF}
  {$IFDEF DELPHI_9} // verified against VCL source in Delphi 9
  THackButtonGlyph = THackButtonGlyph_D6_D7_D9;
  THackBitBtn      = THackBitBtn_D6_D7_D9;
  THackSpeedButton = THackSpeedButton_D6_D7_D9;
  {$ENDIF}
  {$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
  THackButtonGlyph = THackButtonGlyph_D6_D7_D9;
  THackBitBtn      = THackBitBtn_D6_D7_D9;
  THackSpeedButton = THackSpeedButton_D6_D7_D9;
  {$ENDIF}

function GetButtonGlyph(Control: TControl): THackButtonGlyph;
var
  GlyphButton: ITntGlyphButton;
begin
  if Control.GetInterface(ITntGlyphButton, GlyphButton) then
    Result := GlyphButton.GetButtonGlyph
  else
    raise ETntInternalError.Create('Internal Error: Control does not support ITntGlyphButton.');
end;

procedure UpdateInternalGlyphList(Control: TControl);
var
  GlyphButton: ITntGlyphButton;
begin
  if Control.GetInterface(ITntGlyphButton, GlyphButton) then
    GlyphButton.UpdateInternalGlyphList
  else
    raise ETntInternalError.Create('Internal Error: Control does not support ITntGlyphButton.');
end;

function TButtonGlyph_CreateButtonGlyph(Control: TControl; State: TButtonState): Integer;
var
  ButtonGlyph: THackButtonGlyph;
  NumGlyphs: Integer;
begin
  ButtonGlyph := GetButtonGlyph(Control);
  NumGlyphs := ButtonGlyph.FNumGlyphs;

  if (State = bsDown) and (NumGlyphs < 3) then State := bsUp;
  Result := ButtonGlyph.FIndexs[State];
  if (Result = -1) then begin
    UpdateInternalGlyphList(Control);
    Result := ButtonGlyph.FIndexs[State];
  end;
end;

procedure TButtonGlyph_DrawButtonGlyph(Control: TControl; Canvas: TCanvas; const GlyphPos: TPoint;
  State: TButtonState; Transparent: Boolean);
var
  ButtonGlyph: THackButtonGlyph;
  Glyph: TBitmap;
  GlyphList: TImageList;
  Index: Integer;
  {$IFDEF THEME_7_UP}
  Details: TThemedElementDetails;
  R: TRect;
  Button: TThemedButton;
  {$ENDIF}
begin
  ButtonGlyph := GetButtonGlyph(Control);
  Glyph := ButtonGlyph.FOriginal;
  GlyphList := ButtonGlyph.FGlyphList;
  if Glyph = nil then Exit;
  if (Glyph.Width = 0) or (Glyph.Height = 0) then Exit;
  Index := TButtonGlyph_CreateButtonGlyph(Control, State);
  with GlyphPos do
  {$IFDEF THEME_7_UP}
  if ThemeServices.ThemesEnabled then begin
    R.TopLeft := GlyphPos;
    R.Right := R.Left + Glyph.Width div ButtonGlyph.FNumGlyphs;
    R.Bottom := R.Top + Glyph.Height;
    case State of
      bsDisabled:
        Button := tbPushButtonDisabled;
      bsDown,
      bsExclusive:
        Button := tbPushButtonPressed;
    else
      // bsUp
      Button := tbPushButtonNormal;
    end;
    Details := ThemeServices.GetElementDetails(Button);
    ThemeServices.DrawIcon(Canvas.Handle, Details, R, GlyphList.Handle, Index);
  end else
  {$ENDIF}
    if Transparent or (State = bsExclusive) then
      ImageList_DrawEx(GlyphList.Handle, Index, Canvas.Handle, X, Y, 0, 0,
        clNone, clNone, ILD_Transparent)
    else
      ImageList_DrawEx(GlyphList.Handle, Index, Canvas.Handle, X, Y, 0, 0,
        ColorToRGB(clBtnFace), clNone, ILD_Normal);
end;

procedure TButtonGlyph_DrawButtonText(Canvas: TCanvas; const Caption: WideString;
  TextBounds: TRect; State: TButtonState;
    BiDiFlags: LongInt {$IFDEF COMPILER_7_UP}; WordWrap: Boolean {$ENDIF});
begin
  with Canvas do
  begin
    Brush.Style := bsClear;
    if State = bsDisabled then
    begin
      OffsetRect(TextBounds, 1, 1);
      Font.Color := clBtnHighlight;

      {$IFDEF COMPILER_7_UP}
      if WordWrap then
        Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), TextBounds,
          DT_CENTER or DT_VCENTER or BiDiFlags or DT_WORDBREAK) 
      else
      {$ENDIF}
        Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), TextBounds,
          DT_CENTER or DT_VCENTER or BiDiFlags);

      OffsetRect(TextBounds, -1, -1);
      Font.Color := clBtnShadow;

      {$IFDEF COMPILER_7_UP}
      if WordWrap then
        Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), TextBounds,
          DT_CENTER or DT_WORDBREAK or BiDiFlags) { TODO: Figure out why DT_VCENTER is not used }
      else
      {$ENDIF}
        Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), TextBounds,
          DT_CENTER or DT_VCENTER or BiDiFlags);

    end else
    begin
      {$IFDEF COMPILER_7_UP}
      if WordWrap then
        Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), TextBounds,
          DT_CENTER or DT_WORDBREAK or BiDiFlags) { TODO: Figure out why DT_VCENTER is not used }
      else
      {$ENDIF}
        Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), TextBounds,
          DT_CENTER or DT_VCENTER or BiDiFlags);
    end;
  end;
end;

procedure TButtonGlyph_CalcButtonLayout(Control: TControl; DC: HDC; const Client: TRect;
  const Offset: TPoint; const Caption: WideString; Layout: TButtonLayout;
    Margin, Spacing: Integer; var GlyphPos: TPoint; var TextBounds: TRect;
      BiDiFlags: Integer {$IFDEF COMPILER_7_UP}; WordWrap: Boolean {$ENDIF});
var
  TextPos: TPoint;
  ClientSize,
  GlyphSize,
  TextSize: TPoint;
  TotalSize: TPoint;
  Glyph: TBitmap;
  NumGlyphs: Integer;
  ButtonGlyph: THackButtonGlyph;
begin
  ButtonGlyph := GetButtonGlyph(Control);
  Glyph := ButtonGlyph.FOriginal;
  NumGlyphs := ButtonGlyph.FNumGlyphs;

  if (BiDiFlags and DT_RIGHT) = DT_RIGHT then
    if Layout = blGlyphLeft then
      Layout := blGlyphRight
    else
      if Layout = blGlyphRight then
        Layout := blGlyphLeft;

  // Calculate the item sizes.
  ClientSize := Point(Client.Right - Client.Left, Client.Bottom - Client.Top);

  if Assigned(Glyph) then
    GlyphSize := Point(Glyph.Width div NumGlyphs, Glyph.Height)
  else
    GlyphSize := Point(0, 0);

  if Length(Caption) > 0 then
  begin
    {$IFDEF COMPILER_7_UP}
    TextBounds := Rect(0, 0, Client.Right - Client.Left - GlyphSize.X - 3, 0); { TODO: Figure out why GlyphSize.X is in here. }
    {$ELSE}
    TextBounds := Rect(0, 0, Client.Right - Client.Left, 0);
    {$ENDIF}

    {$IFDEF COMPILER_7_UP}
    if WordWrap then