CheckBox grayed ...

[guidok]

Ich hab mir auch eine Checkbox selbst gemacht, nachdem es das was ich wollte nicht fertig gab.

Hier der Quellcode, vielleicht kannst du ja was davon nutzen.

Delphi-Quellcode:

const
  //Anwendungsfarben
  clXTBackground = clInactiveCaption;
  clXTDisabledControl = cl3DDkShadow;
  clXTInactiveControl = cl3DLight;
  clXTActiveControl = $00C8F5F9;
  clXTDisabledControlText = clBtnShadow;
  clXTEnabledControlText = clBlack;
  clXTControlBorder = clBtnShadow;
  clXTMarker = $000080FF;


type
  TXTCheckBox = class(TCustomControl)
  private
    PFState: TCheckBoxState;
    FEnabled: Boolean;
    FBoxColor: TColor;
    function GetChecked: Boolean;
    procedure SetChecked(Value: Boolean);
  protected
    procedure Paint; override;
    procedure Toggle; virtual;
    procedure Click; override;
    procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
    procedure CMExit(var Message: TCMGotFocus); message CM_EXIT;
  public
    Caption: TCaption;
    constructor Create(AOwner: TComponent; AParent: TWinControl; ATop:Integer);Reintroduce;
    property State: TCheckBoxState read PFState;
  published
    property Checked: Boolean read GetChecked write SetChecked;
    property Enabled: Boolean read FEnabled write FEnabled default True;
    property OnClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnEnter;
    property OnExit;
    property OnKeyPress;
    property OnKeyDown;
    property OnKeyUp;
  end;

//==============================================================================
// XTCheckBox

constructor TXTCheckBox.Create(AOwner: TComponent; AParent: TWinControl; ATop:Integer);
begin
  inherited Create(AOwner);
  Parent:=AParent;
  Top:=ATop;
  Left:=5;
  ControlStyle := [csCaptureMouse, csClickEvents, csDesignInteractive];
  FEnabled := True;
  Width := 117;
  Height := 17;
  FBoxColor:=clXTInactiveControl;
end;

procedure TXTCheckBox.Paint;
var
   R:TRect;
begin
  with Canvas do
  begin
//Linie und Beschriftung
    Pen.Color:=clXTControlBorder;
    Pen.Width:=1;
    MoveTo(0,Height-2);
    LineTo(Width-16,Height-2);
    if FEnabled then Font.Color:=clBtnText
    else Font.Color:=clBtnShadow;
    Brush.Color:=Color;
    TextOut(2,1,Caption);
//Rechteck
    R.Top:=0;
    R.Left:=Width-16;
    R.Bottom:=16;
    R.Right:=Width;
    Brush.Color:=FBoxColor;
    FillRect(R);
    Rectangle(R);
//Checked
    if PFState=cbChecked then
    begin
      Pixels[R.Left+4,R.Top+4]:=clBlack;
      Pixels[R.Left+5,R.Top+5]:=clBlack;
      Pixels[R.Left+6,R.Top+6]:=clBlack;
      Pixels[R.Left+7,R.Top+7]:=clBlack;
      Pixels[R.Left+8,R.Top+8]:=clBlack;
      Pixels[R.Left+9,R.Top+9]:=clBlack;
      Pixels[R.Left+10,R.Top+10]:=clBlack;
      Pixels[R.Left+11,R.Top+11]:=clBlack;
      Pixels[R.Left+4,R.Top+11]:=clBlack;
      Pixels[R.Left+5,R.Top+10]:=clBlack;
      Pixels[R.Left+6,R.Top+9]:=clBlack;
      Pixels[R.Left+7,R.Top+8]:=clBlack;
      Pixels[R.Left+8,R.Top+7]:=clBlack;
      Pixels[R.Left+9,R.Top+6]:=clBlack;
      Pixels[R.Left+10,R.Top+5]:=clBlack;
      Pixels[R.Left+11,R.Top+4]:=clBlack;
    end;
  end;
end;


function TXTCheckBox.GetChecked;
begin
  Result := not(State = cbUnChecked);
end;


procedure TXTCheckBox.SetChecked;
begin
  if Value and FEnabled then
    PFState := cbChecked
  else
    PFState := cbUnChecked;
  Paint;
end;


procedure TXTCheckBox.Toggle;
begin
  Checked := not Checked;
end;


procedure TXTCheckBox.Click;
begin
  if FEnabled then begin
    Toggle;
    SetFocus;
  end;
  inherited Click;
end;

procedure TXTCheckBox.CMEnter(var Message: TWMNoParams);
begin
  FBoxColor:=clXTActiveControl;
  Paint;
  inherited;
end;

procedure TXTCheckBox.CMExit(var Message: TWMNoParams);
begin
  FBoxColor:=clXTInactiveControl;
  Paint;
  inherited;
end;