求教关于自定义组件的有关问题

求教关于自定义组件的问题

Delphi(Pascal) code

unit UrlLabel;interfaceuses  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;implementationprocedure 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
...

查看更多 下一篇