VCL für Microsoft-Style URL-Label

[blackdrake]

Ich habe folgendes nun nach langer Arbeit hinbekommen:

Im Header sind ToDo-Einträge gelistet. Hier habe ich noch einige Probleme... Bitte schreibt mir, wenn ihr weiter wisst!

Delphi-Quellcode:

{
  TSingleLinkLabel
  (c) 2008 Daniel Marschall / ViaThinkSoft

  Original code and partitions
  (c) 2008 by omata (Thorsten) - [url]http://www.delphipraxis.net[/url]
}

// ToDo
// + AutoSize
// + Transparent
// + ParentColor
// + ParentFont
// (+ Sonstige Eigenschaften von echten Labels)
// Enabled=False  * Schrift wird nicht grau
//                * Das nächste Item bekommt nicht den Focus
// Microsoft Hand-Cursor

unit SingleLinkLabel;

interface

uses Windows, Controls, Classes, Graphics, SysUtils;

type
  TSingleLinkLabel = class(TCustomControl)
  private
    FLines:TStringList;
    function GetCaption: string;
    procedure SetCaption(const Value: string);
  protected
    procedure Paint; override;
    procedure DoEnter; override;
    procedure DoExit; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure Resize; override;
  published
    property OnClick;
    property Font;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Caption:string read GetCaption write SetCaption;
  end;

implementation

{ TSingleLinkLabel }

constructor TSingleLinkLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FLines := TStringList.Create;
  Width := 65;
  Height := 17;
  TabStop := True;

  Font.Color := clHotLight;
  Font.Style := [fsUnderline];
end;

destructor TSingleLinkLabel.Destroy;
begin
  FLines.free;
  inherited;
end;

procedure TSingleLinkLabel.DoEnter;
begin
  inherited;
  Paint;
end;

procedure TSingleLinkLabel.DoExit;
begin
  inherited;
  Paint;
end;

function TSingleLinkLabel.GetCaption: string;
begin
  Result := FLines.Text;
end;

procedure TSingleLinkLabel.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited;

  if Key = 13 then Click;
end;

procedure TSingleLinkLabel.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited;
  SetFocus;
end;

procedure TSingleLinkLabel.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  Cursor := crHandPoint;
end;

procedure TSingleLinkLabel.Paint;
var
  i: integer;
begin
  inherited;

  Canvas.Font := Font;

  Canvas.Brush.Color := clBtnFace;
  Canvas.Brush.Style := bsSolid;
  Canvas.FillRect(Canvas.ClipRect);

  for i := 0 to FLines.Count - 1 do
  begin
    Canvas.TextOut(0, Canvas.TextHeight('X')*i, FLines.Strings[i]);
  end;

  if Focused then Canvas.DrawFocusRect(Canvas.ClipRect);
end;

procedure TSingleLinkLabel.Resize;
begin
  inherited;
  SetCaption(Caption);
  Paint;
end;

procedure TSingleLinkLabel.SetCaption(const Value: string);
begin
  FLines.Text := Value;

  Paint;
end;

end.

Gruß
blackdrake