AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Projekte Delphi TGraphicControl mit Tabstop / Focus

TGraphicControl mit Tabstop / Focus

Ein Thema von Rudy · begonnen am 3. Aug 2006 · letzter Beitrag vom 15. Jan 2014
Antwort Antwort
Benutzerbild von Rudy
Rudy
Registriert seit: 12. Jun 2006
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
 
Benutzerbild von 3_of_8
3_of_8

 
Turbo Delphi für Win32
 
#2
  Alt 3. Aug 2006, 23:20
Delphi-Referenz durchsuchenTCustomControl?
Manuel Eberl
  Mit Zitat antworten Zitat
Benutzerbild von SirThornberry
SirThornberry

 
Delphi 2006 Professional
 
#3
  Alt 3. Aug 2006, 23:27
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.
Jens
  Mit Zitat antworten Zitat
Benutzerbild von Rudy
Rudy

 
Delphi 7 Enterprise
 
#4
  Alt 3. Aug 2006, 23:51
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.
Rudy
  Mit Zitat antworten Zitat
Benutzerbild von SirThornberry
SirThornberry

 
Delphi 2006 Professional
 
#5
  Alt 4. Aug 2006, 07:43
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.
Jens
  Mit Zitat antworten Zitat
ma2xx
 
#6
  Alt 15. Jan 2014, 16:55
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
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 07:09 Uhr.
Powered by vBulletin® Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2020 by Daniel R. Wolf