摘抄
28. 再谈Leave事件
unit ZeroLinkLabelUnit;
//Zero Studio Delphi Link Label Component
//panying@sina.com
//Version 1.1
{
Unit ZeroLinkLabelUnit
A label when click will lead to an url CopyRight 2001, Zero Studio
Web Site:http://zeroworld.533.net
or http://zeroworld.yes8.com
Version 1.1
New Feature:
When mouse move on label,the label will add underline.
Version 1.0
Initial Version
Attention:
This software is provided 'as-is', without any express or implied warranty. In no event will the author be held liable for any damages arising from the use of this software.
This unit is free to use but the origin of this software must not be misrepresented, you must not claim that you wrote the original software.
Feel free to use this component in your product including commercial applications.
If You alert this component's code to make it better, please remember to tell me about it , let's to make it better together.
This attention may not be removed or altered from any source distribution.
}
interface
uses Stdctrls,Classes,Controls,Forms,Windows,Graphics,ShellAPI,Messages;
type
TZeroLinkLabel=class(TLabel)
private
fUrl: string;
procedure LinkTo;
procedure ZeroMouseLeave(var Msg:TMessage);message CM_MOUSELEAVE;
procedure ZeroMouseEnter(var Msg:TMessage);message CM_MOUSEENTER;
procedure SetUrl(const Value: string);
protected
procedure Click;override;
published
property Url:string read fUrl write SetUrl;
public
constructor Create(AOwner: TComponent);override;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TZeroLinkLabel]);
end;
{ TZeroLinkLabel }
procedure TZeroLinkLabel.Click;
begin
if not (csDesigning in ComponentState)and (fUrl <>'') then LinkTo;
inherited Click;
end;
constructor TZeroLinkLabel.Create(AOwner: TComponent);
begin
inherited;
//set default font
Font.Color:=clBlue;
//set default cursor
Cursor:=crHandPoint;
end;
procedure TZeroLinkLabel.LinkTo;
begin
ShellExecute(Application.handle,'open',pchar(fUrl),nil,nil,SW_SHOWNORMAL);
end;
procedure TZeroLinkLabel.SetUrl(const Value: string);
begin
fUrl:=Value;
end;
procedure TZeroLinkLabel.ZeroMouseEnter(var Msg: TMessage);
begin
Font.Style:=Font.Style+[fsUnderLine];
end;
procedure TZeroLinkLabel.ZeroMouseLeave(var Msg: TMessage);
begin
Font.Style:=Font.Style-[fsUnderLine];
end;
end.
