Создаем гипер-ссылку в Delphi
29.11.2011
Простой способ сделать ссылку:
Разместить на форме TLabel и на событие OnClick вызвать ShellExecute, а в uses формы добавить ShellAPI.
Пример:
Uses ShellAPI; procedure TForm1.Label1Click(Sender: TObject); begin ShellExecute(handle, 'open', 'http://oddler.ru/', nil, nil, SW_SHOW); end;
Пара слов о параметрах:
- handle - это дескриптор формы (аналогично Form1.handle)
- open - тип действия. Нам надо открыть ссылку (в общем виде – открыть файл).
- http:// oddler.ru/ - ссылка (имя файла), которую надо открыть.
- nil - здесь никаких дополнительных параметров открытия файла не должно быть, поэтому nil.
- nil - директория по умолчанию нас так же не интересует.
- SW_SHOW - активирует окно и отображает его с текущими размерами и положением.
Об остальных режимах можно узнать в хелпе (о функции ShellExecute).
Желательно сделать визуальное оформление похожим на ссылки в браузере:
implementation
const
link = clBlue; //цвет ссылки
alink = clRed; //цвет ссылки в момент нажатия
vlink = clPurple; // цвет посещеной ссылки
{$R *.DFM}
...
Теперь в обработчике события формы OnCreate надо написать:
procedure TForm1.FormCreate(Sender: TObject); begin Label1.font.Color := link; end;
В обработчике события метки OnMouseDown мы напишем:
procedure TForm1.Label1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Label1.Font.Color := alink; end;
А в обработчике события OnMouseUp нашей метки мы напишем:
procedure TForm1.Label1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Label1.Font.Color := vlink; end;
Если требуется не одна ссылка, то логичнее использовать компонент, вот листинг готового решения: (сохранить надо в файле Link.pas)
unit Link;
interface
uses
Windows, SysUtils, Classes, Forms, StdCtrls, ShellAPI, Menus,
Controls, Graphics;
type
TLink = class(TLabel)
private
//поле для хранения URL
FURL: string;
// поля для хранения настроек цветов ссылки
FlinkColor, FAlinkColor, FVlinkColor: TColor;
protected
public
//конструктор и деструктор
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
//события, которые нам надо переопределить
procedure Click; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
override;
published
//свойства, которые будут видны в Object Inspector
property URL: string read FURL write FURL;
property LinkColor: TColor read FLinkColor write FLinkColor default clBlue;
property ALinkColor: TColor read FALinkColor write FALinkColor default clRed;
property VLinkColor: TColor read FVLinkColor write FVLinkColor default clPurple;
end;
procedure Register;
implementation
constructor TLink.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
//устанавливаем цвета
FALinkColor := clRed;
FLinkColor := clBlue;
FVLinkColor := clPurple;
//сделаем метку синей и подчеркнутой
with Font do
begin
Color := FLinkColor;
Style := [fsUnderline];
end;
end;
procedure TLink.Click;
begin
inherited Click;
//если поле URL заполнено, то перейдем по ссылке
if FURL <> '' then
ShellExecute(GetDesktopWindow(), 'open', PChar(FURl), nil, nil, SW_SHOW);
end;
procedure TLink.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y:
Integer);
begin
if Button = mbLeft then
begin
FLinkColor := Font.Color;
Font.Color := FALinkColor;
end;
inherited;
end;
procedure TLink.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y:
Integer);
begin
if Button = mbLeft then
Font.Color := FVLinkColor;
inherited;
end;
destructor TLink.Destroy;
begin
//уничтожим компонент
inherited;
end;
procedure Register;
begin
//надо, чтобы компонент появился в палитре
RegisterComponents('Oddler', [TLink]);
end;
end.