首页 > 其他分享 >直接在当前窗口使用控件新属性,如button添加颜色

直接在当前窗口使用控件新属性,如button添加颜色

时间:2024-10-16 14:35:13浏览次数:7  
标签:控件 begin end FCanvas Color button ARect 添加 TButton

https://www.cnblogs.com/zhangzhifeng/p/9072835.html

Delphi自写组件:可设置颜色的按钮

type
  TButton = class(vcl.stdctrls.TButton)
  private
    //添加Color属性,默认clWhite
    { Private declarations }
    FColor:TColor;
    FCanvas:TCanvas;
    IsFocused:Boolean;
    procedure SetColor(Value:Tcolor);
    procedure CNDrawItem(var Message:TWMDrawItem);message CN_DRAWITEM;
  protected
    { Protected declarations }
    procedure CreateParams(var Params:TCreateParams);override;
    procedure SetButtonStyle(ADefault:Boolean);override;
  public
    { Public declarations }
    constructor Create(AOwner:TComponent);override;
    destructor Destroy;override;
  published
    { Published declarations }
    property Color:TColor read FColor write SetColor default clWhite;
  end;
{ TButton }
//*********添加构造函数***************
constructor TButton.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  FCanvas:=TCanvas.Create;
  FColor:=clMoneyGreen; //设置默认颜色
end;
//*********添加析构函数***************
destructor TButton.Destroy;
begin
  FCanvas.Free;
  inherited Destroy;
