zoukankan      html  css  js  c++  java
  • delphi Tab Item Badge Value 消息数标记

    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.
  • 相关阅读:
    谷歌浏览器离线安装
    C语言restrict关键字的使用
    Win32编程中radiobutton的分组
    在SourceForge中建立开源项目
    [转载]Linux解压缩命令
    [转载]vim配置文件
    解决VC6在win7下打开文件崩溃问题
    gson解析复杂的json数据
    catch中return语句的执行时间
    踏出了学习clojure的第一步
  • 原文地址:https://www.cnblogs.com/cb168/p/6009932.html
Copyright © 2011-2022 走看看