课程设计题目 电子台历
所选题目：电子台历 难度：两星级**
知识点：（1）非矩形窗口；（2）动态数组；（3）配置文件的读写；（4）图片的
应用；（5）控件数组；（6）弹出式菜单的使用；（7）公共对话框控件；（8）多模块程序设计；（9）日期函数的使用
前言
“台历”是人们办公、学习的好帮手，人们把它置于案头用来查看日期、星期并可以方便地记事。本题目便编制一个“电子台历”程序，实现台历的一般功能。
一、 功能
1、启动程序，显示一个圆角矩形窗口，并自动显示当前月的月历。星期从
星期一开始排列，星期六和星期天以不同的颜色显示。
2、鼠标单击可以查看不同的年份和月份（左键增大，右键减小）。单击某个
日期会在窗口右半边显示是否有记事。双击左下角的当前日期，可以使台历立即显示当月月历。
3、在窗体的空白处右击，可以弹出一个菜单，可以对显示的日历日期的颜
色、字体，窗体的背影图片加以修改。所有颜色、字体和背影图片的设置会自动保存，下次启动时会自动应用上一次的设置。 4、从快捷菜单中选择“添加节日”或“添加记事”，可以分别实现对节日和
记事的添加。在弹出的对话框中，能同时添加多个节日或记事。
二、 课程设计的详细设计
1、程序的界面要求是圆角矩形窗口，该功能的实现用到了SetWindowRgn
函数。SetWindowRgn函数是属于API函数，在使用时要先声明。其代码如下：
Private Declare Function CreateRoundRectRgn Lib \(ByVal X1 As Long, _
ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, _ ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function SetWindowRgn Lib \(ByVal hWnd As Long, _
ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
hRgn = CreateRoundRectRgn(0, 0, 570, 400, 80, 100) '创建圆角矩形区域 Call SetWindowRgn(Me.hWnd, hRgn, True)
2、年份、月份、日期和记事的显示依靠标签的Caption属性。其中，星期和
日期的显示使用了控件数组，星期的显示使用了14个控件，日期的显示使用了74个控件。又把各个标签的背影设为透明，这样，便实现了日历界面的显示。
3、为了使文字有浮于图片之上的立体感，使用了内容相同但颜色伸浅不同
且位置错开一点的两个控件来实现。功能的实现依靠以下代码：
Public Sub GetCaption() '产生标签的文字，达到字体有悬浮的效果 Dim j As Integer
lblYear1.Caption = lblYear.Caption
lblYear1.FontName = lblYear.FontName lblMonth1.Caption = lblMonth.Caption
lblMonth1.FontName = lblMonth.FontName lblNow1.Caption = lblNow.Caption
lblNow1.FontName = lblNow.FontName For j = 37 To 73
lblDay(j).Caption = lblDay(73 - j).Caption Next
lblShowNote1.Caption = lblShowNote.Caption
lblShowNote1.FontName = lblShowNote.FontName For j = 0 To 6
lblWeek(13 - j).FontName = lblWeek(j).FontName Next End Sub
4、本程序的主窗口使用了漂亮的图片作背影，样例共提供了4个.bmp格式
的图片的加载使用以下代码来实现：
Private Sub Pic1_Click() '日历背影图象变化 frmCalMain.Picture = Nothing
frmCalMain.Picture = LoadPicture(App.Path & \ frmMenu.Pic1.Checked = True frmMenu.Pic2.Checked = False frmMenu.Pic3.Checked = False frmMenu.Pic4.Checked = False strPicName = \End Sub
Private Sub Pic2_Click()
frmCalMain.Picture = Nothing
frmCalMain.Picture = LoadPicture(App.Path & \ frmMenu.Pic2.Checked = True frmMenu.Pic1.Checked = False frmMenu.Pic3.Checked = False frmMenu.Pic4.Checked = False strPicName = \End Sub
Private Sub Pic3_Click()
frmCalMain.Picture = Nothing
frmCalMain.Picture = LoadPicture(App.Path & \ frmMenu.Pic3.Checked = True frmMenu.Pic1.Checked = False frmMenu.Pic2.Checked = False frmMenu.Pic4.Checked = False strPicName = \End Sub
Private Sub Pic4_Click()
frmCalMain.Picture = Nothing
frmCalMain.Picture = LoadPicture(App.Path & \ frmMenu.Pic4.Checked = True frmMenu.Pic1.Checked = False frmMenu.Pic2.Checked = False frmMenu.Pic3.Checked = False strPicName = \End Sub
5、启动程序和左下角的当前日期要求显示当前月历，该功能的实现应用了
两个过程和一个函数来实现：
Private Sub DisplayNow() '该过程显示当前日期 Dim dtmNow As Date dtmNow = Date
lblYear.Caption = Format(dtmNow, \年\ lblMonth.Caption = Format(dtmNow, \月\
lblNow.Caption = Format(dtmNow, \今天是：dddddd\
strNow = Format(dtmNow, \用于存储当前年、月、日字符串 intYear = Val(Format(dtmNow, \用三个变量存储当前年、月、日 intMonth = Val(Format(dtmNow, \ intDay = Val(Format(dtmNow, \
dtmOne = DateAdd(\当前月的第一天 intNum = Days(intYear, intMonth)
Call Sort(dtmOne, intNum) '调用过程生成每月的各个日期 '使当前日期颜色正确显示
If frmCalMain.lblYear.Caption & frmCalMain.lblMonth.Caption & _ frmCalMain.lblDay(intNowDayIndex).Caption & \日\ frmCalMain.lblDay(intNowDayIndex).ForeColor=
frmCalMain.lblNow.ForeColor
End If End Sub
Private Sub Sort(dtm1 As Date, int1 As Integer) '该过程生成每月的各个日期 Dim intweek As Integer, i As Integer, j As Integer Dim h As Integer
For h = 0 To 36 '各个日期标签标题清空 lblDay(h).Caption = \
Next h
intweek = Val(Format(dtm1, \ '计算每月的第一天为星期几 If intweek - 1 > 0 Then i = intweek - 2 Else
i = 6 End If j = 0
Do While j < int1
lblDay(i).Caption = j + 1 lblDay(i).MousePointer = 99 '使指针变成手的图形
lblDay(i).MouseIcon = LoadPicture(App.Path & \ j = j + 1 i = i + 1 Loop
For j = 0 To 36
If lblDay(j).Caption = \
lblDay(j).MousePointer = 99 '使指针边成移动的图形
lblDay(j).MouseIcon=LoadPicture(App.Path&\
End If
Next End Sub
Private Function Days(intY As Integer, intM As Integer) '该函数计算每月天数 Dim k As Integer Select Case intM
Case 1, 3, 5, 7, 8, 10, 12 k = 31 Case 2
If intY Mod 4 = 0 Then k = 29 Else
k = 28 End If Case Else k = 30 End Select Days = k End Function
6、本程序使用了配置文件格式来保存关于颜色、字体和图片的设置以及节
日和记事内容。配置文件是一种特殊的文本文件，一般以.ini为扩展名，它可以使用记事本打开。因为配置文件的特殊格式，Windows提供了专门的API函数来对起进行读写。该功能的实现用到了以下语句：
Private Declare Function WritePrivateProfileString Lib \\
ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileString Lib \\ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal _
lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Dim s As String * 100
'获得星期一至星期五的颜色参量
Call WritePrivateProfileString(\\颜色1, strColor1 App.Path & \
Call GetPrivateProfileString(\\颜色1, \s, 100, App.Path & \
'获得星期的字体参量
Dim s As String * 100, strFont1As String
Call WritePrivateProfileString(\\字体1, strFont2, App.Path & \
Call GetPrivateProfileString(\\字体1, \s, 100, App.Path & \
7、以上的六个过程不是很难，对我来说花是时间最长的是节日和记事的读
出。因为节日和记事在记事本中的保存位置不同，一个在节名为Festival中，一个在节名为Note中，而它们要在同一个标签中显示，而且以序号排列。我用了很长时间进行调试来实现了该要求。其代码如下： Private Sub lblDay_Click(Index As Integer)
Dim strCaption As String, s1 As String, strFest As String Dim s2 As String * 100, strNote As String, strFest1 As String Dim strMid As String, strDate1 As String, strFest2 As String
Dim strDate2 As String, strNoteAndDate As String, strFestAndDate As String
Dim i As Integer, j As Integer, k As Integer 'strDate1保存被选择的日期
strDate1 = Left(lblYear.Caption, 4) & \ InStr(lblMonth.Caption, \月\
strMid = strDate1 + Chr(32) + Chr(32) + Chr(32) + Chr(32) + Chr(32) + _
Chr(32) + Chr(32) + Chr(32) + Chr(32) + Chr(32) + Chr(32) + Chr(32) + Chr(32)
lblShowNote.Caption = \ '显示记事标签标题清空 strCaption = lblDay(Index).Caption If strCaption = \ strFest1 = Left(lblMonth.Caption, _
VB日历-课程设计报告
