📄 自制thyperlink组件.htm
字号:
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>Welcome to Delphi Tips !</title>
<meta name="GENERATOR" content="Microsoft FrontPage 3.0">
<link rel="stylesheet" href="../tips.css"></head>
<body bgcolor="#D8D0C8" text="#675350">
<div align="left">
<table border="1" cellpadding="0" cellspacing="0" width="579" height="63" bordercolorlight="#784400" bordercolordark="#D8D0C8">
<tr>
<td width="194" height="86"><img src="../images/title.gif" width="340" height="85"></td>
<td width="377" height="86" valign="top"><img src="../images/dong.jpg" width="251" height="85">
</td>
</tr>
</table>
<br>
</div>
<div align="left">
<table border="1" cellpadding="0" cellspacing="0" width="578" height="18" bordercolorlight="#784400" bordercolordark="#CCCCCC" class="p2">
<tr bgcolor="#B0A498">
<td width="574" height="18"> ><a href="../index.htm">DelphiTips首页</a>
> <a href="main.htm">控件应用</a></td>
</tr>
</table>
<br>
<table width="96%" border="1" bordercolorlight="#784400" cellspacing="0" bordercolordark="#D8D0C8">
<tr bgcolor="#B0A498" class="p1">
<td colspan="3">
<div align="center">自制THyperLink组件</div>
</td>
<td width="12%" class="p2"><<<a href="main.htm">上一篇</a></td>
<td width="13%" class="p2"><a href="002.htm">下一篇</a>>></td>
</tr>
<tr class="p2">
<td colspan="5">
<table width="100%" border="0" class="p2">
<tr>
<td width="3%"> </td>
<td width="94%"><span style="font-size: 9pt"><font color="#ffffff">----</font>
很多软件在其About窗口或Help菜单中，可让用户通过单击一段文字就能方便地访问某个网页。比如，Delphi的Help中就有可直接访问该公司主页的菜单项。下面介绍的THyperLink组件是用Delphi3.0编制的，可方便地实现上述功能。
</span>
<p></p>
<p><span style="font-size: 9pt"><font color="#ffffff">----</font>
THyperLink是基于TCustomLabel组件的，它有以下特性： </span></p>
<p><span style="font-size: 9pt"><font color="#ffffff">----</font>
<b>属性：</b> </span></p>
<p><span style="font-size: 9pt"><font color="#ffffff">----</font>
普通Label组件的所有特性，考滤到实际用途只公布了Caption、Color、 Cursor、 Enabled、 Font、
Hint、 ShowHint、 Visible等属性，其中Font属性在构造函数中被初始化为蓝色带下划线字体，Cursor被置为手型鼠标。别外，增加了URL属性用于存贮网址。在组件内部接管了OnClick事件，用于实现用户单击后调用默认浏览器打开URL中指定的网页，处理各种错误，并将Font属性置为紫色。
</span></p>
<p><span style="font-size: 9pt"><font color="#ffffff">----</font>
<b>方法：</b> </span></p>
<pre><span style="font-size: 9pt">Function Browse(AURL: string): Integer;
{ AURL为网址或文件名。}</span></pre>
<p><span style="font-size: 9pt"><font color="#ffffff">----</font>
<b>事件：</b> </span></p>
<pre><span style="font-size: 9pt">OnClick; { 响应用户鼠标单击动作。 }</span></pre>
<p><span style="font-size: 9pt"><font color="#ffffff">----</font>
具体源码如下： </span></p>
<pre><span style="font-size: 9pt">{ THyperLink VCL, Version 1.0
This is freeware. If you make cool changes to it,
please send them to me(1234@5678.com).
}
unit HyperLink;
interface
uses
Windows, Messages, SysUtils, Classes,
Graphics, Controls, Forms, Dialogs,
ShellAPI, Stdctrls;
type
THyperLink = class(TCustomLabel)
private
FURL: string; // 存贮网址或文件名
FOwnerHandle: HWND;
protected
procedure DoOnClick(Sender: TObject);
// 处理用户单击鼠标
public
constructor Create(AOwner: TComponent); override;
Function Browse(AURL: string): Integer;
published
property Caption;
property Color;
property Cursor default crHandPoint;
property Enabled;
property Font stored True;
property Hint;
property ShowHint default True;
property URL: string read FURL write FURL;
property Visible;
property OnClick;
end;
procedure Register;
implementation
constructor THyperLink.Create(AOwner: TComponent);
begin
inherited Create(aOwner);
FOwnerHandle := (Owner as TForm).Handle;
OnClick := DoOnClick;
Cursor := crHandPoint;
ShowHint := True;
Font.Color := clBlue;
Font.Style := [fsUnderline];
Font.Size := 10;
end;
procedure THyperLink.DoOnClick(Sender: TObject);
begin
if (not (csDesigning in
ComponentState) and (FURL < >'')) then
begin
Browse(FURL);
// 调用相应程序打开URL中的网址、文件
Font.Color := clPurple;
end;
end;
Function THyperLink.Browse(AURL: string): Integer;
var
RtnValue: Integer;
begin
RtnValue := ShellExecute(FOwnerHandle, 'Open', PChar(AURL),
nil, nil, SW_SHOWNORMAL);
case RtnValue of // 处理各种错理
0: ShowMessage('The operating system is out of memory
or resources.');
ERROR_BAD_FORMAT: ShowMessage( 'The .EXE file is invalid
(non-Win32 .EXE or error in .EXE image');
SE_ERR_ACCESSDENIED: ShowMessage( 'The operating system
denied access to the specified file.');
SE_ERR_ASSOCINCOMPLETE: ShowMessage( 'The filename
association is incomplete or invalid.');
SE_ERR_DDEBUSY: ShowMessage( 'The DDE transaction
could not be completed because other DDE transactions
were being processed.');
SE_ERR_DDEFAIL: ShowMessage( 'The DDE transaction failed.');
SE_ERR_DDETIMEOUT: ShowMessage( 'The DDE transaction
could not be completed because the request timed out.');
SE_ERR_DLLNOTFOUND: ShowMessage( 'The specified
dynamic-link library was not found.');
SE_ERR_FNF: ShowMessage( 'The specified file was not found.');
SE_ERR_NOASSOC: ShowMessage( 'There is no application
associated with the given filename extension.');
SE_ERR_OOM: ShowMessage( 'There was not enough
memory to complete the operation.');
SE_ERR_PNF: ShowMessage( 'The specified path was not found.');
SE_ERR_SHARE: ShowMessage( 'A sharing violation occurred.');
else
if(RtnValue < =32) then ShowMessage( 'Unknown
Error in ShellExecte.');
end;
Result := RtnValue;
end;
procedure Register;
begin
RegisterComponents('Tools', [THyperLink]);
end;
end.</span></pre>
<p><span style="font-size: 9pt"><font color="#ffffff">----</font>
由于THyperLink内部使用ShellExcute函数来打开网页，而ShellExcute函数的特点是可调用与给定文件相关联的应用程来打开该文件，所以在属性URL中设置其它类型的文件（如E-mail地址、文本文件、图像文件，甚至是数据库文件），只要用户的计算机内有相应程序，ThyperLink就能打开该文件。不过E-mail地址应写成mailto:1234@5678.com这样的型式。以下是一简单的示例程序：
</span></p>
<pre><span style="font-size: 9pt">unit sample;
interface
uses
Windows, Messages, SysUtils, Classes,
Graphics, Controls, Forms, Dialogs,
Menus, StdCtrls, HyperLink;
type
TForm1 = class(TForm)
HyperLink1: THyperLink;
MainMenu1: TMainMenu;
Help1: TMenuItem;
BorlandHomePage1: TMenuItem;
procedure BorlandHomePage1Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.BorlandHomePage1Click(Sender: TObject);
begin
HyperLink1.Browse('http://www.borland.com');
end;
end.</span></pre>
<p><span style="font-size: 9pt"><font color="#ffffff">----</font>
因为ThyperLink组件的父类是TCustomLabel组件，所以它拥有TCustomLabel的全部属性、方法、事件，这就是说如果需要的话，你可直接使用它们。
</span>
</td>
<td width="3%"> </td>
</tr>
</table>
</td>
</tr>
<tr bgcolor="#B0A498" class="p2">
<td height="22" width="61%" colspan="2"> <marquee behavior="alternate">如果你有什么好的资料，可以寄给我哟:)</marquee></td>
<td height="22" width="14%"><a href="../index.htm"><<回到首页</a></td>
<td height="22" width="12%"><<<a href="main.htm">上一篇</a></td>
<td height="22" width="13%"><a href="002.htm">下一篇</a>>></td>
</tr>
</table>
<br>
<br>
<hr size=1 noshade width=500>
<table width="75%" border="0" align="center" class="p2">
<tr>
<td colspan="2"> </td>
<td width="24%">
<table width="95%" border="1" bordercolorlight="#663300" bordercolordark="#CCCCCC" cellspacing="0" class="p2">
<tr>
<td>
<div align="center">Delphi 技巧集</div>
</td>
</tr>
</table>
</td>
<td width="38%"> </td>
</tr>
<tr>
<td width="16%"> </td>
<td colspan="2">Copyright 1999.11 by 东子</td>
<td width="38%"><a href="../jintongbao@188.net">Mail to me!</a></td>
</tr>
<tr>
<td colspan="4">
<div align="center">感谢广州视窗提供主页空间</div>
</td>
</tr>
</table>
<br>
</div><div align="center"><center>
</center></div>
</body>
</html>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -