Компонент - ссылка на интернет адрес

← →
Anthony © (2012-01-05 11:55) [0]

Подскажите пожалуйста, какой есть компонент для Delphi,
который был бы как Tlabel, и мог отображать интернет-ссылку так, что при наведении на него мышки, он бы менял цвет, подчёркивался, а при нажатии мышью - позволял открыть интернет браузер и в нём или открыть соотв.страницу, или перейти на страницу написания письма, если ссылка представляет из себя почтовый адрес.
Благодарю.

← →
Dimka Maslov © (2012-01-05 11:58) [1]

Из стандартного TLabel делается за 5 (пять) минут через OnMouseEnter, OnMouseLeave и OnClick.

← →
_Юрий (2012-01-05 12:14) [2]

> OnMouseEnter, OnMouseLeave

Это лишнее)
Свойство "Курсор" выставляем в "лапу", цвет делаем синим, текст - подчеркнутый, ну и OnClick

← →
_Юрий (2012-01-05 12:14) [3]

невнимательно прочитал)

← →
Anthony © (2012-01-05 12:24) [4]

Хорошо, допустим. А что именно нужно вписать в OnClick, чтобы у пользователя открылась например Opera, и если в ссылке содержался почтовый адрес - он сразу перешёл на страницу написания письма?

← →
Dennis I. Komarov © (2012-01-05 12:26) [5]

ShellExecute

← →
Dimka Maslov © (2012-01-05 12:41) [6]

> одержался почтовый адрес - он сразу перешёл на страницу
> написания письма

ShellExecute(Application.Handle, "open", "mailto:antonovanesyan@mail.ru", "", "", SW_SHOWNORMAL)

← →
Anthony © (2012-01-05 13:25) [7]

Благодарю за подсказку, всё работает!
Правда вот по строке "mailto:antonovanesyan@mail.ru" вызывается Microsoft Outlook 2007, а не Опера, и я не знаю как это изменить...
А когда попробовал подставить просто интернет адрес, например "www.yandex.ru" - то открывается страница сразу в Опере, что очень удобно.

← →
знайка (2012-01-05 13:28) [8]

> и я не знаю как это изменить...
А если оперы нет?

← →
RWolf © (2012-01-05 13:32) [9]

> вызывается Microsoft Outlook 2007

вызывается умолчательная почтовая программа. чтобы вызывалась опера, почтовиком по умолчанию надо сделать её

← →
Anthony © (2012-01-05 13:59) [10]

прошу прощения, а где прописывается почтовик по умолчанию?..

← →
RWolf © (2012-01-05 14:24) [11]

http://stackoverflow.com/questions/231/register-windows-program-with-the-mailto-protocol-programmatically

THyperLink = class(TLabel) ... end;
осталась самая малость... :)

> Anthony © (05.01.12 13:59) [10]
> прошу прощения, а где прописывается почтовик по умолчанию?

А это уже не твоя забота.

unit HyperLink;

interface

uses
Windows, Classes, SysUtils, Controls, StdCtrls, Graphics, ShellApi;

type
THyperLink = class(TLabel)
private
FURL: string;
FBold, FUnderline: boolean;
function ValidationURL(AURL: string): boolean;
public
procedure _OnMouseLeave(Sender: TObject);
procedure _OnMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

constructor Create(AOwner: TComponent); override;
protected
procedure Click; override;
published
property URL: string read FURL write FURL;
property Bold: boolean read FBold write FBold;
property Underline: boolean read FUnderline write FUnderline;
end;

procedure Register;

implementation
{$R HyperLink.dcr}

procedure Register;
begin
RegisterComponents("Standard", [THyperLink]);
end;

function THyperLink.ValidationURL(AURL: string): boolean;
begin
if Length(AURL) = 0 then
begin
Result:= False;
Exit;
end;

if (Pos("http://", AnsiLowerCase(AURL)) > 0) or
(Pos("www.", AnsiLowerCase(AURL)) > 0) or
(Pos("mailto:", AnsiLowerCase(AURL)) > 0) then Result:= True
else
Result:= False;
end;

procedure THyperLink._OnMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if (ValidationURL(URL)) or (ValidationURL(Caption)) then
begin
if Cursor <> crHandPoint then Cursor:= crHandPoint;
end
else
begin
if Cursor <> crDefault then Cursor:= crDefault;
end;

if FBold then Font.Style:= Font.Style + [fsBold];
if FUnderline then Font.Style:= Font.Style + [fsUnderline];
end;

procedure THyperLink._OnMouseLeave(Sender: TObject);
begin
if FBold then Font.Style:= Font.Style - [fsBold];
if FUnderline then Font.Style:= Font.Style - [fsUnderline];
end;

constructor THyperLink.Create(AOwner: TComponent);
begin
inherited;

FBold:= False;
FUnderline:= False;

with Font do
begin
Color:= clBlue;
Name:= "MS Sans Serif";
Size:= 12;
end;

Transparent:= True;

OnMouseMove:= _OnMouseMove;
OnMouseLeave:= _OnMouseLeave;
end;

procedure THyperLink.Click;
begin
inherited;
{$WARNINGS OFF}
if ValidationURL(URL) then
ShellExecute(Parent.Handle, "open", PChar(FURL), nil, nil, SW_SHOW)
else
if ValidationURL(Caption) then
ShellExecute(Parent.Handle, "open", PChar(Caption), nil, nil, SW_SHOW)

{$WARNINGS ON}
end;

end.

http://delphimaster.net/view/2-1325423630/

Компонент - ссылка на интернет адрес Найти похожие ветки