📄 062801_05.htm

📁 对于学习很有帮助
💻 HTM
字号:
<html>

<head>
<link REL="stylesheet" HREF="/style.css" TYPE="text/css">
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>计算机世界日报:
自制THyperLink组件
</title>
<!--***********-->
</head>

<body bgcolor="#FFFFFF" >














<p><br>
<font color="#b904e8"><b><em><a href="class.htm">返回</a></em></b></font>
<center>
<font color="#0000c0"><h2>
自制THyperLink组件
</h2></font>
<h3>
成都市八二信箱
<br>王乐
</h3>
</center>
<p><font color="#ffffff">----</font>

很多软件在其About窗口或Help菜单中，可让用户通过单击一段文字就能方便地访问某个网页。比如，Delphi的Help中就有可直接访问该公司主页的菜单项。下面介绍的THyperLink组件是用Delphi3.0编制的，可方便地实现上述功能。
<p><font color="#ffffff">----</font>
THyperLink是基于TCustomLabel组件的，它有以下特性：
<p><font color="#ffffff">----</font>
<b>属性：</b>
<p><font color="#ffffff">----</font>
普通Label组件的所有特性，考滤到实际用途只公布了Caption、Color、 Cursor、 Enabled、 Font、 Hint、 ShowHint、 Visible等属性，其中Font属性在构造函数中被初始化为蓝色带下划线字体，Cursor被置为手型鼠标。别外，增加了URL属性用于存贮网址。在组件内部接管了OnClick事件，用于实现用户单击后调用默认浏览器打开URL中指定的网页，处理各种错误，并将Font属性置为紫色。
<p><font color="#ffffff">----</font>
<b>方法：</b>
<pre>
Function  Browse(AURL: string): Integer; 
{ AURL为网址或文件名。}
</pre>
<p><font color="#ffffff">----</font>
<b>事件：</b>
<pre>
OnClick;  { 响应用户鼠标单击动作。 }
</pre>
<p><font color="#ffffff">----</font>
具体源码如下：
<pre>
{ 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.
</pre>
<p><font color="#ffffff">----</font>
由于THyperLink内部使用ShellExcute函数来打开网页，而ShellExcute函数的特点是可调用与给定文件相关联的应用程来打开该文件，所以在属性URL中设置其它类型的文件（如E-mail地址、文本文件、图像文件，甚至是数据库文件），只要用户的计算机内有相应程序，ThyperLink就能打开该文件。不过E-mail地址应写成mailto:1234@5678.com这样的型式。以下是一简单的示例程序：
<pre>
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.
</pre>
<p><font color="#ffffff">----</font>
因为ThyperLink组件的父类是TCustomLabel组件，所以它拥有TCustomLabel的全部属性、方法、事件，这就是说如果需要的话，你可直接使用它们。



 



<p align="right"><small><em>中国计算机世界出版服务公司版权所有</em></small> 
<br>
</p>
</body>
</html>
💿 文件大小 2022 K
👤 上传用户 siclj
📂 所属分类 Delphi/CppBuilder
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -