VB日历-课程设计报告

1、.课程设计题目 电子台历所选题目：电子台历难度：两星级*知识点：（1）非矩形窗口；（2）动态数组；（3）配置文件的读写；（4）图片的应用；（5）控件数组；（6）弹出式菜单的使用；（7）公共对话框控件；（8）多模块程序设计；（9）日期函数的使用前言“台历”是人们办公、学习的好帮手，人们把它置于案头用来查看日期、星期并可以方便地记事。本题目便编制一个“电子台历”程序，实现台历的一般功能。一、 功能1、 启动程序，显示一个圆角矩形窗口，并自动显示当前月的月历。星期从星期一开始排列，星期六和星期天以不同的颜色显示。2、 鼠标单击可以查看不同的年份和月份（左键增大，右键减小）。单击某个日期会在窗口右半边

2、显示是否有记事。双击左下角的当前日期，可以使台历立即显示当月月历。3、 在窗体的空白处右击，可以弹出一个菜单，可以对显示的日历日期的颜色、字体，窗体的背影图片加以修改。所有颜色、字体和背影图片的设置会自动保存，下次启动时会自动应用上一次的设置。4、 从快捷菜单中选择“添加节日”或“添加记事”，可以分别实现对节日和记事的添加。在弹出的对话框中，能同时添加多个节日或记事。二、 课程设计的详细设计1、 程序的界面要求是圆角矩形窗口，该功能的实现用到了SetWindowRgn函数。SetWindowRgn函数是属于API函数，在使用时要先声明。其代码如下：Private Declare Functio

