首页 技术 正文
技术 2022年11月16日
0 收藏 832 点赞 4,397 浏览 2717 个字

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

delphi Tab Item Badge Value 消息数标记

unit TabBadgeFrm;interfaceuses
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 = ;
HorzTextMargin = ;
VertTextMargin = ;
var
R: TRectF;
TextSize: TSizeF;
Brush: TBrush;
BadgeRadius: Single;
begin
Canvas.Font.Size := ;
// Measure text width
TextSize := TSizeF.Create(Canvas.TextWidth(Text), Canvas.TextHeight(Text));
// Calculate badge rect
R := TRectF.Create(, , HorzTextMargin * + TextSize.Width, VertTextMargin * + 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 / ;
Brush := TBrush.Create(TBrushKind.Solid, Color);
try
Canvas.FillRect(R, BadgeRadius, BadgeRadius, AllCorners, , Brush);
finally
Brush.Free;
end;
// Draw text
Canvas.Fill.Color := TAlphaColorRec.White;
Canvas.FillText(R, Text, False, , [], 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 := ;
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.
相关推荐
python开发_常用的python模块及安装方法
adodb:我们领导推荐的数据库连接组件bsddb3:BerkeleyDB的连接组件Cheetah-1.0:我比较喜欢这个版本的cheeta…
日期:2022-11-24 点赞:878 阅读:9,121
Educational Codeforces Round 11 C. Hard Process 二分
C. Hard Process题目连接:http://www.codeforces.com/contest/660/problem/CDes…
日期:2022-11-24 点赞:807 阅读:5,593
下载Ubuntn 17.04 内核源代码
zengkefu@server1:/usr/src$ uname -aLinux server1 4.10.0-19-generic #21…
日期:2022-11-24 点赞:569 阅读:6,438
可用Active Desktop Calendar V7.86 注册码序列号
可用Active Desktop Calendar V7.86 注册码序列号Name: www.greendown.cn Code: &nb…
日期:2022-11-24 点赞:733 阅读:6,209
Android调用系统相机、自定义相机、处理大图片
Android调用系统相机和自定义相机实例本博文主要是介绍了android上使用相机进行拍照并显示的两种方式,并且由于涉及到要把拍到的照片显…
日期:2022-11-24 点赞:512 阅读:7,845
Struts的使用
一、Struts2的获取  Struts的官方网站为:http://struts.apache.org/  下载完Struts2的jar包,…
日期:2022-11-24 点赞:671 阅读:4,930