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

[s.h.a.r.k]

Und was genau wird nicht korrekt gezeichnet?!

[David Martens]

Ich beziehe mich auf das Bild.
Die Checkbox bei Betreiber ist, wie man sieht, umrandet von einem FocusRect. Bei Win7 wird alles was in diesem Rect ist falsch/komisch dargestellt. Es sieht aus wie ein Teil einer EditBox oder auch was undefinierbares Schwarzes. Das passiert aber nur beim ersten Hineinklicken, kurz danach sieht es ok aus. Es flackert sozusagen kurz auf.

Leider kann ich kein Bild liefern, weil mein Rechner kein Win7 hat. Und weil es nur kurz aufflackert.

[David Martens]

*push*