tntbuttons.pas

TNTUniCtrlsWithExceptions UniCode 国际化语言

      Tnt_DrawTextW(DC, PWideChar(Caption), Length(Caption), TextBounds, DT_WORDBREAK
                                                                      or DT_CALCRECT or BiDiFlags)
    else
    {$ENDIF}
      Tnt_DrawTextW(DC, PWideChar(Caption), Length(Caption), TextBounds, DT_CALCRECT or BiDiFlags);

    TextSize := Point(TextBounds.Right - TextBounds.Left, TextBounds.Bottom - TextBounds.Top);
  end
  else
  begin
    TextBounds := Rect(0, 0, 0, 0);
    TextSize := Point(0, 0);
  end;

  // If the layout has the glyph on the right or the left, then both the text and the glyph are centered vertically.
  // If the glyph is on the top or the bottom, then both the text and the glyph are centered horizontally.
  if Layout in [blGlyphLeft, blGlyphRight] then
  begin
    GlyphPos.Y := (ClientSize.Y - GlyphSize.Y + 1) div 2;
    TextPos.Y := (ClientSize.Y - TextSize.Y + 1) div 2;
  end
  else
  begin
    GlyphPos.X := (ClientSize.X - GlyphSize.X + 1) div 2;
    TextPos.X := (ClientSize.X - TextSize.X + 1) div 2;
  end;

  // If there is no text or no bitmap, then Spacing is irrelevant.
  if (TextSize.X = 0) or (GlyphSize.X = 0) then
    Spacing := 0;

  // Adjust Margin and Spacing.
  if Margin = -1 then
  begin
    if Spacing = -1 then
    begin
      TotalSize := Point(GlyphSize.X + TextSize.X, GlyphSize.Y + TextSize.Y);
      if Layout in [blGlyphLeft, blGlyphRight] then
        Margin := (ClientSize.X - TotalSize.X) div 3
      else
        Margin := (ClientSize.Y - TotalSize.Y) div 3;
      Spacing := Margin;
    end
    else
    begin
      TotalSize := Point(GlyphSize.X + Spacing + TextSize.X, GlyphSize.Y + Spacing + TextSize.Y);
      if Layout in [blGlyphLeft, blGlyphRight] then
        Margin := (ClientSize.X - TotalSize.X + 1) div 2
      else
        Margin := (ClientSize.Y - TotalSize.Y + 1) div 2;
    end;
  end
  else
  begin
    if Spacing = -1 then
    begin
      TotalSize := Point(ClientSize.X - (Margin + GlyphSize.X), ClientSize.Y - (Margin + GlyphSize.Y));
      if Layout in [blGlyphLeft, blGlyphRight] then
        Spacing := (TotalSize.X - TextSize.X) div 2
      else
        Spacing := (TotalSize.Y - TextSize.Y) div 2;
    end;
  end;

  case Layout of
    blGlyphLeft:
      begin
        GlyphPos.X := Margin;
        TextPos.X := GlyphPos.X + GlyphSize.X + Spacing;
      end;
    blGlyphRight:
      begin
        GlyphPos.X := ClientSize.X - Margin - GlyphSize.X;
        TextPos.X := GlyphPos.X - Spacing - TextSize.X;
      end;
    blGlyphTop:
      begin
        GlyphPos.Y := Margin;
        TextPos.Y := GlyphPos.Y + GlyphSize.Y + Spacing;
      end;
    blGlyphBottom:
      begin
        GlyphPos.Y := ClientSize.Y - Margin - GlyphSize.Y;
        TextPos.Y := GlyphPos.Y - Spacing - TextSize.Y;
      end;
  end;

  // Fixup the Result variables.
  with GlyphPos do
  begin
    Inc(X, Client.Left + Offset.X);
    Inc(Y, Client.Top + Offset.Y);
  end;

  {$IFDEF THEME_7_UP}
  { Themed text is not shifted, but gets a different color. }
  if ThemeServices.ThemesEnabled then
    OffsetRect(TextBounds, TextPos.X + Client.Left, TextPos.Y + Client.Top)
  else
  {$ENDIF}
    OffsetRect(TextBounds, TextPos.X + Client.Left + Offset.X, TextPos.Y + Client.Top + Offset.Y);
end;

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;
var
  GlyphPos: TPoint;
begin
  TButtonGlyph_CalcButtonLayout(Control, Canvas.Handle, Client, Offset, Caption, Layout, Margin,
    Spacing, GlyphPos, Result, BiDiFlags {$IFDEF COMPILER_7_UP}, WordWrap {$ENDIF});
  TButtonGlyph_DrawButtonGlyph(Control, Canvas, GlyphPos, State, Transparent);
  TButtonGlyph_DrawButtonText(Canvas, Caption, Result, State,
    BiDiFlags {$IFDEF COMPILER_7_UP}, WordWrap {$ENDIF});
end;

{ TTntSpeedButton }

procedure TTntSpeedButton.DefineProperties(Filer: TFiler);
begin
  inherited;
  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;

function TTntSpeedButton.IsCaptionStored: Boolean;
begin
  Result := TntControl_IsCaptionStored(Self)
end;

function TTntSpeedButton.GetCaption: TWideCaption;
begin
  Result := TntControl_GetText(Self);
end;

procedure TTntSpeedButton.SetCaption(const Value: TWideCaption);
begin
  TntControl_SetText(Self, Value);
end;

function TTntSpeedButton.IsHintStored: Boolean;
begin
  Result := TntControl_IsHintStored(Self)
end;

function TTntSpeedButton.GetHint: WideString;
begin
  Result := TntControl_GetHint(Self)
end;

procedure TTntSpeedButton.SetHint(const Value: WideString);
begin
  TntControl_SetHint(Self, Value);
end;

