选项卡的关闭按钮不支持 vcl 样式

2023-12-05

我已经使用了本示例中提供的代码如何为 TPageControl 的 Ttabsheet 实现关闭按钮在页面控件的每个选项卡上绘制一个关闭按钮,我在代码中用样式服务替换了 ThemeServices,并且在应用样式时,关闭按钮不会显示,也不会做出任何反应。谁能指出我解决这个问题的不同路径。谢谢你!这是 OnDrawTab 事件的代码:

  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;
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;

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

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

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

如果您使用的是vcl样式,则必须编写一个vcl样式钩子来在选项卡控件中绘制关闭按钮,请查看Vcl.Styles.ColorTabs单位(在这些文章中介绍使用 VCL 样式创建彩色选项卡, 为 TTabColorControlStyleHook 添加边框)以了解编写这样的样式钩子需要什么。除了在选项卡中绘制按钮的代码之外,您还必须处理 WM_MOUSEMOVE 和 WM_LBUTTONUP 消息(在样式挂钩中)以更改按钮的状态(正常、热)并检测关闭按钮中的单击。

如果您在实现样式挂钩时遇到问题,请告诉我在这里发布完整的解决方案。

UPDATE

我刚刚编写了这个简单的样式挂钩来添加对选项卡中关闭按钮的支持。

uses
  Vcl.Styles,
  Vcl.Themes;

type
  TTabControlStyleHookBtnClose = class(TTabControlStyleHook)
  private
    FHotIndex       : Integer;
    FWidthModified  : Boolean;
    procedure WMMouseMove(var Message: TMessage); message WM_MOUSEMOVE;
    procedure WMLButtonUp(var Message: TWMMouse); message WM_LBUTTONUP;
    function GetButtonCloseRect(Index: Integer):TRect;
  strict protected
    procedure DrawTab(Canvas: TCanvas; Index: Integer); override;
    procedure MouseEnter; override;
    procedure MouseLeave; override;
  public
    constructor Create(AControl: TWinControl); override;
  end;

constructor TTabControlStyleHookBtnClose.Create(AControl: TWinControl);
begin
  inherited;
  FHotIndex:=-1;
  FWidthModified:=False;
end;

procedure TTabControlStyleHookBtnClose.DrawTab(Canvas: TCanvas; Index: Integer);
var
  Details : TThemedElementDetails;
  ButtonR : TRect;
  FButtonState: TThemedWindow;
begin
  inherited;

  if (FHotIndex>=0) and (Index=FHotIndex) then
   FButtonState := twSmallCloseButtonHot
  else
  if Index = TabIndex then
   FButtonState := twSmallCloseButtonNormal
  else
   FButtonState := twSmallCloseButtonDisabled;

  Details := StyleServices.GetElementDetails(FButtonState);

  ButtonR:= GetButtonCloseRect(Index);
  if ButtonR.Bottom - ButtonR.Top > 0 then
   StyleServices.DrawElement(Canvas.Handle, Details, ButtonR);
end;

procedure TTabControlStyleHookBtnClose.WMLButtonUp(var Message: TWMMouse);
Var
  LPoint : TPoint;
  LIndex : Integer;
begin
  LPoint:=Message.Pos;
  for LIndex := 0 to TabCount-1 do
   if PtInRect(GetButtonCloseRect(LIndex), LPoint) then
   begin
      if Control is TPageControl then
      begin
        TPageControl(Control).Pages[LIndex].Parent:=nil;
        TPageControl(Control).Pages[LIndex].Free;
      end;
      break;
   end;
end;

procedure TTabControlStyleHookBtnClose.WMMouseMove(var Message: TMessage);
Var
  LPoint : TPoint;
  LIndex : Integer;
  LHotIndex : Integer;
begin
  inherited;
  LHotIndex:=-1;
  LPoint:=TWMMouseMove(Message).Pos;
  for LIndex := 0 to TabCount-1 do
   if PtInRect(GetButtonCloseRect(LIndex), LPoint) then
   begin
      LHotIndex:=LIndex;
      break;
   end;

   if (FHotIndex<>LHotIndex) then
   begin
     FHotIndex:=LHotIndex;
     Invalidate;
   end;
end;

function TTabControlStyleHookBtnClose.GetButtonCloseRect(Index: Integer): TRect;
var
  FButtonState: TThemedWindow;
  Details : TThemedElementDetails;
  R, ButtonR : TRect;
