TGraphicControl mit Tabstop / Focus

[Rudy]

Hallo,

im Rahmen eines Großprojektes mit speziellen grafischen Anforderungen an die Benutzeroberfläche habe ich kürzlich diese Basisklasse entworfen. Es ist ein GraphicControl mit der Fähigkeit, auf den Tabulator zu reagieren. Wir wissen alle, dass das grundsätzlich nicht geht, weil TGraphicControl kein Handle hat. Aber was wäre oft alles möglich, wenn es trotzdem ginge... besonders Transparenz bei Komponenten (und zwar echte, nicht gefakete).

Es hat einiges an Nerven und viele Externe und Interne Exceptions gekostet, und das hier ist dabei herausgekommen - bisher läuft es stabil. Ich poste dies hier, weil es ein allgegenwärtiges Problem ist, das normalerweise so verläuft:

A: Ich habe eine transparente Komponente erstellt! Wie bekomme ich noch den Tabstop hin?
B: Deine Komponente stammt von TGraphicControl ab und kann deshalb kein Tabstop erhalten. Nimm TCustomControl/TWinControl...
A: Und wie mache ich die Transparent?
B: Windows unterstützt keine Transparenz. Aber Du kannst Bla... DC hier, WindowRegion da, Hook dort, und zuletzt flackerts doch.

Ich kanns nicht mehr hören und will mich damit nicht abfinden. Ich hoffe anderen hiermit dieses Ärgernis ersparen zu können - und natürlich weiß ich auch, dass hier viele fähige Leute unterwegs sind, die helfen können, Fehler aufzudecken und den Code weiter zu verbessern. Darauf hoffe ich ebenso.

Ziel: Eine GraphicControl-Basisklasse, die es erlaubt, Komponenten zu entwickeln, die Tabstop unterstützen können wie TWinControl-Nachfolger, und Tastendruck unterstützen.

Delphi-Quellcode:

unit FocusGraphicControl;

interface

uses
  SysUtils, Classes, Controls, Dialogs, Messages, Graphics, Forms, Types;

type
  TFocusGraphicControl = class;

  TFocusControl = class(TWinControl)
  private
    FGraphicControl: TFocusGraphicControl;
  protected
    procedure WndProc(var Message: TMessage); override;
    procedure WMKeyDown(var message: TWMKeyDown); message WM_KEYDOWN;
    procedure WMKeyUp(var message: TWMKeyUp); message WM_KEYUP;
  public
    constructor Create(AOwner: TComponent; AGraphicControl: TFocusGraphicControl); reintroduce;
    property TabStop;
    property TabOrder;
  end;

  TFocusGraphicControl = class(TGraphicControl)
  private
    FFocusControl: TFocusControl;
    function GetTabOrder: Integer;
    procedure SetTabOrder(const Value: Integer);
    function GetTabStop: Boolean;
    procedure SetTabStop(const Value: Boolean);
    function GetFocused: Boolean;
    function GetCanFocus: Boolean;
    procedure DestroyFocusControl;
    procedure CreateFocusControl(AOwner: TComponent; AParent: TWinControl);
    procedure WMEraseBkgnd(var message: TWMEraseBkGnd); message WM_ERASEBKGND;
  protected
    procedure Paint; override;
    procedure PaintShape; virtual;
    procedure SetParent(AParent: TWinControl); override;
    procedure DoKeyDown(var Key: Word; Shift: TShiftState); virtual; abstract;
    procedure DoKeyUp(var Key: Word; Shift: TShiftState); virtual; abstract;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetFocus;
    property CanFocus: Boolean read GetCanFocus;
    property Focused: Boolean read GetFocused;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  published
    property TabStop: Boolean read GetTabStop write SetTabStop;
    property TabOrder:Integer read GetTabOrder write SetTabOrder;
  end;

implementation

{ TFocusGraphicControl }

constructor TFocusGraphicControl.Create(AOwner: TComponent);
begin
  inherited;
  FFocusControl := nil;
  CreateFocusControl(nil, TWinControl(AOwner));
end;

destructor TFocusGraphicControl.Destroy;
begin
  DestroyFocusControl;
  inherited;
end;

function TFocusGraphicControl.GetCanFocus: Boolean;
begin
  if Assigned(FFocusControl) then
    result := FFocusControl.CanFocus
  else
    result := False;
end;

function TFocusGraphicControl.GetFocused: Boolean;
begin
  if Assigned(FFocusControl) then
    result := FFocusControl.Focused
  else
    result := False;
end;

function TFocusGraphicControl.GetTabOrder: Integer;
begin
  if Assigned(FFocusControl) then
    result := FFocusControl.TabOrder
  else
    result := -1;
end;

function TFocusGraphicControl.GetTabStop: Boolean;
begin
  if Assigned(FFocusControl) then
    result := FFocusControl.TabStop
  else
    result := False;
