Delphi用ToolButton和MonthCalendar实现DateTimePicker的功能

原作者: [db:作者] 来自: [db:来源] 收藏邀请

效果图如下：

实现平台：xp xe2，其中以上功能的实现，核心主要是参考了万一老师的资料，连接：http://www.cnblogs.com/del/archive/2011/05/12/2044112.html

完整代码如下：

unit Unit1;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.ImgList, RzButton,
  Vcl.ExtCtrls, RzPanel, Vcl.StdCtrls;
 
type
  TForm1 = class(TForm)
    ImageList1: TImageList;
    RzToolbar1: TRzToolbar;
    RzToolButton1: TRzToolButton;
    MonthCalendar1: TMonthCalendar;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure RzToolButton1Click(Sender: TObject);
    procedure MonthCalendar1Click(Sender: TObject);
    procedure MonthCalendar1GetMonthBoldInfo(Sender: TObject; Month,
      Year: Cardinal; var MonthBoldInfo: Cardinal);
  private
    { Private declarations }
    procedure MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer);
    procedure MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer);
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  yy,mm,dd: string;  //存年月日
  y1,m1,d1: Word;  //从DecordDate函数解析年月日，然后传值给yy,mm,dd
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  DecodeDate(MonthCalendar1.Date,y1,m1,d1);
  yy := IntToStr(y1);
  mm := IntToStr(m1);
  dd := IntToStr(d1);
  MonthCalendar1.Visible := False;
  RzToolButton1.Caption := DateToStr(MonthCalendar1.Date);
  //TFrom和TMonthCalendar都是由TControl的派生来的，TMonthCalendar通过TForm间接继承OnMouseUp、OnMouseDown属性
  TForm1(MonthCalendar1).OnMouseUp := MouseUp;
  TForm1(MonthCalendar1).OnMouseDown := MouseDown;
end;
 
procedure TForm1.RzToolButton1Click(Sender: TObject);
begin
  MonthCalendar1.Visible := not MonthCalendar1.Visible;
  if MonthCalendar1.Visible then
  begin
    MonthCalendar1.BringToFront;
    Memo1.Align := alRight;
    Memo1.Width := 100;
  end else Memo1.Align := alClient;
end;
 
procedure TForm1.MonthCalendar1Click(Sender: TObject);
begin
  RzToolButton1.Caption := DateToStr(MonthCalendar1.Date);
end;
 
procedure TForm1.MonthCalendar1GetMonthBoldInfo(Sender: TObject; Month,
  Year: Cardinal; var MonthBoldInfo: Cardinal);
begin
  yy := Format('%u',[Year]);
  RzToolButton1.Caption := yy + '-' + mm + '-' + dd;
end;
 
procedure TForm1.MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  DecodeDate(MonthCalendar1.Date,y1,m1,d1);
  dd := IntToStr(d1);
  if Y >= 48 then  //测量所得，单击日历横线下面的区域日历隐藏
  begin
    MonthCalendar1.Visible := False;
    Memo1.Align := alClient;
  end;
end;
 
procedure TForm1.MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer);
begin
  DecodeDate(MonthCalendar1.Date,y1,m1,d1);
  mm := IntToStr(m1);
  //dd := IntToStr(d1);
  RzToolButton1.Caption := DateToStr(MonthCalendar1.Date);
end;
 
end.