| 下面是我的代码： 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控件，我们也可以(4)Delphi控件，我们也可以(4)
2004-02-14 09:34
出处：PConline
责任编辑：zwg
