哪里有日期控件

我自己画过一个，不过没写成控件的形式。用的是TStrinGGrid.
代码如下。
unit SG;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, StdCtrls, Buttons, ExtCtrls;type
  Tfrm_calendar = class(TForm)
    Panel1: TPanel;
    BitBtn1: TBitBtn;
    Panel2: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    Panel3: TPanel;
    Label5: TLabel;
    Label6: TLabel;
    Panel4: TPanel;
    SG: TStringGrid;
    procedure FormCreate(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure SGDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
      State: TGridDrawState);
  private
    { Private declarations }
  public
    cell_string: array of TStringList ;
    cell_color:array of TColor ;
    procedure set_colorA;
    procedure clear_SG;
    function DaysInMonth(ADate:TDateTime):integer;
    procedure insert_date_inSG(vYear,vMonth:string);
    { Public declarations }
  end;var
  frm_calendar: Tfrm_calendar;implementation{$R *.dfm}
procedure Tfrm_calendar.clear_SG ;
var
  i,j:integer;
begin
  for i:=0 to SG.ColCount-1 do
    for j:=1 to SG.RowCount-1 do
      SG.Cells[i,j]:='';
end;function Tfrm_calendar.DaysInMonth(ADate:TDateTime):integer;
var
  MyMonth,
  MyYear,
  MyDay : Word;
  MyDayTable : TDayTable;
  tmpBool : Boolean;
begin
  DecodeDate(ADate, MyYear, MyMonth, MyDay);
  tmpBool := IsLeapYear(MyYear);
  MyDayTable := MonthDays[tmpBool];
  Result := MyDayTable[MyMonth];
end;procedure Tfrm_calendar.insert_date_inSG(vYear,vMonth:string);
var
  vdate:tdatetime;
  i,v_row,vdays:integer;
  v_word:word;
begin
  clear_SG ;
  vdate:=strtodate(vYear+'-'+vMonth+'-1');
  vdays:=DaysInMonth(vDate);
  v_row:=1;
  for i:=1 to vdays do
  begin
    v_word:=DayOfWeek(strtodatetime(vYear+'-'+vMonth+'-'+inttostr(i)));
    case v_word of
    1: sg.Cells[0,v_row]:=inttostr(i);
    2: sg.Cells[1,v_row]:=inttostr(i);
    3: sg.Cells[2,v_row]:=inttostr(i);
    4: sg.Cells[3,v_row]:=inttostr(i);
    5: sg.Cells[4,v_row]:=inttostr(i);
    6: sg.Cells[5,v_row]:=inttostr(i);
    7:begin
      sg.Cells[6,v_row]:=inttostr(i);
      v_row:=v_row+1;
      end;
  end;
  end;
end;procedure Tfrm_calendar.FormCreate(Sender: TObject);
begin
  set_colorA ;
  SG.Cells[0,0]:='星期一';
  SG.Cells[1,0]:='星期二';
  SG.Cells[2,0]:='星期三';
  SG.Cells[3,0]:='星期四';
  SG.Cells[4,0]:='星期五';
  SG.Cells[5,0]:='星期六';
  SG.Cells[6,0]:='星期天';
  Label6.Caption :=DateToStr(date);
  Label3.Caption :=inttostr(strtoint(FormatDateTime('yyyy',date)));
  label4.Caption :=inttostr(Strtoint(FormatDateTime('mm',date)));
  insert_date_inSG(Label3.Caption,Label4.Caption);
end;procedure Tfrm_calendar.BitBtn1Click(Sender: TObject);
begin
  Label3.Caption :=inttostr(strtoint(label3.caption)-1);
  insert_date_inSG(label3.Caption,label4.Caption);
end;procedure Tfrm_calendar.BitBtn2Click(Sender: TObject);
begin
  Label3.Caption :=inttostr(strtoint(label3.caption)+1);
  insert_date_inSG(label3.Caption,label4.Caption);
end;procedure Tfrm_calendar.BitBtn4Click(Sender: TObject);
begin
  if label4.Caption = '1' then
    begin
    label4.Caption := '12';
    Label3.Caption :=inttostr(strtoint(label3.caption)-1);
    end
  else Label4.Caption :=inttostr(strtoint(label4.caption)-1);
  insert_date_inSG(label3.Caption,label4.Caption);
end;procedure Tfrm_calendar.BitBtn3Click(Sender: TObject);
begin
  if label4.Caption = '12' then
    begin
    label4.Caption := '1';
    Label3.Caption :=inttostr(strtoint(label3.caption)+1);
    end
  else Label4.Caption :=inttostr(strtoint(label4.caption)+1);
  insert_date_inSG(label3.Caption,label4.Caption);
end;procedure Tfrm_calendar.SGDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  i,k:integer;
begin
  if sg.Cells[acol,arow] <> '' then
  for i:=0 to 4 do
    for k:=0 to cell_string[i].Count-1 do
    if sg.Cells[acol,arow] = cell_string[i].Strings[k] then
    begin
      sg.Canvas.Brush.Color :=cell_color[i];
      sg.Canvas.Font.Color :=clwhite;
      sg.Canvas.TextRect(rect,rect.left+2,rect.Top +2,sg.Cells[acol,arow]);
    end;
end;procedure Tfrm_calendar.set_colorA;
var
  i:integer;
begin
  setlength(cell_string,5);
  setlength(cell_color,5);
  for i:=0 to 4 do
    cell_string[i]:=tstringlist.Create ;
  cell_color[0]:=clRed ;
  cell_color[1]:=clSilver ;
  cell_color[2]:=clPurple ;
  cell_color[3]:=clblue;
  cell_color[4]:=clBlack;
  cell_string[0].Add('1');
  cell_string[0].Add('4');
  cell_string[0].Add('8');
  cell_string[1].Add('3');
  cell_string[1].Add('9');
  cell_string[1].Add('10');
  cell_string[1].Add('16');
  cell_string[2].Add('2');
  cell_string[2].Add('11');
  cell_string[2].Add('17');
  cell_string[3].Add('23');
  cell_string[3].Add('27');
  cell_string[3].Add('14');
  cell_string[3].Add('16');
  cell_string[3].Add('18');
  cell_string[4].Add('4');
  cell_string[4].Add('5');
  cell_string[4].Add('7');
  cell_string[4].Add('6');
end;end.