求教关于自定义组件的有关问题
求教关于自定义组件的问题
1.procedure TUrlLabel.MouseEnter(var Message: TMessage);
begin
Font.Color := HoverColor;
Font.Style := [fsUnderLine]; //我这里只有这一句加下划线的代码,为什么托一个我的控件进去,就出现了下划线?我只想在鼠标移动到位置时有下划线怎么处理?
Cursor :=crHandPoint;
end;
2.procedure TUrlLabel.SetHoverColor(const Value: TColor);
begin
FHoverColor := Value;//我在设计视图的对象树中调整了FHoverColor后,发现窗口的URLLabel控件的颜色也变了,运行程序后URLLabel的颜色也成FHoverColor了,这是怎么回事?我应该怎么改呢?只想让它在鼠标移到控件上时改变颜色。
end;
------解决方案--------------------
if not (csDesigning in ComponentState) then
...
- Delphi(Pascal) code
unit UrlLabel; interface uses SysUtils, Classes, Controls, StdCtrls,Graphics,ShellAPI,Windows,Messages; type TUrlKind = (Html,Email,Ftp); TUrlLabel = class(TLabel) private FLinkUrl: string; FUrlKind: TUrlKind; FHoverColor: TColor; procedure SetLinkUrl(const Value: string); procedure SetUrlKind(const Value: TUrlKind); procedure SetHoverColor(const Value: TColor); { Private declarations } protected procedure Click;override; procedure MouseEnter(var Message: TMessage); message CM_MOUSEENTER; procedure MouseLeave(var Message: TMessage); message CM_MOUSELEAVE; public constructor Create(AOwner:TComponent);override; published property LinkUrl:string read FLinkUrl write SetLinkUrl; property UrlKind:TUrlKind read FUrlKind write SetUrlKind default Html; property HoverColor:TColor read FHoverColor write SetHoverColor default clred; end; procedure Register; implementation procedure Register; begin RegisterComponents('ttt', [TUrlLabel]); end; constructor TUrlLabel.Create(AOwner:TComponent); begin inherited; Font.Color := clblue; end; procedure TUrlLabel.Click; var head:string; begin inherited; // end; procedure TUrlLabel.MouseEnter(var Message: TMessage); begin Font.Color := HoverColor; Font.Style := [fsUnderLine]; Cursor :=crHandPoint; end; procedure TUrlLabel.MouseLeave(var Message: TMessage); begin Font.Color := clblue; Font.Style := Font.Style - [fsUnderLine]; Cursor :=crDefault; end; procedure TUrlLabel.SetLinkUrl(const Value: string); begin FLinkUrl := Value; end; procedure TUrlLabel.SetUrlKind(const Value: TUrlKind); begin if Value = Html then LinkUrl := 'Http://' else if Value = Email then LinkUrl := 'MailTo:' else if Value = Ftp then LinkUrl := 'Ftp://'; FUrlKind := Value; end; procedure TUrlLabel.SetHoverColor(const Value: TColor); begin FHoverColor := Value; end; end.
1.procedure TUrlLabel.MouseEnter(var Message: TMessage);
begin
Font.Color := HoverColor;
Font.Style := [fsUnderLine]; //我这里只有这一句加下划线的代码,为什么托一个我的控件进去,就出现了下划线?我只想在鼠标移动到位置时有下划线怎么处理?
Cursor :=crHandPoint;
end;
2.procedure TUrlLabel.SetHoverColor(const Value: TColor);
begin
FHoverColor := Value;//我在设计视图的对象树中调整了FHoverColor后,发现窗口的URLLabel控件的颜色也变了,运行程序后URLLabel的颜色也成FHoverColor了,这是怎么回事?我应该怎么改呢?只想让它在鼠标移到控件上时改变颜色。
end;
------解决方案--------------------
if not (csDesigning in ComponentState) then
...