Transparentes TCustomControl

[Gausi]

Ich möchte eine kleine Komponente erstellen, die (teilweise) transparent sein soll. Und da habe ich beim Zeichnen noch ein paar Problemchen. Zum einen "flackert" es noch ein wenig, und mit myForm.DoubleBuffered := True; geht die Transparenz komplett flöten. Irgendwo fehlt mir noch ein Puzzlestück in der Paint-Behandlung von Windows.

Hat da einer Erfahrung mit, oder versteht jemand den Paint-Zyklus von Windows besser als ich, insbesondere mit Blick auf DoubleBuffered? TCustomTransparentControl als Basis für die Ableitung habe ich auch probiert, aber da wird das flackern extrem störend. Wenn ich mir da die Invalidate-Methode anschaue, dann habe ich auch nicht den Eindruck, als wäre das sonderlich effizient.

Ich habe das mal auf ein Minimalbeispiel runtergebrochen. Hier wird einfach beim MouseMove an der Zeigerposition ein kleiner Kreis gezeichnet. Die eigentliche Komponente macht natürlich ein wenig mehr, und kann z.B. auch den Fokus bekommen.

Delphi-Quellcode:

TDemoDings =  class(TCustomControl)
  private
    FX: Integer;
    FY: Integer;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure DoDraw(aCanvas: TCanvas);
    procedure Paint; override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
  public

end;

///

procedure TDemoDings.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
end;

procedure TDemoDings.DoDraw(aCanvas: TCanvas);
var
  aRect: TRect;
begin
  // Rahmen um die Komponente zeichnen
  aRect := ClientRect;
  InflateRect(aRect, -2, -2);
  Canvas.Brush.Color := clBlack;
  aCanvas.FrameRect(aRect);
  // an der aktuellen Position einen kleinen Kreis malen.
  aCanvas.Brush.Style := bsSolid;
  aCanvas.Brush.Color := clRed;
  aCanvas.Ellipse(FX-4, FY-4, FX+4, FY+4);
end;

procedure TDemoDings.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  aRect: TRect;
begin
  // Bereich, auf dem ich vorher rumgeschmiert habe, wieder löschen
  aRect := Rect(FX-5, FY-5, FX+5, FY+5);
  OffsetRect(aRect, Left, Top);
  InvalidateRect(Parent.Handle, @aRect, True);
  // Koordinaten neu setzen und per Invalidate das Neuzeichnen anfordern
  FX := X;
  FY := Y;
  Invalidate;
end;

procedure TDemoDings.Paint;
begin
  DoDraw(Canvas);
end;

procedure TDemoDings.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
begin
  SetBkMode (msg.DC, TRANSPARENT);
  msg.result := 1;
end;

Kleine Mini-Projekt im Anhang, bei dem die Komponente teilweise über einem TImage liegt.