begin
  R := TabRect[Index];
  if R.Left < 0 then Exit;

  if TabPosition in [tpTop, tpBottom] then
  begin
    if Index = TabIndex then
      InflateRect(R, 0, 2);
  end
  else
  if Index = TabIndex then
    Dec(R.Left, 2)
  else
    Dec(R.Right, 2);

  Result := R;
  FButtonState := twSmallCloseButtonNormal;

  Details := StyleServices.GetElementDetails(FButtonState);
  if not StyleServices.GetElementContentRect(0, Details, Result, ButtonR) then
    ButtonR := Rect(0, 0, 0, 0);

  Result.Left :=Result.Right - (ButtonR.Width) - 5;
  Result.Width:=ButtonR.Width;
end;

procedure TTabControlStyleHookBtnClose.MouseEnter;
begin
  inherited;
  FHotIndex := -1;
end;

procedure TTabControlStyleHookBtnClose.MouseLeave;
begin
  inherited;
  if FHotIndex >= 0 then
  begin
    FHotIndex := -1;
    Invalidate;
  end;
end;

通过这种方式注册

  TStyleManager.Engine.RegisterStyleHook(TCustomTabControl, TTabControlStyleHookBtnClose);
  TStyleManager.Engine.RegisterStyleHook(TTabControl, TTabControlStyleHookBtnClose);

这是一个演示

enter image description here

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

选项卡的关闭按钮不支持 vcl 样式 的相关文章

  • Delphi 如何与 Active Directory 集成?

    我们需要使用 Delphi 7 验证 Microsoft Active Directory 上的用户 最好的方法是什么 我们可以有两种情况 用户输入其网络用户名和密码 其中用户名可能包括域 然后我们检查活动目录是否是有效的活动用户 或者我们
  • 在 Inno Setup 中使用 StringToColor

    我想为表单上的标签 TNewStaticText 属性颜色 TColor 读写 分配一些颜色 我将颜色存储为 RRGGBB 字符串 我想使用 Delphi 函数 StringToColor 将其转换为 TColor 但如果我在脚本中使用此函
  • ADODB 组件导致 Win7/Server 2008 上的访问冲突

    我有一段用 Delphi 2005 编写的代码 用于在 LDAP 中搜索用户的特定属性 当在 Windows 7 或 Server 2008 上运行时 我遇到访问冲突 但在 XP 或 2003 上则没有 Function IsSSOUser
  • 如何添加资源并使用它们

    在我的应用程序中 我想添加 2 个图像作为资源 我想使用这些图像 当我在应用程序中单击 是 按钮时 第一张图像将被设置为壁纸 当我在应用程序中单击 否 按钮时 第二张图像将被设置为桌面壁纸 提前致谢 regards 最简单的方法是创建一个文
  • 在运行时创建 TQReport 元素

    在运行时创建 TQReport 元素 嗯 至少尝试一下 我不知道这份报告中应出现哪些标题或数据 我得到一个代表数据行和列的 TString 的 TList 我在组的带打印事件中植入 创建 指令 并在主数据行带的 OnNeedData 事件中
  • 错误:使用 Microsoft WebService.dll 通过 Delphi7 规范化 XML

    我正在使用 Delphi7 修改旧项目以添加使用证书和签名 经过一番搜索后我发现XML 规范化函数 https learn microsoft com en us previous versions dd815358 v vs 85 但我无
  • 如何从具有管理员权限的应用程序接收键盘输入到非管理员应用程序?

    我编写了一个应用程序 该应用程序具有覆盖类型的窗口 可以通过热键显示和隐藏该窗口 而另一个应用程序具有焦点 所述另一个应用程序是一个以管理员权限运行的 DirectX 游戏 我已经尝试了 3 种可能的解决方案 以便在其他应用程序中按下我的热
  • VCL.位图到 FMX.位图

    我在网上找到了这段代码 但 FMX Bitmap 没有扫描线 是否可以以某种方式将 VCL TBitmap 复制或绘制到 FMX Bitmap IFDEF MSWINDOWS type TBitmap FMX Types TBitmap T
  • 如何在 OSX 上的应用程序名称下创建子项菜单?

    如何在下面添加TMenuItemProject1以上Quit在下面的屏幕截图上 我创建了一个 TMenuBar 并选中了 UseOSMenu 属性 我添加的第一个 TMenuItem 是主栏中的第二个 TMenuItem 您可以通过将 II
  • 如何确保 FormClose 程序运行,无论程序如何退出?

    在 Delphi 7 中 我有一个 TMainForm FormClose 过程 旨在在程序退出时写出一些状态 这在手动关闭程序时效果很好 但是 我发现如果程序被 Windows 强制 退出 例如在 Windows 更新后需要重新启动 则不
  • Delphi线程死锁

    我有时会在销毁某些线程时遇到死锁问题 我尝试过调试该问题 但在 IDE 中调试时似乎从未存在死锁 可能是因为 IDE 中的事件速度较低 问题 当应用程序启动时 主线程会创建多个线程 线程始终处于活动状态并与主线程同步 完全没有问题 当应用程
  • Delphi TImageList 位图更改

    我正在使用 Delphi XE2 Update 3 Update 4 与我们的一些第 3 方组件不兼容 因此我们尚未更新 我在我的应用程序中使用 TImageList 我注意到很多时候当它从源视图切换到表单视图 F12 时 突然之前未修改的
  • delphi 变量值在循环中的线程中发生变化

    我的代码正在运行一个 for 循环来处理一些数据 如下所示 procedure printValue Value Integer begin TThread Synchronize TThread Current procedure beg
  • 使用 OLE 和 Delphi 提高 Word 文档中搜索替换的性能

    经过一些实验 我最终得到了以下代码来在 MSWord 中执行搜索和替换 此代码在页眉和页脚中也能完美运行 包括首页或奇数 偶数页的页眉和 或页脚不同的情况 问题是我需要打电话MSWordSearchAndReplaceInAllDocume
  • 德尔福数据结构

    我可能需要在 Delphi 中做一个项目 并且是该领域的初学者 目前 我正在网上搜索资源 但由于资源站点太少而感到困惑 首先 你能给我一些好的网站 其中包含我迄今为止错过的 Delphi 资源吗 我也在 Delphi 中搜索数据结构 想知道
  • 具有 csOwnerDrawFixed 样式的组合框如何表现得像 csDropDown 样式?

    我正在使用一个组合框 http docwiki embarcadero com Libraries en Vcl StdCtrls TComboBoxstyle 属性设置为的组件csOwnerDrawFixed 我实现了绘图项一切工作正常
  • 在 Delphi 中使用 XML(将特定数据返回到变量)

    过去几天我一直在尝试使用 Delphi 2010 和 MSXML 我是一个极端的新手 需要一点指导 var MemoryStream TMemoryStream XMLPath String sName String XMLDoc vari
  • 每次 TDbGrid 的选定位置更改时都会触发什么事件?

    我的项目中有一个 TDbGrid 每次更改所选行时我都试图触发一个事件 行中的任何更改都已经更新了链接到同一数据源的所有数据感知控件 但还需要进行其他更改 我需要一个事件处理程序 我认为 OnColEnter 会起作用 根据帮助文件 它在以
  • 如何从 VCL.Graphics 获取所有已注册的文件格式...但 64 位

    在我的 32 位应用程序中 我使用FindRegisteredPictureFileFormats 单元由 Cosmin Prund 提供 https stackoverflow com a 14677532 505088 gt 如何从图形
  • 如何在运行时(Delphi/Windows)程序中添加代码?

    我正在Windows XP Delphi 7上工作 我需要在正在运行的程序中添加一些过程 或函数 并且我不想在完成后再次重新编译它 我只有一个具有 5 个功能的主机应用程序来发送不同类型的警报 但是还有其他新的警报类型 所以我必须执行新的功

