如何在Delphi XE3 FireMonkey 2中的TTabControl的每个选项卡上实现关闭按钮?

2024-01-10

我正在尝试创建一个浏览器样式的 TabControl,在 FireMonkey FM2 中的每个选项卡上都有一个小的关闭按钮。

由于 FM2 中没有 TTabsheet 和 TPageControl 组件,因此我无法使用“如何为 TPageControl 的 Ttabsheet 实现关闭按钮 https://stackoverflow.com/questions/2201850/how-to-implement-a-close-button-for-a-ttabsheet-of-a-tpagecontrol”。我猜这段代码给出了太多未声明的函数和变量,FM2 不再支持这些函数和变量。

我不想使用任何第三方组件,因为你永远不知道它们是否会支持下一版本的 Delphi :)

我可以提供在 Delphi XE3 VCL 中正常工作的完整代码(但不能在 FireMonkey 中):

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Math, Vcl.Themes;

type
  TFormMain = class(TForm)
    PageControlCloseButton: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    procedure FormCreate(Sender: TObject);
    procedure PageControlCloseButtonMouseLeave(Sender: TObject);
    procedure PageControlCloseButtonMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure PageControlCloseButtonMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure PageControlCloseButtonMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure PageControlCloseButtonDrawTab(Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean);

  private
    FCloseButtonsRect: array of TRect;
    FCloseButtonMouseDownIndex: Integer;
    FCloseButtonShowPushed: Boolean;
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;

implementation

{$R *.dfm}

procedure TFormMain.FormCreate(Sender: TObject);
var
  I: Integer;
begin

  PageControlCloseButton.TabWidth := 150;
  PageControlCloseButton.OwnerDraw := True;

  //should be done on every change of the page count
  SetLength(FCloseButtonsRect, PageControlCloseButton.PageCount);
  FCloseButtonMouseDownIndex := -1;

  for I := 0 to Length(FCloseButtonsRect) - 1 do
  begin
    FCloseButtonsRect[I] := Rect(0, 0, 0, 0);
  end;

end;

procedure TFormMain.PageControlCloseButtonDrawTab(Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
  CloseBtnSize: Integer;
  PageControl: TPageControl;
  TabCaption: TPoint;
  CloseBtnRect: TRect;
  CloseBtnDrawState: Cardinal;
  CloseBtnDrawDetails: TThemedElementDetails;
const
  UseThemes: boolean=true;
begin
  PageControl := Control as TPageControl;

  if InRange(TabIndex, 0, Length(FCloseButtonsRect) - 1) then
  begin
    CloseBtnSize := 14;
    TabCaption.Y := Rect.Top + 3;

    if Active then
    begin
      CloseBtnRect.Top := Rect.Top + 4;
      CloseBtnRect.Right := Rect.Right - 5;
      TabCaption.X := Rect.Left + 6;
    end
    else
    begin
      CloseBtnRect.Top := Rect.Top + 3;
      CloseBtnRect.Right := Rect.Right - 5;
      TabCaption.X := Rect.Left + 3;
    end;

    CloseBtnRect.Bottom := CloseBtnRect.Top + CloseBtnSize;
    CloseBtnRect.Left := CloseBtnRect.Right - CloseBtnSize;
    FCloseButtonsRect[TabIndex] := CloseBtnRect;

    PageControl.Canvas.FillRect(Rect);
    PageControl.Canvas.TextOut(TabCaption.X, TabCaption.Y, PageControl.Pages[TabIndex].Caption);


    if not UseThemes then
    begin
      if (FCloseButtonMouseDownIndex = TabIndex) and FCloseButtonShowPushed then
        CloseBtnDrawState := DFCS_CAPTIONCLOSE + DFCS_PUSHED
      else
        CloseBtnDrawState := DFCS_CAPTIONCLOSE;

        DrawFrameControl(PageControl.Canvas.Handle,
        FCloseButtonsRect[TabIndex], DFC_CAPTION, CloseBtnDrawState);
    end
    else
    begin
      Dec(FCloseButtonsRect[TabIndex].Left);

      if (FCloseButtonMouseDownIndex = TabIndex) and FCloseButtonShowPushed then
        CloseBtnDrawDetails := ThemeServices.GetElementDetails(twCloseButtonPushed)
      else
        CloseBtnDrawDetails := ThemeServices.GetElementDetails(twCloseButtonNormal);

      ThemeServices.DrawElement(PageControl.Canvas.Handle, CloseBtnDrawDetails,
        FCloseButtonsRect[TabIndex]);
    end;

  end;
end;

procedure TFormMain.PageControlCloseButtonMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  I: Integer;
begin
  if Button = mbLeft then
  begin
    for I := 0 to Length(FCloseButtonsRect) - 1 do
    begin
      if PtInRect(FCloseButtonsRect[I], Point(X, Y)) then
      begin
        FCloseButtonMouseDownIndex := I;
        FCloseButtonShowPushed := True;
        PageControlCloseButton.Repaint;
      end;
    end;
  end;
end;

procedure TFormMain.PageControlCloseButtonMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
  Inside: Boolean;
begin
   if (ssLeft in Shift) and (FCloseButtonMouseDownIndex >= 0) then
  begin
    Inside := PtInRect(FCloseButtonsRect[FCloseButtonMouseDownIndex], Point(X, Y));

    if FCloseButtonShowPushed <> Inside then
    begin
      FCloseButtonShowPushed := Inside;
      PageControlCloseButton.Repaint;
    end;
  end;
end;

procedure TFormMain.PageControlCloseButtonMouseLeave(Sender: TObject);
var
  PageControl: TPageControl;
begin
   FCloseButtonShowPushed := False;
  PageControlCloseButton.Repaint;
end;

procedure TFormMain.PageControlCloseButtonMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  PageControl: TPageControl;
begin

  if (Button = mbLeft) and (FCloseButtonMouseDownIndex >= 0) then
  begin
    if PtInRect(FCloseButtonsRect[FCloseButtonMouseDownIndex], Point(X, Y)) then
    begin
      PageControlCloseButton.Pages[PageControlCloseButton.ActivePageIndex].TabVisible := false;
      PageControlCloseButton.ActivePageIndex := 0;

      FCloseButtonMouseDownIndex := -1;
      PageControlCloseButton.Repaint;
    end;
  end;
 end;

end.

在 github 上有一个开源组件,可以在此链接处扩展基本 FMX TTabControlhttps://github.com/jkour/neTabControl https://github.com/jkour/neTabControl在那里你可以了解如何自己做。

本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)

