| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

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

как сделать ссылку на сайт в форме

Andvitar ©   (2012-01-01 17:13:00) 

Здравствуйте. Есть дочерняя форма Form2. Нужно в этой форме сделать ссылку на сайт чтобы при клике на эту ссылку сайт загрузился во внешний браузер.Как это реализовать ? Если просто поместить компонент Label с названием сайта то загрузки не будет.

---

brother   (2012-01-06 09:34:00) [1]

удобно? наглядно? чего ж еще то?

---

Erythroxylum   (2012-01-04 05:00:00) [2]

> brother ©   (02.01.12 09:56) [5]


у це нереальный выпендрёж.

---

brother   (2012-01-03 21:09:00) [3]

> [5] brother ©   (02.01.12 09:56)

цэ поделка для домашенго использования...

---

Андреевич   (2012-01-02 21:35:00) [4]

я бы курсор еще не дельфевый hand взял, а системный, примерно так:
Screen.Cursors[100]:=LoadCursor(0,IDC_HAND);

---

brother   (2012-01-02 09:56:00) [5]

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.

---

Andvitar   (2012-01-01 19:14:00) [6]

Спасибо за код. Заработало.

---

Юрий Зотов   (2012-01-01 17:59:00) [7]


uses
 ShellAPI;

procedure TForm1.FormCreate(Sender: TObject);
begin
 with Label1 do
 begin
   Font.Style := [fsUnderline];
   Cursor := crHandPoint;
   Caption := ' http://www.delphimaster.ru/cgi-bin/forum.pl?n=3'
 end
end;

procedure TForm1.Label1Click(Sender: TObject);
begin
 ShellExecute(0, 'open', PChar(Label1.Caption), nil, nil, SW_SHOWNORMAL)
end;


---

asail   (2012-01-01 17:57:00) [8]

> Есть дочерняя форма Form2. Нужно в этой форме сделать ссылку
> на сайт

Так же, как и не на дочерней форме Form17...

> Если просто поместить компонент Label с названием сайта
> то загрузки не будет

Логично...

А если серьезно, то смотри
> WinExec   (01.01.12 17:21) [1]

---

WinExec   (2012-01-01 17:21:00) [9]

Но если к этому Label-у написать обработчик события OnClick, а в этом обработчике вызвать функцию WinExec (описание которой см. в справке по WinAPI), то загрузка будет.

---

Наверх