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