如何在Delphi XE3 FireMonkey 2中的TTabControl的每个选项卡上实现关闭按钮? 的相关文章

  • 获取字符、整数和日期字段的字段 oldValue 和 newValue

    我试图只保留表更改的历史记录 所以我想获取一个字段在更改为oldValue之前的值 然后获取它更改为newValue的值 两个值都应转换为字符串 因此 这是该表的一个示例 PartNumber Description 12345 Test
  • 如何将 JSON 字符串转换为图像?

    我有一个将图像转换为 JSON 数组的应用程序 并将其保存到 blob 字段中 function getImage String var memorystream TMemoryStream jsonArray TJSONArray beg
  • 从delphi应用程序调用.net4.0 com服务器后出现错误异常

    我们正在将代码库从 BDS2006 迁移到 Rad Studio XE 我们发现了一些非常奇怪的行为 如果我们在从 Net4 0 中实现的 COM 服务器创建一些对象后进行无效的浮点运算 即除以零 我们不会没有得到正常异常 即 EDivis
  • 我需要避免尝试更新连接到 TSQLQuery 的 Delphi TClientDataset 中的非物理字段

    概要 我的代码正在尝试更新 Delphi XE 中的非物理字段TClientDataset 连接到TSQLQuery以其SQL属性集 作为运行时的结果创建Open命令 我有一个TClientDataset连接到一个TDatasetProvi
  • 在 Delphi 2007 中将具有透明度的位图保存为 PNG

    我有一个包含透明度信息的 Delphi 位图 32 位 我需要将其转换并保存为 PNG 文件 同时保留透明度 我目前拥有的工具是graphics32 Library GR32 PNG 由Christian Budde 提供 和PNGImag
  • 在TImageViewer中,如何获取用户点击图片的位置?

    在TImageViewer控件中 用户可以缩放或平移图片 我的问题是 当用户点击图片时 如何获取用户在图片上的点击位置 尤其是用户可以对图片进行放大 缩小或平移之后 如何获取对应的图片点击位置呢 As shown below How to
  • FreePascal x64 上系统单元函数的汇编调用

    我有一些 Delphi 汇编代码 可以在 Win32 Win64 和 OSX 32 上编译并正常工作 XE2 但是 由于我需要它在 Linux 上工作 所以我一直在考虑编译它的 FPC 版本 到目前为止 Win32 64 Linux32 6
  • 在Delphi 7中,为什么我可以给const赋值?

    我将一些 Delphi 代码从一个项目复制到另一个项目 发现它在新项目中无法编译 但在旧项目中可以编译 代码看起来像这样 procedure TForm1 CalculateGP const Price money 0 begin Pric
  • 调试器异常错误和内存超调

    我尝试运行以下代码 但它显示有关内存地址的错误 并显示一条消息 循环后 n 可能未定义 请看一看 var n max integer n integer r R1 f h0 Array of Real const h 0 00889 nip
  • TColorProperty德尔福柏林10.1.2?

    我正在尝试将组件从 Delphi 7 转换为 Delphi Berlin 平面组件 https sourceforge net projects flatstyle https sourceforge net projects flatst
  • Delphi 流畅的界面

    使用上有什么优点和缺点流畅的界面 http en wikipedia org wiki Fluent interface在德尔福 流畅的界面应该会增加可读性 但我对此有点怀疑one包含很多链式方法的长 LOC 是否存在编译器问题 是否存在任
  • 如何用不同的颜色绘制选定的列表框项目?

    是否可以更改 TListBox 中的项目选择焦点颜色和文本颜色 当项目中未启用主题或列表框样式设置为所有者绘制时 项目周围的选择将被涂成蓝色 我相信这是由系统的外观设置全局定义的 我想将所选项目的颜色更改为自定义颜色 举个例子 结果会是这样
  • 打印 TDBGrid [重复]

    这个问题在这里已经有答案了 如何在不安装或下载组件的情况下打印 DBGrid OR 如何将 DBGrid 的数据放入 RichEdit 以便我可以从那里打印它 数据感知控件从 DataSource 属性获取数据 并使用它 不过 您必须手动遍
  • 如何在iOS的Delphi程序中使用IPv6协议

    我尝试在我的移动程序中使用 IPv6 协议 我的服务器位于 NAT 后面的 LAN 内 在服务器上我使用IP端口3000 我已经组织了从路由器端口 45500 到服务器端口 3000 的虚拟服务器 端口转发 在服务器上 我运行 ipconf
  • logback的“谨慎模式”是如何实现的?

    The 审慎模式 http logback qos ch manual appenders html prudentlogback 中的序列化所有 JVM 之间的 IO 操作 写入同一文件 可能运行在不同的主机上 在其他日志记录框架中 如果
  • 如何在Delphi中将对象方法作为参数传递,然后调用它?

    我担心这可能是一个有点愚蠢的问题 但这让我很难过 我正在寻找将对象的方法传递到过程中的最简单的方法 以便过程可以调用对象的方法 例如 超时后 或者可能在不同的线程中 所以基本上我想 捕获对对象方法的引用 将该引用传递给过程 使用该引用 从过
  • CharInSet 不适用于非英文字母?

    我已经将应用程序从 Delphi 2007 更新到 Delphi 2010 一切都很顺利 除了一条编译正常但不起作用的语句 If Edit1 Text 1 in S then ShowMessage Found else ShowMessa
  • 从其可执行文件的路径获取服务名称

    我有一个可执行文件的路径 它是一个正在运行的服务应用程序 例如 C Program Files x86 Someapp somesvc exe 我想停止并启动它 为此我想我需要获取服务的名称 如下所示 this https stackove
  • 任何第三方都可以从我的项目加载嵌入式资源吗?

    请参考我的一篇之前的问题 https stackoverflow com questions 14681364 issues passing data from dll to application 我问的是如何从 DLL 加载已编译的资源
  • D2010编译行数差异

    构建项目时 有两个地方会报告源代码行数 在编译进度对话框中 项目下 信息 在 Delphi 2007 中 对于我们正在构建的项目 这两个数字是相同的 在 Delphi 2010 中 这两个数字截然不同 1st 计数多出 100 万行或 40

