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

delphiaccess 2012-04-11 08:30:44
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;

...全文
48 1 打赏 收藏 转发到动态 举报
写回复
用AI写文章
1 条回复
切换为时间正序
请发表友善的回复…
发表回复
s11ss 2012-04-11
  • 打赏
  • 举报
回复
if not (csDesigning in ComponentState) then
...

5,388

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