Einzelnen Beitrag anzeigen

blackdrake

Registriert seit: 22. Aug 2003
Ort: Bammental
618 Beiträge
 
Delphi 10.3 Rio
 
#25

Re: VCL für Microsoft-Style URL-Label

  Alt 22. Aug 2008, 00:10
Ich sitze jetzt hier schon seit Tagen daran, mit dem Erstellen einer solchen VCL herumzuexperimentieren und niemand hilft mir...

Jetzt habe ich folgenden Plan versucht:

Eine Klasse von TLabel ableiten und diese Klasse erzeugt ein Tab-Objekt, das über das Label gelegt wird. Dieses Tab-Object ist eine Klasse, die vom TCustomControl (enthält TabStop) abgeleitet ist, aber Transparent sein muss.

Im Moment sieht das so aus:

Delphi-Quellcode:
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.
TSingleLinkLabel ist ein Label, das beim Erstellen ein TTabElement über das Label legt.

TTabElement hat die einzige Aufgabe, lediglich einen Rahmen zu zeichnen, sobald es den Fokus hat!

Aber: Großes Problem besteht bei der Transparenz! Ich bekomme TCustomControl nicht transparent, weswegen in meinem Beispiel das Label unter dem TTabElement verschwindet und somit unsichtbar ist.

Bitte helft mir doch endlich mal! Ich habe so wenig Ahnung von Vererbung und VCL und hocke hier jetzt schon seit 1 Woche an diesem Zeug, was eigentlich vollkommen trivial ist!

Gruß
blackdrake
Angehängte Dateien
Dateityp: zip linkableitung-test_185.zip (268,0 KB, 2x aufgerufen)
Daniel Marschall
  Mit Zitat antworten Zitat