delphi Tab Item Badge Value 消息数标记

Posted 2020-08-16 lypzxy

https://community.embarcadero.com/blogs?view=entry&id=9074

 

unit TabBadgeFrm;
 
interface
 
uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.TabControl, FMX.Controls.Presentation, FMX.Edit,
  FMX.EditBox, FMX.SpinBox, FMX.StdCtrls, FMX.Layouts, FMX.ListBox,
  FMX.NumberBox;
 
type
  TForm16 = class(TForm)
    TabItem1: TTabItem;
    TabItem2: TTabItem;
    BadgeItem: TTabItem;
    SpinBox1: TSpinBox;
    ToolBar1: TToolBar;
    Switch1: TSwitch;
    ListBox1: TListBox;
    ListBoxItem1: TListBoxItem;
    ToolLabel: TLabel;
    TabControl1: TTabControl;
    procedure BadgeItemPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
    procedure SpinBox1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Switch1Switch(Sender: TObject);
    procedure StepperUpClick(Sender: TObject);
  private
    FBadge: Integer;
    FShowBadge: Boolean;
    procedure SetBadge(const Value: Integer);
    procedure SetShowBadge(const Value: Boolean);
    { Private declarations }
  public
    { Public declarations }
    property Badge: Integer read FBadge write SetBadge;
    property ShowBadge: Boolean read FShowBadge write SetShowBadge;
  end;
 
var
  Form16: TForm16;
 
implementation
 
{$R *.fmx}
{$R *.iPhone55in.fmx ios}
 
procedure DrawBadge(Canvas: TCanvas; const ARect: TRectF; const Text: string;
  const Color: TAlphaColor = TAlphaColorRec.Red);
const
  Padding = 2;
  HorzTextMargin = 6;
  VertTextMargin = 4;
var
  R: TRectF;
  TextSize: TSizeF;
  Brush: TBrush;
  BadgeRadius: Single;
begin
  Canvas.Font.Size := 12;
  // Measure text width
  TextSize := TSizeF.Create(Canvas.TextWidth(Text), Canvas.TextHeight(Text));
  // Calculate badge rect
  R := TRectF.Create(0, 0, HorzTextMargin * 2 + TextSize.Width, VertTextMargin * 2 + TextSize.Height);
  if R.Width < R.Height then
    R.Width := R.Height;
  // Position rect
  R := TRectF.Create(ARect.Right - R.Width, ARect.Top, ARect.Right, ARect.Top + R.Height);
  R.Offset(-Padding, Padding);
  // Draw badge
  BadgeRadius := R.Height / 2;
  Brush := TBrush.Create(TBrushKind.Solid, Color);
  try
    Canvas.FillRect(R, BadgeRadius, BadgeRadius, AllCorners, 1, Brush);
  finally
    Brush.Free;
  end;
  // Draw text
  Canvas.Fill.Color := TAlphaColorRec.White;
  Canvas.FillText(R, Text, False, 1, [], TTextAlign.Center, TTextAlign.Center);
end;
 
procedure TForm16.BadgeItemPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
begin
  if ShowBadge then
    DrawBadge(Canvas, ARect, FBadge.ToString);
end;
 
procedure TForm16.FormCreate(Sender: TObject);
begin
  FBadge := 1;
end;
 
procedure TForm16.SetBadge(const Value: Integer);
begin
  if FBadge  Value then
  begin
    FBadge := Value;
    BadgeItem.Repaint;
  end;
end;
 
procedure TForm16.SetShowBadge(const Value: Boolean);
begin
  if FShowBadge  Value then
  begin
    FShowBadge := Value;
    BadgeItem.Repaint;
  end;
end;
 
procedure TForm16.SpinBox1Change(Sender: TObject);
begin
  Badge := Trunc(SpinBox1.Value);
end;
 
procedure TForm16.StepperUpClick(Sender: TObject);
begin
  Badge := Trunc(SpinBox1.Value);
end;
 
procedure TForm16.Switch1Switch(Sender: TObject);
begin
  ShowBadge := Switch1.IsChecked;
end;
 
end.