发信人: sczp74()
整理人: teleme(2001-04-14 12:38:12), 站内信件
|
小弟是DELPHI初学者，解决精华区中MYSPEEDBUTTON组件在切换图片时闪烁问题同时增加了CAPTION字体颜色的切换功能。
原码如下：
unit MySpeedButton;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Buttons;
type
TMySpeedButton = class(TSpeedButton)
private
{ Private declarations }
FFColorIn: TColor;
FFColorOut: TColor;
FEnterImage:TBitmap;
FLeaveImage:TBitmap;
procedure SetFontColorIn(Value: TColor);
procedure SetFontColorOut(Value: TColor);
procedure cmmouseenter(var msg:tmessage);message CM_MOUSEENTER;
procedure cmmouseleave(var msg:tmessage);message CM_MOUSELEAVE;
Function GetEnterBitmap:TBitmap;
procedure SetEnterBitmap(value:TBitmap);
Function GetLeaveBitmap:TBitmap;
procedure SetLeaveBitmap(value:TBitmap);
protected
{ Protected declarations }
public
{ Public declarations }
Constructor Create(AOwner:TComponent);override;
destructor Destroy;override;
published
property EnterImage:TBitmap read GetEnterBitmap write SetEnterBitmap;
property LeaveImage:TBitmap read GetLeaveBitmap write SetLeaveBitmap;
property FontColorIn: TColor read FFColorIn write SetFontColorIn;
property FontColorOut: TColor read FFColorOut write SetFontColorOut;
{ Published declarations }
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('ActiveX', [TMySpeedButton]);
end;
{ TMySpeedButton }
procedure TMySpeedButton.cmmouseenter(var msg: tmessage);
begin
Font.Color := FFColorIn;
if Glyph<>FEnterImage then Glyph:=FEnterImage;
inherited;
end;
procedure TMySpeedButton.cmmouseleave(var msg: tmessage);
begin
Font.Color := FFColorOut;//改变CAPTION的颜色
if Glyph<>FLeaveImage then Glyph:=FLeaveImage;
inherited;
end;
constructor TMySpeedButton.Create(AOwner: TComponent);
begin
inherited;
FEnterImage:=TBitmap.Create;
FLeaveImage:=TBitmap.Create;
end;
destructor TMySpeedButton.Destroy;
begin
FEnterImage.Free;
FLeaveImage.Free;
inherited;
end;
function TMySpeedButton.GetEnterBitmap: TBitmap;
begin
Result:=FEnterImage;
end;
function TMySpeedButton.GetLeaveBitmap: TBitmap;
begin
Result:=FLeaveImage;
end;
procedure TMySpeedButton.SetEnterBitmap(value: TBitmap);
begin
FEnterImage.Assign(value);
end;
procedure TMySpeedButton.SetLeaveBitmap(value: TBitmap);
begin
FLeaveImage.Assign(value);
end;
procedure TMySpeedButton.SetFontColorIn(Value: TColor);
begin
FFColorIn:=Value;//取得MOUSE移入的颜色
end;
procedure TMySpeedButton.SetFontColorOut(Value: TColor);
begin
FFColorOut:=Value;//取得MOUSE移出的颜色
end;
end.
|
|