说三道四技术文摘-感悟人生的经典句子
说三道四 > 文档快照

自制THyperLink组件-Delphi资料

HTML文档下载 WORD文档下载 PDF文档下载
自制THyperLink组件-Delphi资料

很多软件在其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的全部属性、方法、事件,这就是说如果需要的话,你可直接使用它们。

备案号:鲁ICP备13029499号-2 说三道四 www.s3d4.cn 说三道四技术文摘