⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 labelbutton.pas

📁 机房管理系统 是用VB设计的简单的管理系统
💻 PAS
字号:
unit LabelButton;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, StdCtrls, Graphics;

type
  TLabelBtn = class(TLabel)
  private
    { Private declarations }
    FUnableFontColor:TColor;
    FTranFontColor:TColor;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  protected
    { Protected declarations }
    procedure SetTranFontColor(value: TColor);
    procedure SetUnableFontColor(value: TColor);
  public
    { Public declarations }
    destructor Destroy; override;
    constructor Create(aOwner: TComponent); override;
  published
    { Published declarations }
    property Action;
    property TranFontColor:TColor read FTranFontColor write SetTranFontColor default clBlue;
    property UnableFontColor:TColor read FUnableFontColor write SetUnableFontColor default clGray;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Wuqiu', [TLabelBtn]);
end;

procedure TLabelBtn.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  if self.Enabled then
    Font.Color :=clWindowText
  else
    Font.Color :=FUnableFontColor;
end;

procedure TLabelBtn.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if self.Enabled  then
  begin
    Font.Color:=FTranFontColor;
    Font.Style :=[fsUnderline];
  end;
end;

procedure TLabelBtn.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  if Enabled  then
  begin
    Font.Color :=clWindowText;
    Font.Style :=[];
  end;
end;

constructor TLabelBtn.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  Transparent :=true;
  Cursor:=crHandPoint;
  FUnableFontColor:=clGray;
  FTranFontColor:=clBlue;
end;

destructor TLabelBtn.Destroy;
begin
  inherited Destroy;
end;

procedure TLabelBtn.SetTranFontColor(value: TColor);
begin
  if FTranFontColor<>value then
    FTranFontColor:=value;
end;

procedure TLabelBtn.SetUnableFontColor(value: TColor);
begin
  if FUnableFontColor<>value then
    FUnableFontColor:=value;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -