TDateTimePicker的CheckBox框绘制

当DateTimePicker高X 2 – 8 = 宽（这里指的是控件的Height和Width）时，CheckBox刚好容纳在DateTimePicker里面，与上、左相距4 PX，与下相距5PX，把DateTimePicker的颜色属性换成非白色的，更好观察。如图1所示：

当宽度再增加，而高度不变，那么CheckBox也将不变。如图2所示：

当高度变高了，而宽度不变，那么CheckBox将大小不变，位置居中，如图3所示：

那么，相关的伪代码就可以表示如下：

01 02 03 04 05 06 07 08 09 10 11

If H * 2 – 8 < = W Then  Begin    CheckBox边长 = H – 9             起点(2, 2)  End  Else  Begin    CheckBox边长 = (W + 8) div 2 – 9            起点(2, (H – 1 – 边长) div 2 - 1)  End

对于CheckBox里的打钩√，并不好绘制，在这里以颜色来填充，关键函数FloodFill填充画布的区域。对于不同的边长，边框的厚度不同，如表所举例：

边长	边框厚度(左下右上)	第一点位置
23	2,2,2,2	(5,10)
24	4,4,4,3	(9,9)
25	4,4,4,4	(9,10)
40	6,6,6,5	(13,15)
41	6,6,6,6	(13,15)
56	8,8,8,7	(17,20)
57	8,8,8,8	(17,21)
…	…	…

我们必须先把内边框填充成背景色（最外的边框不能被填充），伪代码如下所示：

01 02 03 04 05 06 07 08 09 10 11

If 边长 – 24 < 0 then  Begin    边框 = 2 – 1    End  Else  Begin    边框 = ((边长 – 24) div 16 + 2) * 2 - 1  End  FrameRect最外框  FillRect上左下右四个内边框  FloodFill背景色填充成其他颜色

若是要改变√checked的颜色，则亦可用FloodFill函数，需要确定有一点一定在checked里面，checked的第一点的X坐标有规律变化，而根据CheckBox高度的不同，在第一点那一列，都一定有Y坐标是高度的一半，在Checked上，伪代码如下：

1 2 3 4 5 6 7 8 9

If 边长 – 24 < 0 then  Begin    X = 5 - 1  End  Else  Begin    X = ((边长 – 24) div 16 + 1) * 4 + 5 - 1  End  FloodFill(起点+ X, 起点 + (高度) div 2, Pixels[起点+ X, 起点 + (高度) div 2], fsSurface);

完整代码如下：

01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62

procedure WMPAINT(var Msg : TMessage); message WM_PAINT;    procedure TDateTimePickerEx.WMPAINT(var Msg: TMessage);  begin    inherited;    DrawCheckBox;  end;    procedure TDateTimePickerEx.DrawCheckBox;  var    Canvas: TControlCanvas;    RC: TRect;    CBLength, CBBorder, X: Integer;  begin    if ShowCheckbox then    begin      Canvas := TControlCanvas.Create;      try        Canvas.Control := Self;        if Height * 2 - 8 <= Width then        begin          CBLength := Height - 9;          RC := Rect(2, 2, 2 + CBLength, 2 + CBLength);        end        else        begin          CBLength := (Width + 8) div 2 - 9;          RC := Rect(2, (Height - 1 - CBLength) div 2 - 1,                     2 + CBLength, (Height - 2 - CBLength) div 2 - 1 + CBLength);        end;        if CBLength - 24 < 0 then          CBBorder := 2 - 1        else          CBBorder := ((CBLength - 24) div 16 + 2) * 2 - 1;        with Canvas do        begin          Brush.Color := RGB(144,180,228);          FrameRect(RC);          Brush.Color := Color;          InflateRect(RC, -1, -1);          FillRect(Rect(RC.Left, RC.Top, RC.Right, RC.Top + CBBorder));          FillRect(Rect(RC.Left, RC.Top, RC.Left + CBBorder, RC.Bottom));          FillRect(Rect(RC.Left, RC.Bottom - CBBorder, RC.Right, RC.Bottom));          FillRect(Rect(RC.Right - CBBorder, RC.Top, RC.Right, RC.Bottom));          Brush.Color := RGB(228,240,253);          FloodFill(RC.Left, RC.Top, Pixels[RC.Left, RC.Top],fsSurface);          if Checked then          begin            if CBLength - 24 < 0 then              X := 5 - 1            else              X := ((CBLength - 24) div 16 + 1) * 4 + 5 - 1;            Brush.Color := RGB(144,180,228);            FloodFill(RC.Left + X, RC.Top + (RC.Bottom - RC.Top) div 2,                      Pixels[RC.Left + X, RC.Top + (RC.Bottom - RC.Top) div 2], fsSurface);          end;        end;      finally        FreeAndNil(Canvas);      end;       end;  end;

运行截图如下：