procedure TTntSpeedButton.CMHintShow(var Message: TMessage);
begin
  ProcessCMHintShowMsg(Message);
  inherited;
end;

procedure TTntSpeedButton.CMDialogChar(var Message: TCMDialogChar);
begin
  with Message do
    if IsWideCharAccel(CharCode, Caption) and Enabled and Visible and
      (Parent <> nil) and Parent.Showing then
    begin
      Click;
      Result := 1;
    end else
      inherited;
end;

function TTntSpeedButton.GetButtonGlyph: Pointer;
begin
  Result := THackSpeedButton(Self).FGlyph;
end;

procedure TTntSpeedButton.UpdateInternalGlyphList;
begin
  FPaintInherited := True;
  try
    Repaint;
  finally
    FPaintInherited := False;
  end;
  Invalidate;
  raise EAbortPaint.Create('');
end;

procedure TTntSpeedButton.Paint;
begin
  if FPaintInherited then
    inherited
  else
    PaintButton;
end;

procedure TTntSpeedButton.PaintButton;
const
  DownStyles: array[Boolean] of Integer = (BDR_RAISEDINNER, BDR_SUNKENOUTER);
  FillStyles: array[Boolean] of Integer = (BF_MIDDLE, 0);
var
  PaintRect: TRect;
  DrawFlags: Integer;
  Offset: TPoint;
  {$IFDEF THEME_7_UP}
  Button: TThemedButton;
  ToolButton: TThemedToolBar;
  Details: TThemedElementDetails;
  {$ENDIF}
begin
  try
    if not Enabled then
    begin
      FState := bsDisabled;
      THackSpeedButton(Self).FDragging := False;
    end
    else if FState = bsDisabled then
      if Down and (GroupIndex <> 0) then
        FState := bsExclusive
      else
        FState := bsUp;
    Canvas.Font := Self.Font;

    {$IFDEF THEME_7_UP}
    if ThemeServices.ThemesEnabled then
    begin
      {$IFDEF COMPILER_7_UP}
      PerformEraseBackground(Self, Canvas.Handle);
      {$ENDIF}
      SelectObject(Canvas.Handle, Canvas.Font.Handle); { For some reason, PerformEraseBackground sometimes messes the font up. }

      if not Enabled then
        Button := tbPushButtonDisabled
      else
        if FState in [bsDown, bsExclusive] then
          Button := tbPushButtonPressed
        else
          if MouseInControl then
            Button := tbPushButtonHot
          else
            Button := tbPushButtonNormal;

      ToolButton := ttbToolbarDontCare;
      if Flat then
      begin
        case Button of
          tbPushButtonDisabled:
            Toolbutton := ttbButtonDisabled;
          tbPushButtonPressed:
            Toolbutton := ttbButtonPressed;
          tbPushButtonHot:
            Toolbutton := ttbButtonHot;
          tbPushButtonNormal:
            Toolbutton := ttbButtonNormal;
        end;
      end;

      PaintRect := ClientRect;
      if ToolButton = ttbToolbarDontCare then
      begin
        Details := ThemeServices.GetElementDetails(Button);
        ThemeServices.DrawElement(Canvas.Handle, Details, PaintRect);
        PaintRect := ThemeServices.ContentRect(Canvas.Handle, Details, PaintRect);
      end
      else
      begin
        Details := ThemeServices.GetElementDetails(ToolButton);
        ThemeServices.DrawElement(Canvas.Handle, Details, PaintRect);
        PaintRect := ThemeServices.ContentRect(Canvas.Handle, Details, PaintRect);
      end;

      if Button = tbPushButtonPressed then
      begin
        // A pressed speed button has a white text. This applies however only to flat buttons.
        if ToolButton <> ttbToolbarDontCare then
          Canvas.Font.Color := clHighlightText;
        Offset := Point(1, 0);
      end
      else
        Offset := Point(0, 0);
      TButtonGlyph_Draw(Self, Canvas, PaintRect, Offset, Caption, Layout, Margin, Spacing, FState,
        Transparent, DrawTextBiDiModeFlags(0) {$IFDEF COMPILER_7_UP}, False {$ENDIF});
    end
    else
    {$ENDIF}
    begin
      PaintRect := Rect(0, 0, Width, Height);
      if not Flat then
      begin
        DrawFlags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
        if FState in [bsDown, bsExclusive] then
          DrawFlags := DrawFlags or DFCS_PUSHED;
        DrawFrameControl(Canvas.Handle, PaintRect, DFC_BUTTON, DrawFlags);
      end
      else
      begin
        if (FState in [bsDown, bsExclusive]) or
          (MouseInControl and (FState <> bsDisabled)) or
          (csDesigning in ComponentState) then
          DrawEdge(Canvas.Handle, PaintRect, DownStyles[FState in [bsDown, bsExclusive]],
            FillStyles[Transparent] or BF_RECT)
        else if not Transparent then
        begin
          Canvas.Brush.Color := Color;
          Canvas.FillRect(PaintRect);
        end;
        InflateRect(PaintRect, -1, -1);
      end;
      if FState in [bsDown, bsExclusive] then
      begin
        if (FState = bsExclusive) and (not Flat or not MouseInControl) then
        begin
          Canvas.Brush.Bitmap := AllocPatternBitmap(clBtnFace, clBtnHighlight);
          Canvas.FillRect(PaintRect);
        end;
        Offset.X := 1;
        Offset.Y := 1;
      end
      else
      begin
        Offset.X := 0;
        Offset.Y := 0;
      end;
      TButtonGlyph_Draw(Self, Canvas, PaintRect, Offset, Caption,
        Layout, Margin, Spacing, FState, Transparent,
          DrawTextBiDiModeFlags(0) {$IFDEF COMPILER_7_UP}, False {$ENDIF});