【delphi开源代码栏目提醒】:网学会员鉴于大家对delphi开源代码十分关注,论文会员在此为大家搜集整理了“MyURLLabel.pas”一文,供大家参考学习
unit MyURLLabel;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, StdCtrls,ShellApi,Forms,Graphics;
type
TMyURLLabel = class(TCustomLabel)
private
//宣告一个私有变数,其目的在储存URL的内容
FURL:String;
//宣告一个设定URL内容的程序
Procedure SetURL(Value: String);
//宣告滑鼠事件,但这些事件并不会出现在物件检视器中
Property OnClick;
Property OnMouseUp;
Property OnMouseDown;
procedure Click(Sender: TObject);
Procedure MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Procedure MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
protected
{ Protected declarations }
public
{ Public declarations }
//元件的建构式
Constructor Create(aOwner: TComponent); Override;
published
{ Published declarations }
//自订URL属性
property URL : string read FURL write SetURL;
//显示已经存在的属性
property Caption;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TMyURLLabel]);
end;
procedure TMyURLLabel.SetURL(value:string);
begin
//将使用设定的URL,储存於FURL变数中
FURL:=value;
end;
procedure TMyURLLabel.Click(Sender: TObject);
begin
//uses ShellApi,Forms;
//使用ShellExecute函式开始浏览器并且浏览指定的网址
ShellExecute(Application.Handle, 'open', pchar(URL), nil, nil , SW_SHOWNORMAL);
end;
Procedure TMyURLLabel.MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Begin
//假如使用者按下滑鼠左键则将TMyURLLabel的文字设定蓝色
If Button = mbLeft Then Font.Color := clBlue;
End;
Procedure TMyURLLabel.MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Begin
//假如使用者按下滑鼠左键则将TMyURLLabel的文字设定红色
If Button = mbLeft Then Font.Color := clRed;
End;
constructor TMyURLLabel.Create;
begin
inherited Create(aOwner);
//设定URL与Caption属性的预设值
URL := 'http://';
Caption := 'Carlos Studio';
//预设字体的设定值
Font.Size := 14;
Font.Color := clBlue; //use Graphics
Font.Style := [fsUnderline];
//预设滑鼠游标
Cursor := crHandPoint;
//指定事件所对应的事件处理
程序 OnMouseUp := MouseUp;
OnMouseDown := MouseDown;
OnClick := Click;
End;
end.