TCheckBox mit FocusRect um die CheckBox

[David Martens]

Ich habe erfolgreich eine eigene CheckBox geschrieben (Siehe Photo). Das besondere: das FocusRect ist um die Checkbox, da keine Text vorhanden ist.
Leider funktioniert die nicht mehr mit Windows 7. Hier wird beim anklicken nicht richtig gezeichnet.


Hier die Komponente:

Delphi-Quellcode:

unit CheckBoxDrawFocus;

interface

uses
  Classes, StdCtrls, Messages, Windows, Graphics;

type
  TCheckBoxDrawFocus = class(TCheckBox)
  private

    procedure Enter(Sender: TObject);
  protected
  public
    procedure WndProc(var message: TMessage); override;

    constructor Create(AOwner: TComponent); override;
  published
  end;

procedure Register;

implementation

uses
  Forms,
  Controls;

procedure Register;
begin
  RegisterComponents('Sample', [TCheckBoxDrawFocus]);
end;

{ TCheckBoxDrawFocus }

constructor TCheckBoxDrawFocus.Create(AOwner: TComponent);
begin
  inherited;

  Self.OnEnter := Enter;
end;

procedure TCheckBoxDrawFocus.Enter(Sender: TObject);
begin
  Repaint;
end;

procedure TCheckBoxDrawFocus.WndProc(var message: TMessage);

  {$REGION 'function SubColor(Col1, Col2: TColor): TColor;'}
  // Berechnet die 'Differenzfarbe' von Col1 und Col2
  function SubColor(Col1, Col2: TColor): TColor;
  var
    L1, L2: Longint;
    R1, G1, B1: Byte;
    R2, G2, B2: Byte;
  begin
    L1 := ColorToRGB(Col1);
    L2 := ColorToRGB(Col2);

    R1 := Byte(L1);
    G1 := Byte(L1 shr 8);
    B1 := Byte(L1 shr 16);

    R2 := Byte(L2);
    G2 := Byte(L2 shr 8);
    B2 := Byte(L2 shr 16);

    if R1 > R2 then
      R1 := R1 - R2
    else
      R1 := R2 - R1;

    if G1 > G2 then
      G1 := G1 - G2
    else
      G1 := G2 - G1;

    if B1 > B2 then
      B1 := B1 - B2
    else
      B1 := B2 - B1;

    Result := (B1 shl 16) + (G1 shl 8) + R1;
  end;
  {$ENDREGION}

  {$REGION 'procedure DrawFocusRect(X, Y : integer);'}
  // Zeichnet die Umrandung
  procedure DrawFocusRect(X, Y : integer);
  const
    cPenStyle: array[1..2] of DWORD = (0, 2);
  var
    P1, P2, P3, P4 : TPoint;
    logBrush: TLogBrush;
    Col1, Col2 : TColor;
    C : TCanvas;
  begin
    C := TCanvas.Create;
    C.Handle := GetWindowDC(0);

    Col1 := SubColor(clMenu, clWindowText);
    Col2 := clBlack;

    P1.X := X;      P1.Y := Y;
    P2.X := X + 16; P2.Y := Y;
    P3.X := X + 16; P3.Y := Y + 16;
    P4.X := X;      P4.Y := Y + 16;

    C.Pen.Handle := CreatePen(PS_SOLID, 1, ColorToRGB(Col1));
    C.Polyline([P1, P2, P3, P4, P1]);

    logBrush.lbStyle := BS_SOLID;
    logBrush.lbColor := Col2;

    C.Brush.Color := clRed;
    C.Pen.Handle := ExtCreatePen(PS_GEOMETRIC or PS_USERSTYLE,
                                 1,
                                 logBrush,
                                 Length(cPenStyle), @cPenStyle);


    C.Polyline([P1, P2, P3, P4, P1]);
  end;
  {$ENDREGION}

  {$REGION 'procedure RepaintFirstLine(X, Y : integer; C : TCanvas);'}
  // Zeichnet die fordere Linie neu, da diese nicht mit WMPaint beim Focuslost neu gezeichnet wird
  procedure RepaintFirstLine(X, Y : integer);
  var
    wnd : HWND;
    P1, P2 : TPoint;
    i : integer;
    C : TCanvas;
  begin
    C := TCanvas.Create;
    C.Handle := GetWindowDC(0);
    C.Pen.Handle := CreatePen(PS_SOLID, 1, ColorToRGB(clMenu));

    P1.X := X + 2;
    P1.Y := Y;

    P2.X := X + 2;

    wnd := WindowFromPoint(P1);

    if (wnd = Self.Handle) then
    begin
      i := 17;
      P2.Y := Y + i;
      wnd := WindowFromPoint(P2);

      while (wnd <> Self.Handle) do
      begin
        dec(i);
        P2.Y := Y + i;
        wnd := WindowFromPoint(P2);
      end;

      P1.X := X;
      P2.X := X;
      P2.Y := Y + i + 1;
      C.Polyline([P1, P2]);
    end
    else
    begin
      P2.Y := Y + 17;
      wnd := WindowFromPoint(P2);
      if (wnd = Self.Handle) then
      begin
        i := 1;
        P1.Y := Y + i;
        wnd := WindowFromPoint(P1);

        while (wnd <> Self.Handle) do
        begin
          inc(i);
          P1.Y := Y + i;
          wnd := WindowFromPoint(P1);
        end;

        P1.X := X;
        P2.X := X;
        C.Polyline([P1, P2]);
      end;
    end;
    end;
  {$ENDREGION}

var
  X, Y : integer;
begin
  inherited WndProc(Message);

  if message.Msg = WM_PAINT then
  begin
    Y := Self.ClientOrigin.Y + (Self.Height - 17) div 2;
    X := Self.ClientOrigin.X - 2;

    if Self.Focused then
    begin
      DrawFocusRect(X, Y);
    end
    else
    begin
      // fordere Linie neu zeichnen
      RepaintFirstLine(X, Y);
    end;
  end;
end;

end.

Ich habe auch schon das hier TCheckBoxX probiert, aber leider reagiert diese Komponente nicht auf ein OnClick wenn der Focus schon drauf ist.
Ich habe an der Komponente nur die Checkbox um 2 Pixel nach rechts verschoben und mit Hilfe von focusrectangle die Checkbox selbst gezeichnet.

Vielleicht kann mir ja jemand auch für die TCheckBoxX eine Lösung sagen.

Danke David