Title: Link Label Component
Question: I have seen many tips on how to call the default browser and open a web page, yet no component on Delphi3000 that allows to simply be placed on a form at design time.
Well, here it is.
Answer:
This component was developed for the German-language forum Delphi-PRAXiS by myself. There is not much to say about it. Simply copy the source code into a new Delphi unit save it and install the component in Delphi.
Afterwards you may place it on your form, set link and caption, adjust the colors for Hot-Link, Visited and Unvisited. Just like a link within your HTML. You may place a link to an e-mail address also, by simply preceding the email address with a mailto:.
======================== CODE START ========================
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
* Unit Name : uDPLinkLabel
* Copyright : Copyright 2001, 2002 by gate(n)etwork. All Rights Reserved.
* Author : Daniel Wischnewski
* Freeware : This source is released under the Mozilla Public License. It may
* be reproduced, as long as all references to its original source
* are maintained.
* The most recent version is publicly available at
* http://www.Delphi-PRAXiS.net
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
//: Enthlt eine Internetlink-Label-Komponente fr die Mitglieder der Delphi-PRAXiS.
unit uDPLinkLabel;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
//: Komponente zur Bereitstellung von Links innerhalb von Delphi-Anwendungen
TDPLinkLabel = class (TCustomLabel)
private
FHoverLinkFont: TFont;
FHyperLink: string;
FLinkFont: TFont;
FMouseHover: Boolean;
FVisited: Boolean;
FVisitedLinkFont: TFont;
procedure FontChanged(Sender: TObject);
procedure SetHoverLinkFont(Value: TFont);
procedure SetHyperLink(Value: string);
procedure SetLinkFont(Value: TFont);
procedure SetVisited(Value: Boolean);
procedure SetVisitedLinkFont(Value: TFont);
procedure UpdateLinkFont;
protected
procedure Click; override;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ExecuteHyperLink(aLink: String = '');
published
property Align;
property Alignment;
property Anchors;
property AutoSize;
property BiDiMode;
property Caption;
property Color;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property FocusControl;
property HoverLinkFont: TFont read FHoverLinkFont write SetHoverLinkFont;
property HyperLink: string read FHyperLink write SetHyperLink;
property Layout;
property LinkFont: TFont read FLinkFont write SetLinkFont;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
property ParentBiDiMode;
property ParentColor;
property ParentShowHint;
property PopupMenu;
property ShowAccelChar;
property ShowHint;
property Transparent;
property Visible;
property Visited: Boolean read FVisited write SetVisited;
property VisitedLinkFont: TFont read FVisitedLinkFont write
SetVisitedLinkFont;
property WordWrap;
end;
procedure Register;
implementation
uses
ShellAPI;
procedure Register;
begin
RegisterComponents('Delphi-PRAXiS', [TDPLinkLabel]);
end;
{ TDPLinkLabel }
constructor TDPLinkLabel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
// create default link font object
FLinkFont := TFont.Create;
FLinkFont.OnChange := FontChanged;
FLinkFont.Color := clBlue;
FLinkFont.Style := [fsUnderline];
// set inherited font
Font := LinkFont;
// create visit link font object
FVisitedLinkFont := TFont.Create;
FVisitedLinkFont.OnChange := FontChanged;
FVisitedLinkFont.Color := clPurple;
FVisitedLinkFont.Style := [fsUnderline];
// create hover link font object
FHoverLinkFont := TFont.Create;
FHoverLinkFont.OnChange := FontChanged;
FHoverLinkFont.Color := clRed;
FHoverLinkFont.Style := [fsUnderline];
// initialize vars
FMouseHover := False;
FVisited := False;
Caption := 'Delphi-PRAXiS';
FHyperLink := 'http://www.Delphi-PRAXiS.net';
// override initialization of previous vars
Cursor := crHandPoint;
end;
destructor TDPLinkLabel.Destroy;
begin
inherited Destroy;
// free link font objects
FLinkFont.Free;
FHoverLinkFont.Free;
FVisitedLinkFont.Free;
end;
procedure TDPLinkLabel.Click;
begin
// the onClick method will be overriden only, if a link is assigned to the
// Link property of the component and no custom on-click handler is assigned
if (not Assigned(OnClick)) and (Action = nil) and (ActionLink = nil) and (
HyperLink '') then
// call link
ExecuteHyperLink
else
// work standard control click routine
inherited;
end;
procedure TDPLinkLabel.CMMouseEnter(var Message: TMessage);
begin
inherited;
// mouse enters link - hover color effective
FMouseHover := True;
UpdateLinkFont;
end;
procedure TDPLinkLabel.CMMouseLeave(var Message: TMessage);
begin
inherited;
// mouse leaves link - hover color not effective anymore
FMouseHover := False;
UpdateLinkFont;
end;
procedure TDPLinkLabel.ExecuteHyperLink(aLink: String = '');
var
UseLink: string;
begin
// set link for execution
if Trim(aLink) = '' then
UseLink := Trim(HyperLink)
else
UseLink := Trim(aLink);
// check link data
if Trim(UseLink) = '' then
// raise exception on empty link
raise Exception.Create('No link for launching web browser.');
// load default browser with link
ShellExecute(0, nil, PChar(HyperLink), nil, nil, SW_SHOW);
// HyperLink was visited, no special link passed
if Trim(aLink) '' then
Visited := True;
end;
procedure TDPLinkLabel.FontChanged(Sender: TObject);
begin
// need to inform preceding class of possible changes in font
UpdateLinkFont;
end;
procedure TDPLinkLabel.SetHoverLinkFont(Value: TFont);
begin
FHoverLinkFont.Assign(Value);
UpdateLinkFont;
end;
procedure TDPLinkLabel.SetHyperLink(Value: string);
begin
if FHyperLink Value then
begin
FHyperLink := Value;
Visited := False;
if Caption = '' then
Caption := HyperLink;
end;
end;
procedure TDPLinkLabel.SetLinkFont(Value: TFont);
begin
FLinkFont.Assign(Value);
UpdateLinkFont;
end;
procedure TDPLinkLabel.SetVisited(Value: Boolean);
begin
if FVisited Value then
begin
FVisited := Value;
UpdateLinkFont;
end;
end;
procedure TDPLinkLabel.SetVisitedLinkFont(Value: TFont);
begin
FVisitedLinkFont.Assign(Value);
UpdateLinkFont;
end;
procedure TDPLinkLabel.UpdateLinkFont;
begin
// assign font property the appropriate font data
if FMouseHover then
Font := HoverLinkFont
else if Visited then
Font := VisitedLinkFont
else
Font := LinkFont;
end;
end.
========================= CODE END =========================
Regards,
Daniel Wischnewski
Delphi-PRAXiS