随机推荐

  • Android - Facebook 共享内容被覆盖

    这是我在 Facebook 上分享高分的代码 ShareLinkContent content new ShareLinkContent Builder setImageUrl Uri parse http www example com
  • 获取 Today-Extension 内通知中心的宽度

    我目前正在尝试将 CollectionView 放入 Today 扩展中 但有件事让我烦恼 我希望实现每个单元格都适合我的集合视图的一行 因此 根据项目数计算单元格宽度 在 iPhone 上一切正常 但在 iPad 上却看起来不太正常 单元
  • 将 Azure 诊断日志写入 Blob 存储的性能影响

    我们在 Azure 上运行的 C Web 应用程序使用 System Diagnostics Trace 编写跟踪语句以进行调试 故障排除 一旦我们为这些日志启用 blob 存储 使用 Azure 门户中的 应用程序日志记录 blob 选项
  • 将 Serilog 与 Azure 日志流结合使用

    我一直在研究如何使用 Serilog 写入 Azure 日志流 我也在这里找到了一些答案 例如 一个答案是建议登录到特定文件夹中的文件 home LogFiles http 但它似乎对我不起作用 我尝试使用Trace https githu
  • 添加 Material Design 时,布局预览不显示布局

    我正在开发一个 Android 应用程序 一切看起来都很完美 直到我决定使用材料设计在我的主题中 添加后材料设计主题 布局预览不显示预览 但在手机上构建时效果良好 当删除 xml 中使用的材料设计组件时 一切都完美运行 附上我的代码 活动主
  • 列出文件中的 unicode 单词

    我的代码是 f codecs open r C Users Admin Desktop nepali txt r UTF 8 nepali f read split for i in nepali print i 显示文件中的单词 但是当我
  • 如何修复:致命错误:openssl/opensslv.h:RedHat 7 中没有这样的文件或目录

    我有 RedHat Enterprise Linux Server 7 并且下载了 linux 内核版本 4 12 10 我正在尝试编译它 但是当我执行以下命令时 make modules 我收到以下错误 scripts sign file
  • 使用默认过滤器值加载数据表

    尝试使用数据表中的输入框构建自定义搜索 请找到小提琴版本 http jsfiddle net c6cu705n http jsfiddle net c6cu705n 我试图仅加载表中的 San Francisco 值 而不加载其他值 尝试了
  • 如何使 ProgressDialog 可以通过后退按钮取消,但不能通过屏幕点击取消?

    我想做一个ProgressDialog可以通过后退按钮取消 但不能通过屏幕点击取消 目前我使用setCancelable true 然而 在一些较新的设备中 点击屏幕也会取消ProgressDialog 我想禁用屏幕点击操作Progress
  • iOS UITextField 在文本更改时更改位置

    我用它来将文本字段置于相关内容的中心 textField setCenter someObject center textField becomeFirstResponder 这看起来很棒 很漂亮 并且位于对象的中心 可以接受文本 我希望文
  • Python smtplib 代理支持

    我想通过代理发送电子邮件 我目前的实现如下 我通过身份验证连接到 smtp 服务器 成功登录后 我会发送一封电子邮件 它工作正常 但当我查看电子邮件标题时 我可以看到我的主机名 我想通过代理来传输它 任何帮助将不胜感激 Use Socksi
  • OracleConnection 生命周期 - 最佳实践

    我正在使用标准 Oracle 驱动程序连接到数据库 但对于 OracleConnection 的生命周期 我不太同意我的同事的观点 创建成本高吗 它是线程安全的吗 我可以在请求之间重复使用它 还是应该为每个请求创建一个新的 如果能更详细地解
  • 从 ExecutorService 更新 JProgressBar

    我正在使用 Java ICMP ping 功能对网关进行 ping 操作 为了执行快速 ping 我使用 ExectorService 创建用于 ping 的线程 地址被 ping 或不 后 我想在 ping 后更新 Jprogressba
  • Eclipse 和 Android XML 布局给出“‘默认’不是任何设备/区域设置组合的最佳匹配”

    这是我第一次使用 XML 布局制作应用程序 过去我总是在运行时动态生成布局 所以不用担心 我不是 Android 新手 不过 这是我第一次使用静态布局 那么这条消息到底是关于什么的呢 2010 09 22 20 43 23 Rockport
  • Bootstrap css,如何使导航栏切换始终可见?

    我想添加在移动设备上显示的按钮之一 以便打开导航栏中的折叠菜单 但到目前为止还无法做到 这里是较少的代码和 html navbar toggle always navbar toggle media min width 768px disp
  • MongoDB 汇总之前所有周的每周总和

    我有一系列 MongoDB 文档 一个示例文档是 createdAt Mon Oct 12 2015 09 45 20 GMT 0700 PDT year 2015 week 41 想象一下这些跨越一年中的所有几周 并且同一周可能有很多 我
  • Modernizr:如何检测 CSS display:table-cell 支持?

    我想用display table and display table cell对于我在支持它的浏览器中的布局 在 IE7 中 我只是想浮动我的列 因为我假设它不可能在该浏览器中工作 但无法找到有关如何使用 Modernizr 执行此操作的任
  • 如何在 matplotlib 中绘制 datetime.time ?

    我有两个要显示的数组 x datetime time 0 17 47 782000 ect y 1712 2002 ect 我正在尝试将 x 转换为 matplotlib 使用的格式 但它永远不会工作 x matplotlib dates
  • 使用 Firebase 身份验证验证 ID 令牌

    我们正在开始开发一个 Web 应用程序 并考虑使用 Firebase 身份验证来处理我们的注册流程 但是 我们不确定 ID 令牌验证的工作原理 似乎可以在 Firebase 领域之外使用其令牌来验证用户 我们正在考虑在 Google Kub
  • 如何在Delphi XE3 FireMonkey 2中的TTabControl的每个选项卡上实现关闭按钮?

    我正在尝试创建一个浏览器样式的 TabControl 在 FireMonkey FM2 中的每个选项卡上都有一个小的关闭按钮 由于 FM2 中没有 TTabsheet 和 TPageControl 组件 因此我无法使用 如何为 TPageC