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

[3_of_8]

TCustomControl?

[SirThornberry]

Ging sicher auch kürzer. Letzendlich machst du ja nix anderes als ein WinControl versteckt mitzuführen und darauf zu reagieren wenn dieses events bekommt (wie focus etc.).
Es gibt sicher bessere Variante. Graphiccontrols haben ja auch den Nachteil dass, das ParentWinControl jedes mal mit gezeichnet werden muss wenn das Graphiccontrol gezeichnet wird. Wir haben zum Beispiel eigene Panels geschrieben von denen man das bild abfragen kann. Somit können wir bei unseren CustomControls vom Parent das Bild abfragen und die Transparenz berechnen.

[Rudy]

Zitat:

Ging sicher auch kürzer. Letzendlich machst du ja nix anderes als ein WinControl versteckt mitzuführen und darauf zu reagieren wenn dieses events bekommt (wie focus etc.).

Ja, das Prinzip ist dieses. Ich hatte das Problem, dass auf Panels mit Verläufen keine wirklich befriedigende Lösung gefunden habe, darauf befindliche CheckBoxen/Radiobuttons im Themed-Modus und ohne Themes, mit DoubleBuffered und ohne einfach transparent zu bekommen. Ich hab so vieles zusammen mit meinem Kollegen versucht... alles hatte einen Haken.

Wie ginge es denn kürzer? (mal abgesehen von den ganzen Assigned-Prüfungen, die im Katastrophenfall eh nicht greifen *g)

Zitat:

Graphiccontrols haben ja auch den Nachteil dass, das ParentWinControl jedes mal mit gezeichnet werden muss wenn das Graphiccontrol gezeichnet wird.

Ja. Davon merke ich mit DoubleBuffered allerdings bisher nichts. Der VCL-Bug in WMEraseBkGnd von TWinControl ist in den Parent-Wincontrols durch Überschreiben behoben.

Zitat:

Somit können wir bei unseren CustomControls vom Parent das Bild abfragen und die Transparenz berechnen.

Was meinst Du mit berechnen? Du kopierst dann einfach das Rect des Parents auf den Canvas des CustomControls bevor Du den Rest zeichnest, oder? Wie siehts dabei mit Flackern aus?

Danke für das Feedback.

[SirThornberry]

Flackern gibts da keines. Flackern hat man in der Regel nur wenn man mit "Repaint" arbeitet. Wenn man mit Invalidate arbeitet hält sich das Flackern in Grenzen.

Und ja, letztendlich kopieren wir den Hintergrund nur vom Parent. Berechnen hab ich geschrieben weil wir da auch noch mit Alphakanal arbeiten und da eben Alphatransparenz berechnet werden muss.

[ma2xx]

Auch wenn der initiale Beitrag doch schon einige Jahre alt ist, möchte ich doch mal lobend erwähnen, dass diese Basisklasse mir doch weitergeholfen hat.

Als Ergänzung noch die Focus-Umschaltung bei Left-Mouse-Click in das Control

Code:

procedure TFocusGraphicControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var InCtrl: Boolean;
begin
    inherited;
    if (Button=mbLeft)and Enabled then begin
        InCtrl:=(X>=0)and(X<ClientWidth)and(Y>=0)and(Y<=ClientHeight);
        if (InCtrl) then begin
            SetFocus();
        end;
    end;
end;

Danke
ma2xx