使用这个组件可以同时完成网址和邮件连接<br><br><br>{***********************************************************************<br>* TKURL version 2.0 *<br>* *<br>* Copyright ?1997, 1998 - All Rights Reserved. *<br>* Developed By: Karlos Jorge Pinto *<br>* E-MAIL: Karlospinto@hotmail.com *<br>* Visit: o---> Delphi@pt <---o in: *<br>* http://www.terravista.pt/bilene/1412 ---> In English/Portuguese *<br>************************************************************************<br>* Changed By: Eduardo Oliveros D韆z *<br>* E-MAIL: oliveros@redestb.es *<br>* ThanX to Ahto (http://www.moonsoftware.ee) *<br>************************************************************************<br>* This component is FREEWARE. *But* is Unregistered. If you like *<br>* To have a registered copy of this component please read the *<br>* Register.wri, for more details. Build n? 3/98 *<br>***********************************************************************}<br><br>Unit KURL2;<br><br>interface<br><br>uses<br> Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,<br> Dialogs, ShellApi, stdctrls;<br><br>type<br> LinkType = (ltURL,ltEMAIL);<br> TKURL2 = class(TWinControl)<br> private<br> { Private declarations }<br> FLabel: TLabel;<br> FURL: string;<br> FLink: LinkType;<br><br> function GetURL: string;<br> procedure SetURL(s: string);<br> function GetShowHint: Boolean;<br> procedure SetShowHint(B: Boolean);<br> protected<br> { Protected declarations }<br> public<br> { Public declarations }<br> constructor Create( AOwner: TComponent ); override;<br> destructor Destroy; override;<br> procedure Click(Sender : TObject);<br> published<br> { Published declarations }<br> property URLorEMAIL: string read GetURL write SetURL;<br> property ShowHint: Boolean read GetShowHint write SetShowHint default True;<br> property Choose: LinkType read FLink write FLink default ltURL;<br> end;<br><br>procedure Register;<br><br>implementation<br><br>procedure Register;<br>begin<br> RegisterComponents('Delphi@pt', [TKURL2]);<br>end;<br><br>constructor TKURL2.Create( AOwner: TComponent );<br>begin<br> inherited Create(AOwner);<br><br> Height := 13;<br> Cursor := crHandPoint;<br> Hint := 'Put here the Hint for your site link!';<br><br> FLabel := TLabel.Create(self);<br> FLabel.Visible := true;<br> FLabel.Font.Color := clBlue;<br> FLabel.Font.Style := [fsUnderline];<br> FLabel.OnClick := Click;<br> FLabel.Parent := Self;<br> FLabel.Caption := 'http://www.Url_Or_E-Mail.com';<br> FLabel.ShowHint := True;<br> Width := FLabel.Width;<br>end;<br><br>destructor TKURL2.Destroy;<br>begin<br> FLabel.Free;<br> inherited Destroy;<br>end;<br><br>procedure TKURL2.Click(Sender : TObject);<br>begin<br> If Flink=ltUrl then<br> ShellExecute(Handle , 'open', PChar(FLabel.Caption), nil, nil, SW_MAXIMIZE)<br> else<br> ShellExecute(Handle , 'open', PChar('mailto:'+Flabel.Caption), nil, nil, SW_MAXIMIZE);<br>end;<br><br>function TKURL2.GetURL: string;<br>begin<br> result := FLabel.Caption;<br>end;<br><br>procedure TKURL2.SetURL(s : String);<br>begin<br> FLabel.Caption := s;<br> Width := FLabel.Width;<br>end;<br><br>function TKURL2.GetShowHint : Boolean;<br>begin<br> result:=FLabel.ShowHint;<br>end;<br><br>procedure TKURL2.SetShowHint(B : Boolean);<br>begin<br> FLabel.ShowHint:=b;<br>end;<br><br>end.<br>