随机推荐

  • C# 中的谓词是什么? [复制]

    这个问题在这里已经有答案了 我对使用谓词非常陌生 刚刚学会了如何编写 Predicate
  • Bin Packing - 暴力递归解决方案 - 如何使其更快

    我有一个数组 其中包含不同大小的材料列表 4 3 4 1 7 8 但是 该箱子最多可容纳 10 号材料 我需要找出包装数组中所有元素所需的最小箱子数量 对于上面的数组 你可以打包成 3 个 bin 并按如下方式划分它们 4 4 1 3 7
  • 打印所有内容,不带省略号

    当我尝试打印列时 print dataframe columns 它向我展示了 Index u Id u Guid u HardDisksInfo u ServerVersion u Email u BackupServer u DataS
  • 如何提取在 python 中渲染 HTML 页面期间获得的 url 列表?

    我希望能够获取当我们尝试打开页面时浏览器将执行 GET 请求的所有 URL 的列表 例如 如果我们尝试打开 cnn com 浏览器递归请求的第一个 HTTP 响应中会有多个 URL 我不想渲染页面 但我试图获取渲染页面时请求的所有 url
  • 如何使用 ajax-call joomla 2.5 加载自定义 html 模块

    我的 html 页面中有一个类名 flyer 和 href MY HREF 的链接 当用户单击链接时 我想加载具有特定 ID 的 自定义 html 模块 您能否告诉我 MY HREF 的语法如何 例如http www mywebsite c
  • 如果 autoStartup 设置为 false,如何手动启动 Spring Cloud Stream Binder

    我在用着spring cloud starter stream kafka创建 Kafka 消费者绑定并且我已经配置spring cloud stream bindings input consumer autoStartup to fal
  • 使用 PHP 根据日期显示内容

    我正在搭建一个基于 Wordpress 的竞赛网站 从法律上讲 比赛必须在午夜开始 为了避免半夜起来设置内容 我想构建一些 PHP 逻辑来显示开始日期之后的所有内容 并在此之前显示一些基本的 HTML 用于启动页面 我是一个完全的编程新手
  • 当监视从 componentDidMount 调用的组件方法时,永远不会调用间谍

    在 React 组件中我有 export default class MyComp extends Component componentDidMount this customFunc customFunc gt 当我尝试使用 Jest
  • 是否有一个 R 包可以处理 POSIX 对象并返回一周中的第 n 天?

    我编写了一个函数 当提供日期范围时 一周中特定日期的名称以及给定月份中该天的出现情况 例如 每个月的第二个星期五 将返回相应的日期 然而 它的速度不是很快 而且我并不 100 相信它的稳健性 R 中是否有一个包或一组函数可以对 POSIX
  • 服务器发送事件 停止 使用新参数启动

    请帮忙 我正在使用服务器发送事件根据数据库中存储的数据动态更新网站 我现在希望根据上一条消息中收到的数据将新参数 abc php lastID xxx 传递回 PHP 脚本 我明白我可以使用event close停止当前的 流 但我正在努力
  • 如何将离散值映射到seaborn中的热图?

    我正在尝试使用seaborn 在热图中绘制离散值 这是我试图绘制的列表 xa 5 4 4 4 13 4 4 1 9 4 3 9 1 4 4 1 7 1 5 3 7 1 9 4 3 9 5 4 2 1 4 1 9 4 3 9 4 8 1 7
  • 读取 JSON 文件时出现“参数列表太长”[重复]

    这个问题在这里已经有答案了 我有数千个 JSON 文件 我想将它们合并为一个文件 我正在使用下面的命令来执行此操作 jq s json gt result json 但我收到参数列表太长错误 可能是因为我尝试合并的文件数量 这个问题有什么解
  • ARC (Chrome) 上的 ANDROID_ID 与 Android 有何不同?

    在 Android 上 ANDROID ID 对于设备上的用户配置文件来说是常量 请参阅在这里讨论 ARC 上的情况似乎并非如此 但 ARC 非常新 希望这种情况能够改变 还值得注意的是 关于 ARC 的设备识别 Android 序列号在
  • 确定是否设置了对照片库的访问 - PHPhotoLibrary

    借助 iOS 8 中的新功能 如果您在应用程序中使用相机 它会请求访问相机的权限 然后当您尝试重新拍摄照片时 它会请求访问照片库的权限 下次启动应用程序时 我想检查相机和照片库是否有访问权限 对于相机 我通过以下方式检查 if AVCapt
  • Javascript GZIP 和 btoa 并用 C# 解压

    我正在开发一个应用程序 其中使用 pako gzip 压缩大型 JSON 数据 然后使用 btoa 函数将其设为 base64string 以便将数据发布到服务器 在我写的 JavaScript 中 var data JSON string
  • ff包写入错误

    我正在尝试使用 R 处理 1909x139352 数据集 由于我的计算机只有 2GB RAM 因此该数据集对于传统方法来说太大 500MB 所以我决定使用ff包裹 然而 我遇到了一些麻烦 功能read table ffdf无法读取第一个数据
  • 过去 X 小时内未使用的 Docker 修剪镜像

    有办法吗docker prune image如果在过去 X 小时内未使用图像或其中间层 是否要删除图像 目的是 假设构建已经创建了中间和最终映像 F1 后续构建可以使用中间映像 当后续构建正在运行时 如果我运行docker image pr
  • 在python中导入全局命名空间

    假设我有以下文件 a py glo var 0 def func global glo var glo var 5 print A d glo var b py from a import func print B d glo var 如果
  • 从视图列检索数据时如何避免 64k 限制?

    我知道 SSJS 版本 DbColumn 与原始 Formula 语言版本具有相同的 64k 限制 所以到目前为止我用过NotesView getColumnValues 相反 相信在这里我不会面临这样的限制 正如昨天的紧急支持电话告诉我的
  • 选项卡的关闭按钮不支持 vcl 样式

    我已经使用了本示例中提供的代码如何为 TPageControl 的 Ttabsheet 实现关闭按钮在页面控件的每个选项卡上绘制一个关闭按钮 我在代码中用样式服务替换了 ThemeServices 并且在应用样式时 关闭按钮不会显示 也不会