Автор: Павел

На самом деле создать гиперссылку в Delphi очень просто. Алгоритм тут такой: мы ставим на форму метку (TLabel), приводим ее внешний вид к привычному нам виду гиперссылки в нашем браузере (рассмотрим на примере IE), и пишем обработчик события OnClick.

Чтобы нам можно было постоянно использовать гиперссылку в наших программах, мы создадим компонент!

Сейчас мы на простом примере разберемся с созданием ссылки в Delphi, а затем оформим все в виде компонента. Начинаем с того, что ставим на форму нашего проекта метку (TLabel), пусть ее имя останется Label1. Теперь мы напишем обработчик события OnClick, для нее:

procedure TForm1.Label1Click(Sender: TObject);
begin
  ShellExecute(handle, 'open', 'http://delphiworld.narod.ru/', nil, nil, SW_SHOW);
end;

Теперь поясню, что мы здесь написали. Функция ShellExecute предназначена для открытия или печати файла, как исполняемого, так и документа. Первый параметр это handle родительского окна, второй параметр - строка, указывает, что надо сделать с файлом, третий параметр содержит имя открываемого файла, четвертый параметр указывает дополнительные параметры запуска исполняемого файла, пятый параметр определяет директорию по умолчанию, последний параметр определяет где будет отображен файл после октрытия.

!!! Кстати если Вы уже попробовали запустить приведенный код, то скорее всего у Вас ничего не вышло, потому что функция ShellExecute, находится в модуле ShellAPI, который конечно же надо добавить в секцию uses, кода нашего приложения.

Теперь разберем параметры относительно нашего случая:

handle - это дескриптор главной формы (аналогично Form1.handle)
open - тип действия с файлом. Нам надо его открыть.
http://delphiworld.narod.ru/ - имя файла, который надо открыть. У нас это может быть гиперссылка, содержащая абсолютный URI.
nil - здесь никаких дополнительных параметров открытия файла не должно быть, поэтому nil.
nil - директория по умолчанию нас так же не интересует.
SW_SHOW - активирует окно и отображает его с текущими размерами и положением. Об остальных режимах можно узнать в хелпе (о функции ShellExecute).

Надо отметить, что второй и третий параметры функции являются нуль терминированными строками, т.е. строками типа PChar, поэтому для использования в функции имени файла, полученного из OpenDialog1, нужно использовать PChar(OpenDialog1.Filename).

Поскольку в браузере (при настройках по умолчанию) ссылка меняет цвет в зависимости от своего состояния и действий пользователя. Мы тоже сделаем так. Для этого заведем три константы (в них будут определяться цвета), которые надо поместить в раздел Implementation:

...
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;

Для придания полной реалистичности нашей ссылке, надо установить свойство метки Cursor в crHandPoint. Т.е. при наведении на ссылку указатель будет иметь вид привычной нам кисти руки с вытянутым указательным пальцем и сделать ссылку подчеркнутой.

Ну вот и разобрались, а теперь напишем компонент. Там все предельно просто и понятно, поэтому объяснения напишу только в виде комментариев в коде. Как инсталлировать компонент (и все другие вопросы связанные с самим написанием компонент), смотрите в статьях "Пособие по написанию компонент" и "Пособие по написанию компонент. Часть 2".

В качестве родительского класса (Ancestor Type) мы конечно же должны выбрать TLabel.

Привожу полный код модуля компонента Link класса Tlink (текст модуля надо сохранить в файле 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('http://delphiworld.narod.ru/', [TLink]);
end;

end.

Вот мы и разобрались с созданием гипер-ссылок в Delphi, как оказалось все очень просто!