end;
//****定义按钮样式,必须将该按钮重定义为自绘式按钮*****
procedure TButton.CreateParams(var Params:TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do Style:=Style or BS_OWNERDRAW;
end;
//****属性写方法*****
procedure TButton.SetColor(Value:TColor);
begin
  FColor:=Value;
  Invalidate;     //完全重画控件
end;
//****设置按钮状态*****
procedure TButton.SetButtonStyle(ADefault:Boolean);
begin
  if ADefault<>IsFocused then
  begin
    IsFocused:=ADefault;
    Refresh;
  end;
end;
//****绘制按钮*****
procedure TButton.CNDrawItem(var Message: TWMDrawItem);
var
  IsDown,IsDefault:Boolean;
  ARect:TRect;
  Flags:Longint;
  DrawItemStruct:TDrawItemStruct;
  wh:TSize;
begin
/////////////////////////////////////////
  DrawItemStruct:=Message.DrawItemStruct^;
  FCanvas.Handle := DrawItemStruct.hDC;
  ARect := ClientRect;
  with DrawItemStruct do
  begin
    IsDown := itemState and ODS_SELECTED <> 0;
    IsDefault := itemState and ODS_FOCUS <> 0;
  end;
  Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
  if IsDown then Flags := Flags or DFCS_PUSHED;
  if DrawItemStruct.itemState and ODS_DISABLED <> 0 then
     Flags := Flags or DFCS_INACTIVE;
  if IsFocused or IsDefault then
  begin
    //按钮得到焦点时的状态绘制
    FCanvas.Pen.Color := clWindowFrame;
    FCanvas.Pen.Width := 1;
    FCanvas.Brush.Style := bsClear;
    FCanvas.Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
    InflateRect(ARect, -1, -1);
  end;
  FCanvas.Pen.Color := clBtnShadow;
  FCanvas.Pen.Width := 1;
  FCanvas.Brush.Color := FColor;
  if IsDown then begin
    //按钮被按下时的状态绘制
     FCanvas.Rectangle(ARect.Left , ARect.Top, ARect.Right, ARect.Bottom);
     InflateRect(ARect, -1, -1);
  end else
     //绘制一个未按下的按钮
     DrawFrameControl(DrawItemStruct.hDC, ARect, DFC_BUTTON, Flags);
  FCanvas.FillRect(ARect);
  //绘制Caption文本内容
  FCanvas.Font := Self.Font;
  ARect:=ClientRect;
  wh:=FCanvas.TextExtent(Caption);
  FCanvas.Pen.Width := 1;
  FCanvas.Brush.Style := bsClear;
  if not Enabled then
  begin //按钮失效时应多绘一次Caption文本
     FCanvas.Font.Color := clBtnHighlight;
     FCanvas.TextOut((Width div 2)-(wh.cx div 2)+1,
                     (height div 2)-(wh.cy div 2)+1,
                      Caption);
     FCanvas.Font.Color := clBtnShadow;
  end;
  FCanvas.TextOut((Width div 2)-(wh.cx div 2),(height div 2)-(wh.cy div 2),Caption);
  //绘制得到焦点时的内框虚线
  if IsFocused and IsDefault then
  begin
     ARect := ClientRect;
     InflateRect(ARect, -4, -4);
     FCanvas.Pen.Color := clWindowFrame;
     FCanvas.Brush.Color := FColor;
     DrawFocusRect(FCanvas.Handle, ARect);
  end;
  FCanvas.Handle := 0;
end;

 

标签:控件,begin,end,FCanvas,Color,button,ARect,添加,TButton
From: https://www.cnblogs.com/tulater/p/18469887

相关文章

  • 第四十九章 添加滤镜能力
    添加滤镜后端做法由于需要实时预览滤镜效果,所以必须在渲染开始之前添加滤镜。好在WebRTC已经提供了VideoProcessor这个接口类,可以对采集到的帧数据进行预处理,调用VideoSource.setVideoProcessor(processor)即可设置:VideoSource.javapublicclassVideoSourceextends......
  • QT实现改变窗口大小其子控件也自动调节大小
    创建一个顶层布局即可,一定要在MainWindows或者Widget的下面! 观察图标变化带有禁止的意思是分拆布局(当前无布局)现在是添加布局后了 注意:一定是在MainWindows或Widget才可以添加顶层布局,才可以实现控件自适应现在我想实现的是文字跟随变化,效果图如下所以我们利用......
  • jumpserver堡垒机部署 添加资产主机和MySQL数据库,图解过程
    jumpserver堡垒机部署JumpServer是广受欢迎的开源堡垒机,是符合4A规范的专业运维安全审计系统。JumpServer帮助企业以更安全的方式管控和登录所有类型的资产,实现事前授权、事中监察、事后审计,满足等保合规要求。下载软件包JumpServer-开源堡垒机-官网#官方网址......
  • 本地部署ComfyUI并添加强大的Flux.1开源文生图模型远程制作AI图片
    文章目录前言1.本地部署ComfyUI2.下载Flux.1模型3.下载CLIP模型4.下载VAE模型5.演示文生图6.公网使用Flux.1大模型6.1创建远程连接公网地址7.固定远程访问公网地址前言本文将详细介绍如何在本地部署ComfyUI并搭建Flux.1文生图神器,......
  • 宝塔面板添加网站
    宝塔面板是一款非常流行的服务器管理软件,它可以帮助用户方便地管理服务器上的网站、数据库、域名等资源。要在宝塔面板上添加一个新的网站,你可以按照以下步骤操作:登录宝塔面板:打开浏览器,输入宝塔面板的IP地址加上端口号(默认为8888)。输入用户名和密码登录。进入网站管理......
  • WPF中Resx文件中添加Byte[]
    参考:https://learn.microsoft.com/zh-tw/dotnet/api/system.resources.resxresourcewriter.generate?view=windowsdesktop-8.0&viewFallbackFrom=netcore-3.1代码实现:staticvoidMain(string[]args){using(ResXResourceWriterresWriter=newResXResourceWr......
  • 【油猴脚本】00027 案例 Tampermonkey油猴脚本, 仅用于学习,不要乱搞。添加标题为网页数
    前言:哈喽,大家好,今天给大家分享一篇文章!并提供具体代码帮助大家深入理解,彻底掌握!创作不易,如果能帮助到大家或者给大家一些灵感和启发,欢迎收藏+关注哦......
  • 【QT】常用控件(一)
    个人主页~常用控件一、控件是什么二、QWidget核心属性1、enabled2、geometry3、windowTitle4、windowIcon5、windowOpacity6、cursor7、font8、toolTip9、focusPolicy10、styleSheet一、控件是什么ui设计界面左边的这些都叫控件,除了这些以外,QT还允许自定义控件,满......
  • 【Azure Cloud Service】使用Key Vault Secret添加.CER证书到Cloud Service Extended
    问题描述因为KeyVault的证书上传功能中,只支持pfx格式的证书,而中间证书,根证书不能转换为pfx格式,只能是公钥证书格式cet或者crt,能通过文本工具直接查看base64编码内容。如一个证书链文件中可以看见中间证书,根证书: 当把包含完成证书链的证书PFX上传到KeyVaultcertificate......
  • Elementui树形列表控件tree-box
    效果图(在vue2项目开发中,实现了树形列表查看及筛选等交互,用清晰的层级结构展示信息) 开发步骤及代码,来喽!!无脑copy1、组件基本框架  DeviceTree 是基于 Vue.js 和 ElementUI 构建的树形组件。通过 el-tree 组件显示树状结构。组件的外部可通过传递 props 来控制......