|
 Forum
Grundkurs
»Introduktion
»Snabbguide
»Komponenter
»Händelser
»Strängar
»Räkna med Delphi »Egna
typer
»Selektion
»Iteration
»Menyer
»Funktioner
»Arraystrukturer
Tips & Tricks
»Nya tips
»Blandat
»Databaser
»Filer
»Forms
»Grafik
»Internet
»Komponenter
»Matematik
»Multimedia
»Objekt/ActiveX
»Skrivare
»Strängar
»System
»Mest lästa tips
Artiklar
»Delphi och ADO
»Bygga en DLL
»Skapa en enkel rapport
»Hantera registret
»Enheter, units
»Klassen TCanvas
»Använd LookUp Controls
 Nya
tips
 Lägg
till tips
 Delphilänkar
 Gästbok
|
|
|
|
|
|
Skapa hyperlänk på ditt formulär
|
Kategori: Blandat
Inlagt: 2005-11-08
Läst: 1345
Inlagt av: Staffan Berg
|
|
Beskrivning |
|
För att skapa en hyperlänk behöver du inte nödvändigtvis använda dig av någon tredjepartskomponent. Du kan ärva egenskaper och metoder som i exemplet nedan. Alla komponenter i koden ärver från en modifierad TStatisText.
|
|
Kod |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ShellAPI, Registry;
type
TStaticText = class(StdCtrls.TStaticText)
private
procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
procedure WMKillFocus(var Message: TWMSetFocus); message WM_KILLFOCUS;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure Draw(Active: Boolean);
procedure WMKeyUp(var Message: TWMKeyUp); message WM_KEYUP;
function GetAnchorColor: TColor;
end;
TForm1 = class(TForm)
StaticText1: TStaticText;
StaticText2: TStaticText;
Edit1: TEdit;
procedure StaticText1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TStaticText.Draw(Active: Boolean);
begin
with Self.Font do
begin
if Active then
begin
// uncomment this line if you want the "hyperlink" to be bold
// Font.Style := Font.Style + [fsBold];
//
// You can use the function GetAnchorColor to get the same
// anchor colors as IE but it reads from the registry everytime
// you mouseover or set focus to this control
// Note: if you chose not to use it, remove it completely or you will
// get a compile hint: Private symbol 'GetAnchorColor' declared
// but never used
//
// Color := GetAnchorColor;
//
// Here we are just setting to the standard blue for an unvisited
// anchor.
Color := clBlue;
if not Focused then
Screen.Cursor := crHandPoint;
end
else
begin
// uncomment this line if you want the "hyperlink" to be bold
// Font.Style := Font.Style - [fsBold];
Color := clWindowText;
if not Focused then
Screen.Cursor := crDefault;
end;
end;
end;
procedure TStaticText.CMMouseEnter(var Message: TMessage);
begin
inherited;
Draw(True);
end;
procedure TStaticText.CMMouseLeave(var Message: TMessage);
begin
inherited;
Draw(False);
end;
procedure TStaticText.WMKillFocus(var Message: TWMSetFocus);
begin
inherited;
Draw(False);
end;
procedure TStaticText.WMSetFocus(var Message: TWMSetFocus);
begin
inherited;
Draw(True);
end;
procedure TStaticText.WMKeyUp(var Message: TWMKeyUp);
begin
if Assigned(OnClick) and (Message.CharCode = 13) then
Click;
end;
function TStaticText.GetAnchorColor: TColor;
{
Will return the ASectionNumber' section of text from
a string that is delimited with the passed delimiter.
usage:
ParseDelimetedString('ABC,123,XYZ',',',1) returns 'ABC'
ParseDelimetedString('ABC,123,XYZ',',',2) returns '123'
}
function ParseDelimitedString(AString, ADelimiter: String;
ASectionNumber: Integer): String;
var
i, miCount : integer;
mStr : String;
begin
result := '';
miCount := 1;
for i:= 1 to Length(AString) do
begin
mStr := Copy(AString,i,1);
if mStr = ADelimiter then
miCount := miCount + 1
else if miCount = ASectionNumber then
result := result + mStr;
end;
end;
var
Reg: TRegistry;
UseHover: Boolean;
RGBString: String;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey('\Software\Microsoft\Internet Explorer\Settings', False) then
begin
UseHover := (Reg.ReadString('Use Anchor Hover Color') = 'yes');
if UseHover then
begin
RGBString := Reg.ReadString('Anchor Color Hover')
end
else
begin
RGBString := Reg.ReadString('Anchor Color')
end;
Reg.CloseKey;
end;
finally
Reg.Free;
Result := RGB(StrToInt(ParseDelimitedString(RGBString, ',', 1)),
StrToInt(ParseDelimitedString(RGBString, ',', 2)),
StrToInt(ParseDelimitedString(RGBString, ',', 3)));
end;
end;
// Now this is what it does when you click or hit enter
// when it has focus
procedure TForm1.StaticText1Click(Sender: TObject);
begin
ShellExecute(0, 'open', PChar(TStaticText(Sender).Caption), '', '', SW_SHOW);
end;
end.
|
|
|