Jump to content

Como criar uma hiperligação...


nunopicado
 Share

Recommended Posts

unit NetLabel;

(******************************************************************************)
(*****************  NetLabel: Hyperlink Label for Delphi  *********************)
(*****************       Nuno Miguel Picado © 2012        *********************)
(******************************************************************************)

interface

uses
    StdCtrls, ShellAPI, Registry, Windows, Classes, Graphics, Controls, Messages;

type
    TNetLabel = class (TLabel)  // Nova classe baseada na TLabel
    Private
      Address:String;  // onde o endereço é guardado
      LinkClr:TColor;  // Guarda a cor do link antes de ser clicado
      HotClr:TColor;  // Guarda a cor do link depois de clicado
      function BrowseURL : boolean;  // Abre o explorador com o endereço guardado
      procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;  // Apanha a entrada do rato na área da NetLabel
      procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;  // Apanha a saida do rato na área da NetLabel
      Procedure SetURL(URL:String);  // Define o endereço URL
      procedure SetLColor(LinkColor: TColor);  // Define a cor do link antes de ser clicado
      procedure SetHColor(HotColor: TColor);  // Define a cor do link depois de ser clicado
    Public
      constructor Create(Sender:TComponent); Override;  // Constructor da classe
      procedure Click; Override;  // Apanha o evento OnClick da NetLabel
    Published
      property URL:String Read Address Write SetURL;  // Define e mostra o endereço da NetLabel
      property LinkColor:TColor Read LinkClr Write SetLColor;  // Define e mostra a cor da NetLabel antes de clicada
      property HotColor:TColor Read HotClr Write SetHColor;  // Define e mostra a cor da NetLabel depois de clicada
  end;

procedure Register;  // Regista o componente

implementation

constructor TNetLabel.Create(Sender:TComponent);
begin
     inherited;
     SetURL(''); // Define o endereço como não existente
     SetLColor(clBlue);
     SetHColor(clPurple);
     Font.Color:=LinkClr;
end;

procedure TNetLabel.SetLColor(LinkColor: TColor);
begin
     LinkClr:=LinkColor;
end;

procedure TNetLabel.SetHColor(HotColor: TColor);
begin
     HotClr:=HotColor;
end;

Procedure TNetLabel.SetURL(URL:String);
begin
     with Font do
          begin
               Color:=LinkClr;  // Define a cor como azul (não clickado)
               Style:=Font.Style-[fsUnderline];  // Remove o sublinhado do estilo da fonte, caso exista
          end;
     Address:=Url; // Define a variável URL
end;

procedure TNetLabel.Click;
begin
     inherited;
     if Address<>''
        then if BrowseURL  // Abre o Browser
                then Font.Color:=HotClr;  // Define a cor como purble (já clickado)
end;

procedure TNetLabel.CMMouseEnter(var Message: TMessage);
begin
     inherited;
     Font.Style:=Font.Style+[fsUnderline];  // Define o sublinhado
     Cursor:=crHandpoint;  // Define o cursor como HandPoint
end;

procedure TNetLabel.CMMouseLeave(var Message: TMessage);
begin
     inherited;
     Font.Style:=Font.Style-[fsUnderline];  // Remove o sublinhado
     Cursor:=crDefault;  // Define o cursor como Default
end;

function TNetLabel.BrowseURL : boolean;
var
   Browser:String;
begin
     Result:=True;
     Browser:='';

     // Verifica o browser padrão
     with TRegistry.Create do
          try
             RootKey:=HKEY_CLASSES_ROOT;
             Access:=KEY_QUERY_VALUE;
             if OpenKey('\htmlfile\shell\open\command', False)
                then Browser:=ReadString('');
             CloseKey;
          finally
             Free;
          end;

     // Se não houver browser padrão, termina
     if Browser=''
        then begin
                  Result:=False;
                  Exit;
             end;

     // Livra-se dos parametros do browser padrão
     Browser:=Copy(Browser,Pos('"',Browser)+1,999);
     Browser:=Copy(Browser,1,Pos('"',Browser)-1);

     // Chama o browser padrão com o URL como parâmetro
     ShellExecute(0,'open',PChar(Browser),PChar(Address),nil,SW_SHOW);
end;

procedure Register;
begin
     // Regista o componente no separador Internet
     RegisterComponents('Internet',[TNetLabel]);
end;

end.

Em Designtime:

1. Ir ao separador 'Internet'

2. Arrastar um TNetLabel para o local desejado

3. Definir as propriedades Caption (texto apresentado) e URL (Endereço) no Object Inspector

E voilá, está um link feito...

NOTA: Se não for definida a propriedade URL, o NetLabel age como um link interno, e terá de ser definido a sua acção no evento OnClick...

NOTA2: Pode-se alterar as cores padrão do componente, definindo as propriedades LinkColor (cor antes de clicado) e HotColor (cor depois de clicado)

"A humanidade está a perder os seus génios... Aristóteles morreu, Newton já lá está, Einstein finou-se, e eu hoje não me estou a sentir bem!"

> Não esclareço dúvidas por PM: Indica a tua dúvida no quadro correcto do forum.

Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
 Share

×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.