3、n CreateRoundRectRgn Lib gdi32 (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 LongPrivate Declare Function SetWindowRgn Lib user32 (ByVal hWnd As Long, _ByVal hRgn As Long, ByVal bRedraw As Boolean) As LonghRgn = CreateRoundRectRgn(0

4、, 0, 570, 400, 80, 100) 创建圆角矩形区域Call SetWindowRgn(Me.hWnd, hRgn, True)2、 年份、月份、日期和记事的显示依靠标签的Caption属性。其中，星期和日期的显示使用了控件数组，星期的显示使用了14个控件，日期的显示使用了74个控件。又把各个标签的背影设为透明，这样，便实现了日历界面的显示。3、 为了使文字有浮于图片之上的立体感，使用了内容相同但颜色伸浅不同且位置错开一点的两个控件来实现。功能的实现依靠以下代码：Public Sub GetCaption() 产生标签的文字，达到字体有悬浮的效果 Dim j As Integer

5、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.Captio

6、n = lblShowNote.Caption lblShowNote1.FontName = lblShowNote.FontName For j = 0 To 6 lblWeek(13 - j).FontName = lblWeek(j).FontName NextEnd Sub4、 本程序的主窗口使用了漂亮的图片作背影，样例共提供了4个.bmp格式的图片的加载使用以下代码来实现：Private Sub Pic1_Click() 日历背影图象变化 frmCalMain.Picture = Nothing frmCalMain.Picture = LoadPicture(App.Path &

7、 picsp1.bmp) frmMenu.Pic1.Checked = True frmMenu.Pic2.Checked = False frmMenu.Pic3.Checked = False frmMenu.Pic4.Checked = False strPicName = p1End SubPrivate Sub Pic2_Click() frmCalMain.Picture = Nothing frmCalMain.Picture = LoadPicture(App.Path & picsp2.bmp) frmMenu.Pic2.Checked = True frmMenu.Pic1

8、.Checked = False frmMenu.Pic3.Checked = False frmMenu.Pic4.Checked = False strPicName = p2End SubPrivate Sub Pic3_Click() frmCalMain.Picture = Nothing frmCalMain.Picture = LoadPicture(App.Path & picsp3.bmp) frmMenu.Pic3.Checked = True frmMenu.Pic1.Checked = False frmMenu.Pic2.Checked = False frmMenu

9、.Pic4.Checked = False strPicName = p3End SubPrivate Sub Pic4_Click() frmCalMain.Picture = Nothing frmCalMain.Picture = LoadPicture(App.Path & picsp4.bmp) frmMenu.Pic4.Checked = True frmMenu.Pic1.Checked = False frmMenu.Pic2.Checked = False frmMenu.Pic3.Checked = False strPicName = p4End Sub5、 启动程序和左

10、下角的当前日期要求显示当前月历，该功能的实现应用了两个过程和一个函数来实现：Private Sub DisplayNow() 该过程显示当前日期 Dim dtmNow As Date dtmNow = Date lblYear.Caption = Format(dtmNow, yyyy年) lblMonth.Caption = Format(dtmNow, M月) lblNow.Caption = Format(dtmNow, 今天是：dddddd) strNow = Format(dtmNow, dddddd) 用于存储当前年、月、日字符串 intYear = Val(Format(dtmN

11、ow, yyyy) 用三个变量存储当前年、月、日 intMonth = Val(Format(dtmNow, M) intDay = Val(Format(dtmNow, d) dtmOne = DateAdd(d, (1 - intDay), dtmNow)当前月的第一天 intNum = Days(intYear, intMonth) Call Sort(dtmOne, intNum) 调用过程生成每月的各个日期 使当前日期颜色正确显示 If frmCalMain.lblYear.Caption & frmCalMain.lblMonth.Caption & _ frmCalMain.lb

12、lDay(intNowDayIndex).Caption & 日 = strNow Then frmCalMain.lblDay(intNowDayIndex).ForeColor= frmCalMain.lblNow.ForeColor End IfEnd SubPrivate 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).C

13、aption = Next h intweek = Val(Format(dtm1, w) 计算每月的第一天为星期几 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 & Resourcehand.cur) j = j + 1 i = i + 1 Loop For j = 0 T

14、o 36 If lblDay(j).Caption = ThenlblDay(j).MousePointer = 99使指针边成移动的图形 lblDay(j).MouseIcon=LoadPicture(App.Path&Resourcemove.cur) End If NextEnd SubPrivate 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

15、4 = 0 Then k = 29 Else k = 28 End If Case Else k = 30 End Select Days = kEnd Function6、 本程序使用了配置文件格式来保存关于颜色、字体和图片的设置以及节日和记事内容。配置文件是一种特殊的文本文件，一般以.ini为扩展名，它可以使用记事本打开。因为配置文件的特殊格式，Windows提供了专门的API函数来对起进行读写。该功能的实现用到了以下语句：Private Declare Function WritePrivatePro Lib kernel32 Alias _WritePrivatePro (ByVal

16、lpApplicationName As String, _ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lp As String) As LongPrivate Declare Function GetPrivatePro Lib kernel32 Alias _GetPrivatePro (ByVal lpApplicationName As String, _ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal _lpReturnedString As String,

17、ByVal nSize As Long, ByVal lp As String) As LongDim s As String * 100获得星期一至星期五的颜色参量 Call WritePrivatePro(SetColor, 颜色1, strColor1 App.Path & cal.set)Call GetPrivatePro(SetColor, 颜色1, 0, s, 100, App.Path & cal.set)获得星期的字体参量Dim s As String * 100, strFont1As StringCall WritePrivatePro(SetFont, 字体1, str

18、Font2, App.Path & cal.set)Call GetPrivatePro(SetFont, 字体1, 0, s, 100, App.Path & cal.set)7、 以上的六个过程不是很难，对我来说花是时间最长的是节日和记事的读出。因为节日和记事在记事本中的保存位置不同，一个在节名为Festival中，一个在节名为Note中，而它们要在同一个标签中显示，而且以序号排列。我用了很长时间进行调试来实现了该要求。其代码如下：Private Sub lblDay_Click(Index As Integer) Dim strCaption As String, s1 As Strin

19、g, 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(lbl

20、Year.Caption, 4) & - & Left(lblMonth.Caption, _ InStr(lblMonth.Caption, 月) - 1) & - & lblDay(Index).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 = 显示记事标签标题清空 strCaptio

21、n = lblDay(Index).Caption If strCaption = Then Exit Sub strFest1 = Left(lblMonth.Caption, _ InStr(lblMonth.Caption, 月) - 1) & - & lblDay(Index).Caption Do 此循环用于显示被选择的日期有无记事 i = i + 1 s1 = 节日 & i s2 = Call GetPrivatePro(Festival, s1, 0, s2, 100, App.Path & cal.set) If Trim(Left(s2, InStr(s2, Chr(0) -

22、 1) = 0 Then Exit Do strFestAndDate = Trim(Left(s2, InStr(s2, Chr(0) - 1) strFest2 = Left(strFestAndDate, InStr(strFestAndDate, :) - 1) strFest2保存记事本中已有的日期 strFest = Right(strFestAndDate, Len(strFestAndDate) - InStr(strFestAndDate, :) strFest保存记事本中存储的记事 If strFest2 = strFest1 Then 若条件成立,则被选择的日期有记事 k

23、 = k + 1 strMid = strMid + Chr(13) + Chr(10) + CStr(k) + : + strFest lblShowNote.Caption = strMid strFest2 = End If Loop i = 0If lblShowNote.Caption = Then此循环用于显示被选择的日期有无记事 Do While strDate2 strDate1 i = i + 1 s1 = 记事 & i s2 = Call GetPrivatePro(Note, s1, 0, s2, 100, App.Path & cal.set) If Trim(Left

24、(s2, InStr(s2, Chr(0) - 1) = 0 Then lblShowNote.Caption = strMid + 无记事 Exit Do End If strNoteAndDate = Trim(Left(s2, InStr(s2, Chr(0) - 1) strDate2 = Left(strNoteAndDate, InStr(strNoteAndDate, :) - 1) strDate2保存记事本中已有的日期 strNote = Right(strNoteAndDate, Len(strNoteAndDate) - InStr(strNoteAndDate, :)

25、strNote保存记事本中存储的记事 Loop End If i = 0: j = k Do 此循环用于显示被选择的日期有无记事 i = i + 1 s1 = 记事 & i s2 = Call GetPrivatePro(Note, s1, 0, s2, 100, App.Path & cal.set) If Trim(Left(s2, InStr(s2, Chr(0) - 1) = 0 Then Exit Do strNoteAndDate = Trim(Left(s2, InStr(s2, Chr(0) - 1) strDate2 = Left(strNoteAndDate, InStr(

26、strNoteAndDate, :) - 1) strDate2保存记事本中已有的日期 strNote = Right(strNoteAndDate, Len(strNoteAndDate) - InStr(strNoteAndDate, :) strNote保存记事本中存储的记事 If strDate2 = strDate1 Then 若条件成立,则被选择的日期有记事 j = j + 1 strMid = strMid + Chr(13) + Chr(10) + CStr(j) + : + strNote lblShowNote.Caption = strMid strDate2 = End

27、 If Loop GetCaptionEnd Sub自己认为上述代码还不够简洁，还可以进行修改和简化，由于时间仓促，来不及再进行修改。三、 调试程序的过程1、 在显示当前月的日期时，曾一度发生错误，不容易找到实现该过程的方法。曾经想过运用当前日期所在的标签的Index号然后进行加或减生成各个日期，可是这样调试了好久，不但代码很多，而且该过程不容易实现。最后自己终于找到了一种简便的算法：先运用Format函数得到当前日期，然后生成当前月的第一天，接着计算该天所在标签，得到标签的Index号，最后计算输出当前月的各个日期。这样，整个过程很简洁快速的实现了。2、 在生成矩形窗口时，自己遇到了问题：一

28、个窗口一旦有了菜单，运用SetWindowRgn函数便不好实现对其的剪切，其最后效果因为存在着标题栏（最上部存在一个绿色的长条）而变的难看，不符合要求。自己调试了好久依然不成功。最后自己又增加了一个窗体frmMenu，在该窗体放置了菜单和公共对话框控件。这样之后，当右击主窗体frmCalMain时便弹出frmMenu窗体的菜单。这样，原来可能集中在窗体frmCalMain中的代码便部分转移到了frmMenu窗体中，有利于程序的调试。3、 在编写颜色对话框时不能实现对上一次操作的记忆，自己调试了好久，首先想把在显示当前日期时要求其颜色要保持和lblNow标签的颜色一样，这样增加了设计的难度，因为

29、不知道该日期是星期几，而且，在单击lblYear和lblMonth时要注意颜色的一致性，即月份或年份一旦改变，原来用来显示当前日期的标签的颜色就要可能改变，保持所在星期颜色的一致性。自己调试了好久，运用一个全局变量intNowDayIndex满足了该要求。其具体过程可看附件的代码。4、 当然还有许多问题，像运用CommonDialog的ShowFont属性无用（只要把CommonDialog的Flags属性值设为2），节日和记事不能正确保存（设计时ComboBox的List属性值输入时存在大量的空格）等等小问题，这里就不一一说了。四、 输入输出数据此电子台历几乎没有涉及数据的输入输出，这里也就

30、不在列出。五、 课程设计总结虽然说此电子台历只有两颗星，但我花的时间并不短，算起来，大约有三个星期，这其中有暑假的一个多星期的时间。整体说来，自己还是蛮有成就感的，毕竟自己仅仅是刚学了VB一年。在设计时，许多自己在课堂或考试中没有遇到或接触的东西都是自己看书解决的，这样使得自己感到在VB上的知识又掌握了许多。正如老师说的，VB课程设计关键是训练学生把所学知识运用到实践当中去，自己在课堂上学到了什么，就真正掌握了什么。自己本来就梦想要自己编制属于自己的程序，可以说，自己的梦想已经实现，自己确实感到很高兴。六、 附件电子台历源代码：frmCalMain窗体：Option ExplicitOptio

31、n Base 1Private dtmOne As Date, lngMidColor As Long, strNow As String, LocalMousePlaceX As SinglePrivate strSatColor As String, strSunColor As String, strMtoFColor As String, LocalMousePlaceY As SinglePublic intMonth As Integer, intNum As Integer, intNowDayIndex As IntegerPublic intYear As Integer,

32、intDay As IntegerAPI函数的声明Private Declare Function CreateRoundRectRgn Lib gdi32 (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 LongPrivate Declare Function SetWindowRgn Lib user32 (ByVal hWnd As Long, _ByVal hRgn As Long, ByVal bRedra

33、w As Boolean) As LongPrivate Declare Function WritePrivatePro Lib kernel32 Alias _WritePrivatePro (ByVal lpApplicationName As String, _ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lp As String) As LongPrivate Declare Function GetPrivatePro Lib kernel32 Alias _GetPrivatePro (ByVal lpApplicati

34、onName As String, _ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal _lpReturnedString As String, ByVal nSize As Long, ByVal lp As String) As LongPrivate 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 各个

35、日期标签标题清空 lblDay(h).Caption = Next h intweek = Val(Format(dtm1, w) 计算每月的第一天为星期几 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 & Resourcehand.cur) 使指针变成手的图形 j = j + 1 i = i

36、+ 1 Loop For j = 0 To 36 If lblDay(j).Caption = Then lblDay(j).MousePointer = 99 lblDay(j).MouseIcon = LoadPicture(App.Path & Resourcemove.cur) 使指针边成移动的图形 End If NextEnd SubPrivate Sub DisplayNow() 该过程显示当前日期 Dim dtmNow As Date dtmNow = Date lblYear.Caption = Format(dtmNow, yyyy年) lblMonth.Caption =

37、Format(dtmNow, M月) lblNow.Caption = Format(dtmNow, 今天是：dddddd) strNow = Format(dtmNow, dddddd) 用于存储当前年、月、日字符串 intYear = Val(Format(dtmNow, yyyy)用三个变量存储当前的年、月、日 intMonth = Val(Format(dtmNow, M) intDay = Val(Format(dtmNow, d) dtmOne = DateAdd(d, (1 - intDay), dtmNow) 当前月的第一天 intNum = Days(intYear, int

38、Month) Call Sort(dtmOne, intNum) 调用过程生成每月的各个日期 使当前日期颜色正确显示 If frmCalMain.lblYear.Caption & frmCalMain.lblMonth.Caption & _ frmCalMain.lblDay(intNowDayIndex).Caption & 日 = strNow Then frmCalMain.lblDay(intNowDayIndex).ForeColor= frmCalMain.lblNow.ForeColor End IfEnd SubPublic Sub GetCaption() 产生标签的文字

39、，达到字体有悬浮的效果 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).Cap

40、tion Next lblShowNote1.Caption = lblShowNote.Caption lblShowNote1.FontName = lblShowNote.FontName For j = 0 To 6 lblWeek(13 - j).FontName = lblWeek(j).FontName NextEnd SubPrivate Sub ShowNowColor() 此过程显示当前日期的颜色 Dim i As Integer If lblYear.Caption & lblMonth.Caption & lblDay(intNowDayIndex).Caption &

41、 日 = strNow Then lblDay(intNowDayIndex).ForeColor = frmCalMain.lblNow.ForeColor Else Select Case intNowDayIndex Case 5, 12, 19, 2, 633 lblDay(intNowDayIndex).ForeColor = CLng(strSatColor) Case 6, 13, 20, 27, 34 lblDay(intNowDayIndex).ForeColor = CLng(strSunColor) Case Else lblDay(intNowDayIndex).For

42、eColor = CLng(strMtoFColor) End Select End IfEnd SubPrivate 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 = kEnd FunctionPublic Sub

43、 GetShowNowLblelIndex()此过程可获得当前日子所在标签的Index号 Dim i As Integer For i = 0 To 36 If frmCalMain.lblDay(i).Caption = CStr(frmCalMDay) Then intNowDayIndex = i Exit For End If NextEnd SubPrivate Sub Form_Load() Dim i As Integer, s2 As String Dim hRgn As Long, s As String * 100, strWeekFont As String

44、 Dim strTodayColor As String, strHeadColor As String, strTodayFont As String Dim strNoteColor As String, strNoteFont As String, strHeadFont As String DisplayNow 调用过程显示当前日期 GetShowNowLblelIndex 获得当前日子所在标签的Index号 # 各标签获得颜色参量 # Call GetPrivatePro(SetColor, 颜色1, 0, s, 100, App.Path & cal.set) strMtoFCol

45、or = Trim(Left(s, InStr(s, Chr(0) - 1) 获得星期一至星期五的颜色参量 For i = 0 To 36 frmCalMain.lblDay(i).ForeColor = CLng(strMtoFColor)字体颜色的获取 Select Case i Case 4, 11, 18, 25, 32 i = i + 2 End Select Next Call GetPrivatePro(SetColor, 颜色2, 0, s, 100, App.Path & cal.set) strSatColor = Trim(Left(s, InStr(s, Chr(0)

46、- 1) 获得星期六的颜色参量 For i = 5 To 33 Step 7 If i = intNowDayIndex Then i = i + 7 frmCalMain.lblDay(i).ForeColor = CLng(strSatColor) Next Call GetPrivatePro(SetColor, 颜色3, 0, s, 100, App.Path & cal.set) strSunColor = Trim(Left(s, InStr(s, Chr(0) - 1) 获得星期天的颜色参量 For i = 6 To 34 Step 7 If i = intNowDayIndex

47、 Then i = i + 7 frmCalMain.lblDay(i).ForeColor = CLng(strSunColor) Next Call GetPrivatePro(SetColor, 颜色4, 0, s, 100, App.Path & cal.set) strTodayColor = Trim(Left(s, InStr(s, Chr(0) - 1) 获得颜色参量 frmCalMain.lblNow.ForeColor = CLng(strTodayColor) frmCalMain.lblDay(intNowDayIndex).ForeColor = CLng(strTo

48、dayColor) Call GetPrivatePro(SetColor, 颜色5, 0, s, 100, App.Path & cal.set) strHeadColor = Trim(Left(s, InStr(s, Chr(0) - 1) 获得颜色参量 frmCalMain.lblYear.ForeColor = CLng(strHeadColor) frmCalMain.lblMonth.ForeColor = CLng(strHeadColor) For i = 0 To 6 frmCalMain.lblWeek(i).ForeColor = CLng(strHeadColor)

49、Next Call GetPrivatePro(SetColor, 颜色6, 0, s, 100, App.Path & cal.set) strNoteColor = Trim(Left(s, InStr(s, Chr(0) - 1) 获得颜色参量 frmCalMain.lblShowNote.ForeColor = CLng(strNoteColor) Call GetPrivatePro(Pic, 图片, 0, s, 100, App.Path & cal.set) frmMenu.strPicName = Trim(Left(s, InStr(s, Chr(0) - 1) 保存记事本的图片信息不丢失,在窗体frmMenu的Exit的单击事件中用到该变量 s2 = CStr(App.Path & & Pics & & Trim(Left(s, InStr(s, Chr(0) - 1) 保存最近一次操作所得的背影图片的地址 frmCalMain.Picture = LoadPicture(s2 & .bmp) 下载背影图片 # 获得各个标签的字体类型 # Call GetPrivatePro(SetFont, 字体1, 0, s, 100, App.Path & cal.set) strWeekFont = CStr(Trim(Left(s, InStr(s, Chr(0