Текущий архив: 2012.05.06;
Скачать: CL | DM;

Вниз

как сделать ссылку на сайт в форме   Найти похожие ветки 

← →
Andvitar ©   (2012-01-01 17:13) [0]

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

---

← →
WinExec   (2012-01-01 17:21) [1]

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

---

← →
asail ©   (2012-01-01 17:57) [2]

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

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

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

Логично...

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

---

← →
Юрий Зотов ©   (2012-01-01 17:59) [3]


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;


---

← →
Andvitar ©   (2012-01-01 19:14) [4]

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

---

← →
brother ©   (2012-01-02 09:56) [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.

---

← →
Андреевич   (2012-01-02 21:35) [6]

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

---

← →
brother ©   (2012-01-03 21:09) [7]

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

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

---

← →
Erythroxylum   (2012-01-04 05:00) [8]

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


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

---

← →
brother ©   (2012-01-06 09:34) [9]

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

---

Страницы: 1 вся ветка

Текущий архив: 2012.05.06;
Скачать: CL | DM;

Наверх

Память: 0.49 MB
Время: 0.007 c