Delphi控件，我们也可以(4)
添加时间: 2006-2-28 8:29:39 作者: Delphi教程 阅读次数:173 来源: http://www.d9soft.com
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); override;
destructor Destroy; override;
published
{ Published declarations }
property Color;
property ParentColor;
property ParentFont;
property TouchColor : TColor Read GetTouchColor Write SetTouchColor
stored isStoreTouchColor 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', [TTouchLable]);
end;
{ TTouchLable }
constructor TTouchLable.Create(AOwner: TComponent);
begin
inherited;
FTempColor := clWindow;
FTempFont := TFont.Create;
FTouchFont := TFont.Create;
isStoreTouchFont := True;
end;
destructor TTouchLable.Destroy;
begin
FTempFont.Free;
FTouchFont.Free;
inherited;
end;
function TTouchLable.GetTouchColor: TColor;
begin
Result := FTouchColor;
end;
function TTouchLable.isStoreTouchColor: Boolean;
begin
Result := (FColor <> FTouchColor);
end;
procedure TTouchLable.MouseEnter(AControl: TControl);
begin
inherited;
if not ChangeWhileTouch then exit;
if FColor <> FTouchColor then
begin
FTempColor := Color;
Color := TouchColor;
end;
FTempFont.Assign(Font);
Font.Assign(TouchFont);
end;
procedure TTouchLable.MouseLeave(AControl: TControl);
begin
inherited;
if not ChangeWhileTouch then exit;
if FColor <> FTouchColor then
Color := FTempColor;
Font.Assign(FTempFont);
end;
procedure TTouchLable.SetTouchColor(AColor: TColor);
begin
FTouchColor := AColor;
end;
procedure TTouchLable.SetTouchFont(AFont: TFont);
begin
FTouchFont.Assign(AFont);
isStoreTouchFont := True;
end;
end.
上下文章:
上一篇文章: 用Delphi实现打印功能 下一篇文章: Delphi控件，我们也可以(3)
相关文章:
相关软件: