Создаем гипер-ссылку в 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.