unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, jpeg, ExtCtrls, Buttons;
type
TForm1 =
class(TForm)
Label1: TLabel;
Button1: TButton;
Image1: TImage;
procedure Button1Click(Sender: TObject);
end;
// FUNKTIONIERT NICHT!!! DAS TEIL IST NICHT DURCHSICHTIG!!!
TTransparentCustomControl =
class(TCustomControl)
protected
procedure CreateParams(
var Params: TCreateParams);
override;
end;
TTabElement =
class(TTransparentCustomControl)
protected
procedure Paint;
override;
procedure DoEnter;
override;
procedure DoExit;
override;
public
constructor Create(AOwner: TComponent);
override;
end;
TSingleLinkLabel =
class(TLabel)
protected
procedure Paint;
override;
private
FTabElement: TTabElement;
public
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
override;
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
end;
var
Form1: TForm1;
implementation
{uses
Themes;}
{$R *.dfm}
{ TTransparentCustomControl }
procedure TTransparentCustomControl.CreateParams(
var Params: TCreateParams);
begin
// Transparenz herstellen
// [url]http://www.coding-board.de/board/showpost.php?p=25336&postcount=7[/url]
// Problem: Die Transparenz funktioniert nicht! Es wird nur die
// Formhintergrundfarbe übernommen. Das dahinterliegende Label ist
// verdeckt!
// ToDo: Transparenz des TSingleLinkLabel anzapfen
inherited CreateParams(Params);
Params.ExStyle := Params.ExStyle+WS_EX_Transparent;
ControlStyle := ControlStyle-[csOpaque]+[csAcceptsControls];
end;
{ TTabElement }
procedure TTabElement.Paint;
begin
inherited;
if Focused
then
begin
Canvas.DrawFocusRect(Canvas.ClipRect);
end;
Repaint;
end;
constructor TTabElement.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Parent := AOwner
as TWinControl;
DoubleBuffered := true;
TabStop := True;
// ToDo: Transparent, Click -> FocusGet, Enter=ClickNotify
{if ThemeServices.ThemesEnabled then
ControlStyle := ControlStyle - [csOpaque]
else
ControlStyle := ControlStyle + [csOpaque];}
end;
procedure TTabElement.DoEnter;
begin
inherited;
Paint;
end;
procedure TTabElement.DoExit;
begin
inherited;
Paint;
end;
{ TSingleLinkLabel }
procedure TSingleLinkLabel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
inherited;
FTabElement.Left := ALeft;
FTabElement.Top := ATop;
FTabElement.Width := AWidth;
FTabElement.Height := AHeight;
end;
constructor TSingleLinkLabel.Create(AOwner: TComponent);
begin
FTabElement := TTabElement.Create(AOwner);
FTabElement.Parent := AOwner
as TWinControl;
inherited Create(FTabElement);
Parent := FTabElement
as TWinControl;
Font.Color := clHotLight;
Font.Style := [fsUnderline];
Cursor := crHandPoint;
// ToDo: Microsoft-Hand verwenden
end;
procedure TSingleLinkLabel.Paint;
begin
inherited;
end;
destructor TSingleLinkLabel.Destroy;
begin
// FTabElement.Free; // EXCEPTION
inherited;
end;
{ Testform }
procedure TForm1.Button1Click(Sender: TObject);
var
x: TSingleLinkLabel;
begin
x := TSingleLinkLabel.Create(self);
x.Parent := form1;
x.AutoSize := true;
x.Caption := '
Dies ist ein Label ... als Link';
x.Top := 10;
x.Left := 20;
end;
end.