Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

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

Anthony © (2012-01-05 11:55:00)
Подскажите пожалуйста, какой есть компонент для Delphi,
который был бы как Tlabel, и мог отображать интернет-ссылку так, что при наведении на него мышки, он бы менял цвет, подчёркивался, а при нажатии мышью - позволял открыть интернет браузер и в нём или открыть соотв.страницу, или перейти на страницу написания письма, если ссылка представляет из себя почтовый адрес.
Благодарю.

brother (2012-01-06 16:01:00) [1]
http://www.delphimaster.ru/cgi-bin/forum.pl?n=18&id=1325423630

brother (2012-01-06 16:00:00) [2]
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.

Eraser (2012-01-06 14:51:00) [3]
> [0] Anthony © (05.01.12 11:55)

TLinkLabel

DiamondShark (2012-01-06 14:44:00) [4]

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

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

Dennis I. Komarov (2012-01-06 14:37:00) [5]
THyperLink = class(TLabel) ... end;
осталась самая малость... :)

RWolf (2012-01-05 14:24:00) [6]
http://stackoverflow.com/questions/231/register-windows-program-with-the-mailto-protocol-programmatically

Anthony (2012-01-05 13:59:00) [7]
прошу прощения, а где прописывается почтовик по умолчанию?..

RWolf (2012-01-05 13:32:00) [8]

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

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

знайка (2012-01-05 13:28:00) [9]

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

Anthony (2012-01-05 13:25:00) [10]
Благодарю за подсказку, всё работает!
Правда вот по строке "mailto:antonovanesyan@mail.ru" вызывается Microsoft Outlook 2007, а не Опера, и я не знаю как это изменить...
А когда попробовал подставить просто интернет адрес, например "www.yandex.ru" - то открывается страница сразу в Опере, что очень удобно.

Dimka Maslov (2012-01-05 12:41:00) [11]

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

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

Dennis I. Komarov (2012-01-05 12:26:00) [12]
ShellExecute

Anthony (2012-01-05 12:24:00) [13]
Хорошо, допустим. А что именно нужно вписать в OnClick, чтобы у пользователя открылась например Opera, и если в ссылке содержался почтовый адрес - он сразу перешёл на страницу написания письма?

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

> OnMouseEnter, OnMouseLeave

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

_Юрий (2012-01-05 12:14:00) [15]
невнимательно прочитал)

Dimka Maslov (2012-01-05 11:58:00) [16]
Из стандартного TLabel делается за 5 (пять) минут через OnMouseEnter, OnMouseLeave и OnClick.

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »