读书人

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

发布时间: 2012-04-19 14:36:43 作者: rapoo

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

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
...

读书人网 >.NET

热点推荐