end;

procedure TFocusGraphicControl.SetFocus;
begin
 if Assigned(FFocusControl) then
   if FFocusControl.CanFocus then
      FFocusControl.SetFocus;
end;

procedure TFocusGraphicControl.SetTabOrder(const Value: Integer);
begin
  if Assigned(FFocusControl) then
    FFocusControl.TabOrder := Value;
end;

procedure TFocusGraphicControl.SetTabStop(const Value: Boolean);
begin
  if Assigned(FFocusControl) then
    FFocusControl.TabStop := Value;
end;

procedure TFocusGraphicControl.PaintShape;
begin
  //!!!Nur ein Beispiel, diese Methode in Nachfolgern überschreiben 
  Canvas.Brush.Style := bsClear;
  if not Focused then
    Canvas.Pen.Color := clBlack
  else
    Canvas.Pen.Color := clRed;
  Canvas.Rectangle(ClientRect);
end;

procedure TFocusGraphicControl.Paint;
begin
  inherited;
  PaintShape;
end;

procedure TFocusGraphicControl.SetParent(AParent: TWinControl);
begin
  inherited;
  if Assigned(Self.Parent) then
  begin
    FFocusControl.Parent := Self.Parent;
    FFocusControl.Show;
  end;
end;

procedure TFocusGraphicControl.CreateFocusControl(AOwner: TComponent; AParent: TWinControl);
begin
  if not Assigned(FFocusControl) then
  begin
    FFocusControl := TFocusControl.Create(AOwner, Self);
    try
      FFocusControl.TabStop := True;
      FFocusControl.SetBounds(0, 0, 0, 0);
    except
      raise;
    end;
  end;
end;

procedure TFocusGraphicControl.DestroyFocusControl;
begin
  if Assigned(FFocusControl) then
  begin
    if Assigned(FFocusControl.Parent) then
      FreeAndNil(FFocusControl);
  end;
end;

procedure TFocusGraphicControl.SetBounds(ALeft, ATop, AWidth,
  AHeight: Integer);
begin
  inherited;
  Repaint;
end;

procedure TFocusGraphicControl.WMEraseBkgnd(
  var message: TWMEraseBkGnd);
begin
  message.result := 1;
end;

{ TFocusControl }

constructor TFocusControl.Create(AOwner: TComponent;
  AGraphicControl: TFocusGraphicControl);
begin
  inherited Create(AOwner);
  Assert(Assigned(AGraphicControl), 'Cannot create a FocusControl with unassigned GraphicControl.');
  FGraphicControl := AGraphicControl;
end;

procedure TFocusControl.WMKeyDown(var message: TWMKeyDown);
  var Shift: TShiftState;
begin
  if Assigned(FGraphicControl) then
  begin
    Shift := KeyDataToShiftState(Message.KeyData);
    FGraphicControl.DoKeyDown(Message.CharCode, Shift);
  end;
  inherited;
end;

procedure TFocusControl.WMKeyUp(var message: TWMKeyUp);
  var Shift: TShiftState;
begin
  if Assigned(FGraphicControl) then
  begin
    Shift := KeyDataToShiftState(Message.KeyData);
    FGraphicControl.DoKeyUp(Message.CharCode, Shift);
  end;
  inherited;
end;

procedure TFocusControl.WndProc(var Message: TMessage);
begin
  inherited;
  case Message.Msg of
    WM_SETFOCUS, WM_KILLFOCUS:
       begin
         if Assigned(FGraphicControl) then
           FGraphicControl.Repaint;
       end;
  end;
end;

end.

Verwendung:
Dies ist eine Basisklasse. Die Methode 'PaintShape' sollte in Nachfolgern mit override übernommen und nicht inherited werden, die vorhandene ist nur zu Demonstrationszwecken da. In dieser Methode kann dann die Komponente gezeichnet werden.

Der Taborder kann wie gewöhnlich gesetzt werden, weil das der WinControl übernimmt.

Auf Tastendruck kann in den (abstrakten) Methoden DoKeyDown und DoKeyUp reagiert werden, Nachfolger müssen dazu diese Methoden ausprogrammieren. Die Parameter sollten selbsterklärend sein.

Die Komponente scheint bisher flickerfrei zu sein, auch mit Themes (XP Manifest) und Doublebuffered getestet.


Was haltet Ihr von dieser Lösung? Zu gewagt?


NB: Wer jetzt an eine transparente GroupBox denkt, ist hiermit schlecht bedient - ein GraphicControl kann keine Komponenten direkt aufnehmen. Dafür ist das hier nicht gedacht! Aber allerlei grafische Komponenten, die auch mit der Tastatur errecihbar und bedienbar sein sollen, sind damit gut zu realisieren.

Viel Spaß mit dem Code, ich hoffe auf euer Feedback!

Schönen Gruß,
Rudy