如何建一个指向Email的链接(100分)

  • 主题发起人 主题发起人 let
  • 开始时间 开始时间
L

let

Unregistered / Unconfirmed
GUEST, unregistred user!
如何在窗体上建一个指向Email的链接,像平常软件中所见到的一样
 
mailto://someone@somecompany.com
 
mailto:url....
 
可以使用第三方 TKURL 组件 &nbsp;<br><br>
 
uses ShellAPI, ......<br><br>ShellExecute(FormHandle,'OPEN',PChar('MailTo:'+EmailAdress),nul,nil,SW_SHOW); <br>
 
使用这个组件可以同时完成网址和邮件连接<br><br><br>{***********************************************************************<br>* &nbsp;TKURL version 2.0 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; *<br>* &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;*<br>* &nbsp; &nbsp;Copyright ?1997, 1998 - All Rights Reserved. &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; *<br>* &nbsp; &nbsp;Developed By: Karlos Jorge Pinto &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;*<br>* &nbsp; &nbsp;E-MAIL: Karlospinto@hotmail.com &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; *<br>* &nbsp; &nbsp;Visit: o---&gt; Delphi@pt &lt;---o in: &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;*<br>* &nbsp; &nbsp;http://www.terravista.pt/bilene/1412 ---&gt; In English/Portuguese &nbsp; *<br>************************************************************************<br>* &nbsp; &nbsp;Changed By: Eduardo Oliveros D韆z &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; *<br>* &nbsp; &nbsp;E-MAIL: oliveros@redestb.es &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; *<br>* &nbsp; &nbsp;ThanX to Ahto (http://www.moonsoftware.ee) &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;*<br>************************************************************************<br>* &nbsp;This component is FREEWARE. *But* is Unregistered. If you like &nbsp; &nbsp; &nbsp;*<br>* &nbsp;To have a registered copy of this component please read the &nbsp; &nbsp; &nbsp; &nbsp; *<br>* &nbsp;Register.wri, for more details. &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;Build n? &nbsp;3/98 &nbsp;*<br>***********************************************************************}<br><br>Unit KURL2;<br><br>interface<br><br>uses<br>&nbsp; Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,<br>&nbsp; Dialogs, ShellApi, stdctrls;<br><br>type<br>&nbsp; LinkType = (ltURL,ltEMAIL);<br>&nbsp; TKURL2 = class(TWinControl)<br>&nbsp; private<br>&nbsp; &nbsp; { Private declarations }<br>&nbsp; &nbsp; FLabel: TLabel;<br>&nbsp; &nbsp; FURL: string;<br>&nbsp; &nbsp; FLink: LinkType;<br><br>&nbsp; &nbsp; function &nbsp;GetURL: string;<br>&nbsp; &nbsp; procedure SetURL(s: string);<br>&nbsp; &nbsp; function &nbsp;GetShowHint: Boolean;<br>&nbsp; &nbsp; procedure SetShowHint(B: Boolean);<br>&nbsp; protected<br>&nbsp; &nbsp; { Protected declarations }<br>&nbsp; public<br>&nbsp; &nbsp; { Public declarations }<br>&nbsp; &nbsp; constructor Create( AOwner: TComponent ); override;<br>&nbsp; &nbsp; destructor Destroy; override;<br>&nbsp; &nbsp; procedure Click(Sender : TObject);<br>&nbsp; published<br>&nbsp; &nbsp; { Published declarations }<br>&nbsp; &nbsp; property URLorEMAIL: string read GetURL write SetURL;<br>&nbsp; &nbsp; property ShowHint: Boolean read GetShowHint write SetShowHint default True;<br>&nbsp; &nbsp; property Choose: LinkType read FLink write FLink default ltURL;<br>&nbsp; end;<br><br>procedure Register;<br><br>implementation<br><br>procedure Register;<br>begin<br>&nbsp; RegisterComponents('Delphi@pt', [TKURL2]);<br>end;<br><br>constructor TKURL2.Create( AOwner: TComponent );<br>begin<br>&nbsp; inherited Create(AOwner);<br><br>&nbsp; Height := 13;<br>&nbsp; Cursor := crHandPoint;<br>&nbsp; Hint := 'Put here the Hint for your site link!';<br><br>&nbsp; FLabel := TLabel.Create(self);<br>&nbsp; FLabel.Visible := true;<br>&nbsp; FLabel.Font.Color := clBlue;<br>&nbsp; FLabel.Font.Style := [fsUnderline];<br>&nbsp; FLabel.OnClick := Click;<br>&nbsp; FLabel.Parent := Self;<br>&nbsp; FLabel.Caption := 'http://www.Url_Or_E-Mail.com';<br>&nbsp; FLabel.ShowHint := True;<br>&nbsp; Width := FLabel.Width;<br>end;<br><br>destructor TKURL2.Destroy;<br>begin<br>&nbsp; FLabel.Free;<br>&nbsp; inherited Destroy;<br>end;<br><br>procedure TKURL2.Click(Sender : TObject);<br>begin<br>&nbsp; If Flink=ltUrl then<br>&nbsp; ShellExecute(Handle , 'open', PChar(FLabel.Caption), nil, nil, SW_MAXIMIZE)<br>&nbsp; else<br>&nbsp; ShellExecute(Handle , 'open', PChar('mailto:'+Flabel.Caption), nil, nil, SW_MAXIMIZE);<br>end;<br><br>function TKURL2.GetURL: string;<br>begin<br>&nbsp; result := FLabel.Caption;<br>end;<br><br>procedure TKURL2.SetURL(s : String);<br>begin<br>&nbsp; FLabel.Caption := s;<br>&nbsp; Width := FLabel.Width;<br>end;<br><br>function TKURL2.GetShowHint : Boolean;<br>begin<br>&nbsp; result:=FLabel.ShowHint;<br>end;<br><br>procedure TKURL2.SetShowHint(B : Boolean);<br>begin<br>&nbsp; FLabel.ShowHint:=b;<br>end;<br><br>end.<br>
 
偶的:<br>uses<br>ShellApi;<br>begin<br>shellExecute(GetDesktopWindow,'Open','mailto:zeda@netease.com',<br>nil,nil,SW_ShowNormal);<br>end;
 
通过调用API函数ShellExecute,可以实现超链接
 
多人接受答案了。
 
后退
顶部