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

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


实现：


测试代码：


简单搞定。

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

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

强！！！

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

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.

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