最简单但又是最方便的超级链接Label控件：TSysLink

大家常常需要一种简单的Label控件，可以支持超级链接，也就是说支持类似的Caption设置：

Welcome to visit my home page, click <a href="http://kingron.g4soft.net/bbs/" id="web"> here</a> to visit. Click <a id="config">Change config</a> to Change configuration

Windows中实际上已经支持类似的控件，在Windows系统中，其控件类型为SysLink，我们用下面的代码可以创建并显示一个SysLink控件：

function CreateSysLink(hDlg: HWND; hInst: THandle; rect: TRECT): HWND;

begin

   Result := CreateWindowEx(WS_EX_TRANSPARENT, WC_LINK,

       'For more information, <A HREF="http://www.microsoft.com">click here</A> ' +

       'or <A ID="idInfo">here</A>.',

       WS_VISIBLE or WS_CHILD or WS_TABSTOP,

       rect.left, rect.top, rect.right, rect.bottom,

       hDlg, 0, hInst, nil);

end;

procedure TForm1.FormCreate(Sender: TObject);

var

 w : HWND;

begin

 w := CreateSysLink(Handle, HInstance, Rect(10, 50, 200, 40));

end;

但是这个使用起来太麻烦了，而且我们无法检测到URL的点击事件，分辨点击的是什么东东！最好的解决方式是做成一个控件，这样就好了：

// Delphi 2007下测试通过

unit SysLink;

interface

uses

 Windows, SysUtils, Classes, Controls, StdCtrls, CommCtrl, Messages;

type

 TOnClickLink = procedure(Sender: TObject; const AIndex: Integer; const AID, AURL: string) of object;

 TSysLink = class(TStaticText)

 private

   FOnClickLink: TOnClickLink;

   procedure SetOnClickLink(const Value: TOnClickLink);

 protected

   procedure CreateParams(var Params: TCreateParams); override;

   procedure CNNotify(var Msg: TMessage); message CN_NOTIFY;

 public

 published

   property OnClickLink: TOnClickLink read FOnClickLink write SetOnClickLink;

 end;

procedure Register;

implementation

procedure Register;

begin

 RegisterComponents('Win32', [TSysLink]);

end;

{ TCustomSysLink }

procedure TSysLink.CNNotify(var Msg: TMessage);

var

 plink : PNMLink;

begin

 case TWMNotify(Msg).NMHdr.code of

   NM_CLICK, NM_RETURN:

     begin

       plink := PNMLINK(TMessage(Msg).LParam);

       if Assigned(FOnClickLink) then

       begin

         FOnClickLink(Self,

                      plink.item.iLink,

                      WideCharToString(plink.item.szID),

                      WideCharToString(plink.item.szUrl));

       end;

       inherited;

     end;

 else

   inherited;

 end;

end;

procedure TSysLink.CreateParams(var Params: TCreateParams);

begin

 inherited;

 CreateSubClass(Params, WC_LINK);

end;

procedure TSysLink.SetOnClickLink(const Value: TOnClickLink);

begin

 FOnClickLink := Value;

end;

end.

// 使用Demo：<a id="test" href="http://kingron.com" color="red">Test</a> Help Test

procedure TForm1.syslnk1ClickLink(Sender: TObject; AID, AURL: string);

begin

 ShowMessage(AID);

 ShowMessage(AURL);

end;