繁體中文当前位置: 首页 > 图文教程 > 开发语言 > Delphi > Delphi控件，我们也可以(4)
Delphi控件，我们也可以(4)
出处:互联网 整理: 软晨网（RuanChen.com） 发布: 2009-10-30 浏览: 99 ::
收藏到网摘: n/a
下面是我的代码：
unit LxTouchLabel;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, StdCtrls, Graphics;
type
TTouchLabel = class(TLabel)
private
{ Private declarations }
FColor : TColor;
FTouchColor : TColor;
FTempColor : TColor;
FTouchFont : TFont;
FTempFont : TFont;
isStoreTouchFont : Boolean;
function GetTouchBKColor : TColor;
function isStoreTouchBKColor : Boolean;
procedure SetTouchBKColor(AColor : TColor);
procedure SetTouchFont(AFont : TFont);
procedure CMMouseEnter(var Message : TMessage); Message CM_MOUSEENTER;
procedure CMMouseLeave(var Message : TMessage); Message CM_MOUSELEAVE;
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
property Color;
property ParentColor;
property ParentFont;
property TouchBKColor : TColor Read GetTouchBKColor Write SetTouchBKColor
stored isStoreTouchBKColor default clWindow;
property TouchFont : TFont Read FTouchFont Write SetTouchFont
stored isStoreTouchFont;
property ChangeWhileTouch : Boolean Read isStoreTouchFont
Write isStoreTouchFont default True;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('LX', [TTouchLabel]);
end;
{ TTouchLabel }
constructor TTouchLabel.Create(AOwner: TComponent);
begin
inherited;
FTempColor := clWindow;
FTempFont := TFont.Create;
FTouchFont := TFont.Create;
isStoreTouchFont := True;
end;
destructor TTouchLabel.Destroy;
begin
FTempFont.Free;
FTouchFont.Free;
inherited;
end;
function TTouchLabel.GetTouchBKColor: TColor;
begin
Result := FTouchColor;
end;
procedure TTouchLabel.SetTouchFont(AFont: TFont);
begin
FTouchFont.Assign(AFont);
isStoreTouchFont := True;
end;
procedure TTouchLabel.CMMouseEnter(var Message: TMessage);
begin
inherited;
if not ChangeWhileTouch then exit;
if FColor <> FTouchColor then
begin
FTempColor := Color;
Color := TouchBKColor;
end;
FTempFont.Assign(Font);
Font.Assign(TouchFont);
end;
procedure TTouchLabel.CMMouseLeave(var Message: TMessage);
begin
inherited;
if not ChangeWhileTouch then exit;
if FColor <> FTouchColor then
Color := FTempColor;
Font.Assign(FTempFont);
end;
procedure TTouchLabel.SetTouchBKColor(AColor: TColor);
begin
FTouchColor := AColor;
end;
function TTouchLabel.isStoreTouchBKColor: Boolean;
begin
Result := (FColor <> FTouchColor);
end;
end.
///////////////////////////////////////////////////////////////////////
unit QLXTouchLable;
interface
uses
Windows, Messages, SysUtils, Classes, QControls, QStdCtrls, QGraphics;
type
TTouchLable = class(TLabel)
private
{ Private declarations }
FColor : TColor;
FTouchColor : TColor;
FTempColor : TColor;
FTouchFont : TFont;
FTempFont : TFont;
isStoreTouchFont : Boolean;
function GetTouchColor : TColor;
function isStoreTouchColor : Boolean;
procedure SetTouchColor(AColor : TColor);
procedure SetTouchFont(AFont : TFont);
procedure MouseEnter(AControl: TControl); override;
procedure MouseLeave(AControl: TControl); override;
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); overri
评论 (0) All
