Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
Link Label Component Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
28-May-03
Category
VCL-General
Language
Delphi All Versions
Views
46
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			Author: Daniel Wischnewski

I have seen many tips on how to call the default browser and open a web page, yet 
no component in DKB that allows to simply be placed on a form at design time. 

Answer:

This component was developed for the German-language forum 
Delphi-PRAXiShttp://www.delphipraxis.net 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 ======================== 
1   
2   {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
3   *
4   * Unit Name : uDPLinkLabel
5   * Copyright : Copyright © 2001, 2002 by gate(n)etwork. All Rights Reserved.
6   * Author    : Daniel Wischnewski
7   * Freeware  : This source is released under the Mozilla Public License. It may
8   *             be reproduced, as long as all references to its original source
9   *             are maintained.
10  *             The most recent version is publicly available at
11  *             http://www.Delphi-PRAXiS.net
12  *
13  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
14  
15  //: Enthält eine Internetlink-Label-Komponente für die Mitglieder der Delphi-PRAXiS.
16  unit uDPLinkLabel;
17  
18  interface
19  
20  uses
21    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
22    StdCtrls;
23  
24  type
25    //: Komponente zur Bereitstellung von Links innerhalb von Delphi-Anwendungen
26    TDPLinkLabel = class(TCustomLabel)
27    private
28      FHoverLinkFont: TFont;
29      FHyperLink: string;
30      FLinkFont: TFont;
31      FMouseHover: Boolean;
32      FVisited: Boolean;
33      FVisitedLinkFont: TFont;
34      procedure FontChanged(Sender: TObject);
35      procedure SetHoverLinkFont(Value: TFont);
36      procedure SetHyperLink(Value: string);
37      procedure SetLinkFont(Value: TFont);
38      procedure SetVisited(Value: Boolean);
39      procedure SetVisitedLinkFont(Value: TFont);
40      procedure UpdateLinkFont;
41    protected
42      procedure Click; override;
43      procedure CMMouseEnter(var message: TMessage); message CM_MOUSEENTER;
44      procedure CMMouseLeave(var message: TMessage); message CM_MOUSELEAVE;
45    public
46      constructor Create(AOwner: TComponent); override;
47      destructor Destroy; override;
48      procedure ExecuteHyperLink(aLink: string = '');
49    published
50      property Align;
51      property Alignment;
52      property Anchors;
53      property AutoSize;
54      property BiDiMode;
55      property Caption;
56      property Color;
57      property Constraints;
58      property DragCursor;
59      property DragKind;
60      property DragMode;
61      property Enabled;
62      property FocusControl;
63      property HoverLinkFont: TFont read FHoverLinkFont write SetHoverLinkFont;
64      property HyperLink: string read FHyperLink write SetHyperLink;
65      property Layout;
66      property LinkFont: TFont read FLinkFont write SetLinkFont;
67      property OnClick;
68      property OnContextPopup;
69      property OnDblClick;
70      property OnDragDrop;
71      property OnDragOver;
72      property OnEndDock;
73      property OnEndDrag;
74      property OnMouseDown;
75      property OnMouseMove;
76      property OnMouseUp;
77      property OnStartDock;
78      property OnStartDrag;
79      property ParentBiDiMode;
80      property ParentColor;
81      property ParentShowHint;
82      property PopupMenu;
83      property ShowAccelChar;
84      property ShowHint;
85      property Transparent;
86      property Visible;
87      property Visited: Boolean read FVisited write SetVisited;
88      property VisitedLinkFont: TFont read FVisitedLinkFont write
89        SetVisitedLinkFont;
90      property WordWrap;
91    end;
92  
93  procedure register;
94  
95  implementation
96  
97  uses
98    ShellAPI;
99  
100 procedure register;
101 begin
102   RegisterComponents('Delphi-PRAXiS', [TDPLinkLabel]);
103 end;
104 
105 { TDPLinkLabel }
106 
107 constructor TDPLinkLabel.Create(AOwner: TComponent);
108 begin
109   inherited Create(AOwner);
110   // create default link font object
111   FLinkFont := TFont.Create;
112   FLinkFont.OnChange := FontChanged;
113   FLinkFont.Color := clBlue;
114   FLinkFont.Style := [fsUnderline];
115   // set inherited font
116   Font := LinkFont;
117   // create visit link font object
118   FVisitedLinkFont := TFont.Create;
119   FVisitedLinkFont.OnChange := FontChanged;
120   FVisitedLinkFont.Color := clPurple;
121   FVisitedLinkFont.Style := [fsUnderline];
122   // create hover link font object
123   FHoverLinkFont := TFont.Create;
124   FHoverLinkFont.OnChange := FontChanged;
125   FHoverLinkFont.Color := clRed;
126   FHoverLinkFont.Style := [fsUnderline];
127   // initialize vars
128   FMouseHover := False;
129   FVisited := False;
130   Caption := 'Delphi-PRAXiS';
131   FHyperLink := 'http://www.Delphi-PRAXiS.net';
132   // override initialization of previous vars
133   Cursor := crHandPoint;
134 end;
135 
136 destructor TDPLinkLabel.Destroy;
137 begin
138   inherited Destroy;
139   // free link font objects
140   FLinkFont.Free;
141   FHoverLinkFont.Free;
142   FVisitedLinkFont.Free;
143 end;
144 
145 procedure TDPLinkLabel.Click;
146 begin
147   // the onClick method will be overriden only, if a link is assigned to the
148   // Link property of the component and no custom on-click handler is assigned
149   if (not Assigned(OnClick)) and (Action = nil) and (ActionLink = nil) and (
150     HyperLink <> '') then
151     // call link
152     ExecuteHyperLink
153   else
154     // work standard control click routine
155     inherited;
156 end;
157 
158 procedure TDPLinkLabel.CMMouseEnter(var message: TMessage);
159 begin
160   inherited;
161   // mouse enters link - hover color effective
162   FMouseHover := True;
163   UpdateLinkFont;
164 end;
165 
166 procedure TDPLinkLabel.CMMouseLeave(var message: TMessage);
167 begin
168   inherited;
169   // mouse leaves link - hover color not effective anymore
170   FMouseHover := False;
171   UpdateLinkFont;
172 end;
173 
174 procedure TDPLinkLabel.ExecuteHyperLink(aLink: string = '');
175 var
176   UseLink: string;
177 begin
178   // set link for execution
179   if Trim(aLink) = '' then
180     UseLink := Trim(HyperLink)
181   else
182     UseLink := Trim(aLink);
183   // check link data
184   if Trim(UseLink) = '' then
185     // raise exception on empty link
186     raise Exception.Create('No link for launching web browser.');
187   // load default browser with link
188   ShellExecute(0, nil, PChar(HyperLink), nil, nil, SW_SHOW);
189   // HyperLink was visited, no special link passed
190   if Trim(aLink) <> '' then
191     Visited := True;
192 end;
193 
194 procedure TDPLinkLabel.FontChanged(Sender: TObject);
195 begin
196   // need to inform preceding class of possible changes in font
197   UpdateLinkFont;
198 end;
199 
200 procedure TDPLinkLabel.SetHoverLinkFont(Value: TFont);
201 begin
202   FHoverLinkFont.Assign(Value);
203   UpdateLinkFont;
204 end;
205 
206 procedure TDPLinkLabel.SetHyperLink(Value: string);
207 begin
208   if FHyperLink <> Value then
209   begin
210     FHyperLink := Value;
211     Visited := False;
212     if Caption = '' then
213       Caption := HyperLink;
214   end;
215 end;
216 
217 procedure TDPLinkLabel.SetLinkFont(Value: TFont);
218 begin
219   FLinkFont.Assign(Value);
220   UpdateLinkFont;
221 end;
222 
223 procedure TDPLinkLabel.SetVisited(Value: Boolean);
224 begin
225   if FVisited <> Value then
226   begin
227     FVisited := Value;
228     UpdateLinkFont;
229   end;
230 end;
231 
232 procedure TDPLinkLabel.SetVisitedLinkFont(Value: TFont);
233 begin
234   FVisitedLinkFont.Assign(Value);
235   UpdateLinkFont;
236 end;
237 
238 procedure TDPLinkLabel.UpdateLinkFont;
239 begin
240   // assign font property the appropriate font data
241   if FMouseHover then
242     Font := HoverLinkFont
243   else if Visited then
244     Font := VisitedLinkFont
245   else
246     Font := LinkFont;
247 end;
248 
249 end.

========================= CODE END ========================= 

			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC