一个极其简单的自画的CheckBox

应York.W的求助，要实现一个非标准的CheckBox，check时为圆形，不check时为方型。但CheckBox组件是继承于WinControl的，本身没有OnPaint也无Paint方法供直接重载，如何画省事呢？

  忽然想到，何必执着于CheckBox？于是从TShape继承了一个组件，哈哈。
  声明：

[code]??TRyCheckBox = class(TShape)
  ??private
  ? ? FChecked: Boolean;
  ? ? FOnChange: TNotifyEvent;
  ??protected
  ? ? procedure DoChanged; virtual;
  ? ? procedure Toggle; virtual;
  ? ? procedure Click; override;
  ??public
  ? ? property OnChange: TNotifyEvent read FOnChange write FOnChange;
  ? ? property Checked: Boolean read FChecked write FChecked;
  ??end;[/code]

  实现：

[code]{ TRyCheckBox }

  procedure TRyCheckBox.Click;
  begin
  ??Toggle;
  ??inherited;
  end;

  procedure TRyCheckBox.DoChanged;
  begin
  ??if Assigned(FOnChange) then
  ? ? FOnChange(Self);
  end;

  procedure TRyCheckBox.Toggle;
  begin
  ??FChecked := not FChecked;
  ??if FChecked then
  ? ? Shape := stCircle
  ??else
  ? ? Shape := stRectangle;
  ??DoChanged;
  end;[/code]

  测试代码：

[code]procedure TForm1.FormCreate(Sender: TObject);
  begin
  ??FCheck := TRyCheckBox.Create(Self);
  ??FCheck.Parent := Self;
  ??FCheck.OnChange := CheckClick;
  end;

  procedure TForm1.CheckClick(Sender: TObject);
  begin
  ??if FCheck.Checked then
  ? ? Caption := 'Checked.'
  ??else
  ? ? Caption := 'Unchecked.';
  end;[/code]

  简单搞定。

  不过缺点也是显而易见的，首先不是WinControl子类，不支持焦点以及空格切换。其次没有灰色状态。不过能满足基本要求也就够了。

啊。有个bug，Checked的写方法应该用SetChecked，内部同步Shape状态。

强！！！

自绘TCheckBox补充 之 继承TCheckBox自绘

无意之中看到这个贴子, 自己试着弄了弄, 一时疏忽大意. 竟绕了个大圈子. 值得高兴的就是最终实现了.

unit Unit1;

interface

uses
??Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
??Dialogs, StdCtrls, Buttons;

type
??TForm1 = class(TForm)
? ? BitBtn1: TBitBtn;
? ? CheckBox1: TCheckBox;
? ? Memo1: TMemo;
? ? Edit1: TEdit;
? ? procedure FormCreate(Sender: TObject);
??private
??public
??end;

??TMyCheckBox = class(TCheckBox)
??private
? ? FCanvas: TCanvas;
??protected
? ? procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MeasureItem;
? ? procedure CNDrawItem(var Message: TWMDrawItem); message CN_DrawItem;
? ? procedure DrawItem(const DrawItemStruct: TDrawItemStruct);
??public
? ? constructor Create(AOwner: TComponent); override;
? ? destructor Destroy; override;
? ? procedure CreateParams(var Params: TCreateParams); override;
??end;

var
??Form1: TForm1;

implementation

{$R *.dfm}
procedure TMyCheckBox.CNDrawItem(var Message: TWMDrawItem);
begin
??DrawItem(Message.DrawItemStruct^);
end;

procedure TMyCheckBox.CNMeasureItem(var Message: TWMMeasureItem);
begin
??with Message.MeasureItemStruct^ do
??begin
? ? itemWidth := Width;
? ? itemHeight := Height;
??end;
end;

constructor TMyCheckBox.Create(AOwner: TComponent);
begin
??inherited Create(AOwner);
??ControlStyle := [csSetCaption, csDoubleClicks];
??Checked := True;
??FCanvas := TCanvas.Create;
??Caption := 'TMyCheckBox';
??Width := 160;
??Height := 20
end;

procedure TMyCheckBox.CreateParams(var Params: TCreateParams);
begin
??inherited CreateParams(Params);
??with Params do
??begin
? ? //这块很关键, 就是这绕了个大圈子. 结果一直拦到CM_DrawItem消息.
? ? Style := Style xor BS_3STATE xor BS_MULTILINE;
? ? Style := Style or BS_OWNERDRAW;
??end;
end;

destructor TMyCheckBox.Destroy;
begin
??FCanvas.Free;
??inherited;
end;

procedure TMyCheckBox.DrawItem(const DrawItemStruct: TDrawItemStruct);
var
??R: TRect;
??DrawR, TextR: TRect;
begin
??FCanvas.Handle := DrawItemStruct.hDC;
??FCanvas.Pen.Width := 2;
??R := ClientRect;

??DrawR.Left := R.Left;
??DrawR.Top := R.Top;
??DrawR.Right := 20;
??DrawR.Bottom := R.Bottom;

??TextR.Left := R.Left + DrawR.Right;
??TextR.Top := R.Top;
??TextR.Right := R.Right;
??TextR.Bottom := R.Bottom;

??if Self.Checked then
? ? FCanvas.Brush.Color := clRed
??else
? ? FCanvas.Brush.Color := clWhite;
??FCanvas.Pen.Color := clBlack;
??FCanvas.Ellipse(DrawR);
??FCanvas.Brush.Style := bsClear;
??FCanvas.Font.Size := 12;
??FCanvas.TextRect(TextR, 22, 2, Caption);
??//DrawText(FCanvas.Handle, PChar(Caption), Length(Caption), TextR, DT_CENTER or DT_VCENTER);
??FCanvas.Handle := 0;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
??with TMyCheckBox.Create(Self) do
??begin
? ? Parent := Self;
? ? Left := 0;
??end;
end;

end.

基本上就是这样,但还是有点小问题:
一是画的不好看 二是单击的过快了就....点点看就知道了. 呵.