Delphi 用ToolButton和MonthCalendar实现DateTimePicker的功能

效果图如下:

实现平台: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.
复制代码

 

posted on   癫狂编程  阅读(211)  评论(0编辑  收藏  举报

编辑推荐:
· 浏览器原生「磁吸」效果!Anchor Positioning 锚点定位神器解析
· 没有源码,如何修改代码逻辑?
· 一个奇形怪状的面试题:Bean中的CHM要不要加volatile?
· [.NET]调用本地 Deepseek 模型
· 一个费力不讨好的项目,让我损失了近一半的绩效!
阅读排行:
· 全网最简单!3分钟用满血DeepSeek R1开发一款AI智能客服,零代码轻松接入微信、公众号、小程
· .NET 10 首个预览版发布,跨平台开发与性能全面提升
· 《HelloGitHub》第 107 期
· 全程使用 AI 从 0 到 1 写了个小工具
· 从文本到图像:SSE 如何助力 AI 内容实时呈现?(Typescript篇)
历史上的今天:
2018-12-14 Delphi 使用之连接数据库

导航

< 2025年3月 >
23 24 25 26 27 28 1
2 3 4 5 6 7 8
9 10 11 12 13 14 15
16 17 18 19 20 21 22
23 24 25 26 27 28 29
30 31 1 2 3 4 5
好的代码像粥一样,都是用时间熬出来的
点击右上角即可分享
微信分享提示