- Delphiartiklar, tips, forum, länksamling - 

      

START | DELPHI | LÄNKARGÄSTBOK 




 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: 1279
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. 
 
 

 
 
© Copyright 2005 - Staffan Berg
- Alla rättigheter förbehålles -