VCL für Microsoft-Style URL-Label

[blackdrake]

Hallo.

Ich habe jetzt 2 Dinge Probiert.

Versuch A (von mir bevorzugt):

TLabel ableiten, ein Handle versehen und versuchen, TabStopps setzen zu können.

Problem:
- TabOrder Problematik?
- EACCESS-VIOLATION im Message-Handler

Delphi-Quellcode:

type
  tx = class(TLabel)
  private
    FWindowHandle: HWND;
  protected
    procedure WndProc(var Msg: TMessage); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

procedure tx.WndProc(var Msg: TMessage);
var
  Handled: Boolean;
begin
  inherited;

  Handled := True;
  case Msg.Msg of
    WM_DESTROY: ; // ToDo
    else
      Handled := False;
  end;
  if Handled then
    Msg.Result := 0
  else
    Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.WParam, Msg.LParam); // EXCEPTION EACCESSVIOLATION (bei Msg.Msg = 71)
end;

constructor tx.Create(AOwner: TComponent);
var
  Style: LongInt;
begin
  inherited Create(AOwner);

{$IFDEF MSWINDOWS}
  FWindowHandle := Classes.AllocateHWnd(WndProc);
{$ENDIF}
{$IFDEF LINUX}
  FWindowHandle := WinUtils.AllocateHWnd(WndProc);
{$ENDIF}

  Style := GetWindowLong(FWindowHandle, GWL_STYLE);
  SetWindowLong(FWindowHandle, GWL_STYLE, Style and WS_TABSTOP);
end;

destructor tx.Destroy;
begin
{$IFDEF MSWINDOWS}
  Classes.DeallocateHWnd(FWindowHandle);
{$ENDIF}
{$IFDEF LINUX}
  WinUtils.DeallocateHWnd(FWindowHandle);
{$ENDIF}

  inherited Destroy;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  x: tx;
begin
  x := tx.Create(self);
  x.Parent := self;

  x.Left := 10;
  x.Top := 10;
  x.Height := 10;
  x.Width := 10;

  x.Visible := true;

  x.Caption := 'Der Versuch eines Labels...';
end;

Versuch B:

Problem:
- Das StaticLabel ist nicht Transparent.
- Das Canvas, das das DrawFocusRect() zeichnen soll, flackert.
- Wird das Control überdeckt, verliert es seine grafischen Informationen. (Ich habe schon versucht, eine TPaintBox als Objekt in die VCL zu integrieren)
- Problem mit dem Focus-Rect anzeigen/löschen

Delphi-Quellcode:

type
  TS = class(TStaticText)
  private
    FCanvas: TCanvas;
    procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  protected
    procedure Paint;
    property Canvas: TCanvas read FCanvas;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

procedure ts.WMPaint(var Message: TWMPaint);
begin
  Paint;
end;

procedure ts.CMFocusChanged(var Message: TCMFocusChanged);
begin
  inherited;
  Paint;
end;

procedure ts.Paint;
begin
  inherited;
  
  if Focused then
  begin
    Canvas.DrawFocusRect(Canvas.ClipRect);
  end;

  Repaint;
end;

constructor ts.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCanvas := TControlCanvas.Create;
  TControlCanvas(FCanvas).Control := Self;

//  DoubleBuffered := true;
end;

destructor ts.Destroy;
begin
  FCanvas.Free;
  inherited Destroy;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  x: ts;
begin
  x := ts.Create(form1);
  x.Parent := form1;

  x.Left := StaticText1.Left;
  x.Top := StaticText1.Top+40;
  x.Height := StaticText1.Height;
  x.Width := StaticText1.Width;
  x.Caption := StaticText1.Caption;
  x.TabStop := true;
end;

Gruß
blackdrake