效果图如下:

实现平台: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.

 

Delphi 用ToolButton和MonthCalendar实现DateTimePicker的功能的更多相关文章

  1. GDI+在Delphi程序的应用 Photoshop色相饱和度明度功能

    本文用GDI+实现Photoshop色相/饱和度/明度功能,参照我的其它有关GDI+在 Delphi程序的应用的文章,代码也可供TBitmap使用. 有些人不喜欢,或者不太懂Delphi的BASM代码 ...

  2. Delphi数据库技术中Disablecontrols和Enablecontrols的功能

    一般来说,用来扫描整个数据库表并修改每个记录的某一个字段的程序如下所示: with Table Do begin DisableControls;{在修改记录的过程中,使其它部件无效} First; ...

  3. delphi datetimepicker 修改时间无效问题

    今天用delphi写个程序,使用datetimepicker获得想要的时间.蛋疼的问题是无论怎么调整明明看着控件里面的日期变了,但是show出来的datetimepicker.datetime日期都不 ...

  4. delphi中DateTimePicker控件同时输入日期和时间

    将DateTimePicker的Format属性中加入日期格式设成 'yyyy-MM-dd HH:mm',注意大小写 , 将kind设置为dtkTime即可,可以在每次Form onShow时将Dat ...

  5. DELPHI实现关闭指定进程,自身防杀

    偶然翻到很久以前用DELPHI写的一个小程序,实现功能是在后台默默关闭符合条件的进程,并隐藏自身.编写目的是为了防止办公电脑运行游戏. 实现原理是: 1.程序运行后将自身以不同的名称一式三份存到系统各 ...

  6. Delphi XE5 常见问题解答

    Delphi XE5 常见问题解答 有关于新即时试用的问题吗?请看看 RAD Studio 即时试用常见问答. 常见问题 什么是 Delphi? Embarcadero? Delphi? XE5 是易 ...

  7. 我常用的delphi 第三方控件

    转载:http://www.cnblogs.com/xalion/archive/2012/01/09/2317246.html 有网友问我常用的控件及功能.我先大概整理一下,以后会在文章里面碰到时再 ...

  8. Delphi 程序结构

    注:该内容整理自以下链接. http://www.cnblogs.com/hackpig/archive/2010/02/15/1668513.html 概要介绍:Object Pascal语言的结构 ...

  9. delphi一些小技巧 从别处看到

    开发环境--------    Delphi 7是一个很经典的版本,在Win2000/XP下推荐安装Delphi 7来开发软件,在Vista下推荐使用Delphi 2007开发软件.安装好Delphi ...

随机推荐

  1. mysql数据库操作语句大全

    一 . 常用mysql命令行命令 1 .启动MYSQL服务  net start mysql 停止MYSQL服务  net stop mysql 2 . netstat –na | findstr 3 ...

  2. Linux2.6内核--内存管理(2)--区

    由于硬件的限制,内核不能对所有的页一视同仁.有些页位于内存中的特定物理地址上,所以,不能将其用于一些特别的任务.(关于内存分页机制可以查看:http://blog.csdn.net/dlutbruce ...

  3. 【HDOJ】3459 Rubik 2×2×2

    模拟+DFS. /* 3459 */ #include <cstdio> #include <cstring> #include <cstdlib> #define ...

  4. ZOJ 3469 Food Delivery

    题目大意: 有n个人,住在一条直线上.第i个人的坐标是Xi,街上有个外卖餐馆的位置是X,现在餐厅工作人员要给街上的每个人送饭,送完之后再回到餐厅,送饭人的速度是V,每个人有个不满意值,当这个人送餐时间 ...

  5. (转载)MySQL中执行sql语句反斜杠需要进行转义否则会被吃掉

    (转载)http://www.phpcode8.com/lamp/mysql-lamp/mysql-escape-slash.html 最近在执行一个sql备份的还原后,发现系统的部分路径找不到,于是 ...

  6. 动态规划 计数型DP:dobra

    令人愉快的单词(dobra)时间限制: 0.1 秒空间限制: 32 MB [问题描述]Lea 在她的一生中碰到过很多单词.其中的很大一部分都使她不愉快.作为补偿,她开始创造一些愉快的单词. Lea 通 ...

  7. ScrollView自动滑到底部

    // 自动滑动到底部 mScrollView.post(new Runnable() { @Override public void run() { mScrollView.fullScroll(Sc ...

  8. ZOJ1025-最长下降子序列

    ZOJ1025-Wooden Sticks 加工木棒问题 [问题描述] 现有n根木棒,已知它们的长度和重量.要用一部木工机一根一根地加工这些木棒.该机器在加工过程中需要一定的准备时间用于清洗机器.调整 ...

  9. legoblock秀上限

    很久没有做题了,前天做了一道题结果弱的一逼...搜了解题报告不说...还尼玛秀了上限 题意: 给出宽和高为n和m的一堵墙,手上有长为1,2,3,4高均为1的砖,问形成一个坚固的墙有多少种做法. 坚固的 ...

  10. python 解析xml 文件: Element Tree 方式

    环境 python:3.4.4 准备xml文件 首先新建一个xml文件,countries.xml.内容是在python官网上看到的. <?xml version="1.0" ...