第1个回答 2008-06-25
这是我自己编的一个万年历的小程序。你看看有没有用?
\\\'在窗体上有如下控件:
\\\'picDate,picturebox
\\\'lblD(0 to 34),label,每行7个,5行
\\\'Shape1
还有其他一些标题性的控件,你自己安排吧!
Sub AddDAte()
Dim R, intWekV As Integer
Dim strWekV As String
For R = 0 To 34
lblD(R).Caption = ""
lblD(R).BackColor = vbWhite
Next
\\\'Shape1.Visible = False
Dim qaa As Integer
Dim t, d As Integer
Dim e As Date
e = DateSerial(YearV, MonthV, 1)
qaa = DatePart("w", e)
\\\'e = "1" & "-" & CStr(strMoto(MonthV)) & "-" & YearV
\\\'qaa = DatePart("w", CDate(e))
t = qaa - 1
For d = 1 To Day(DateSerial(YearV, MonthV + 1, 1) - 1)
If t > 34 Then t = 0
lblD(t).Caption = d
lblD(t).Enabled = True
If t = 0 Or t = 7 Or t = 14 Or t = 21 Or t = 28 Or t = 6 Or t = 13 Or t = 20 Or t = 27 Or t = 34 Then lblD(t).ForeColor = &HFF&
If d = Day(Now) And MonthV = Month(Now) And YearV = Year(Now) Then
Shape1.Visible = True
Shape1.Move lblD(t).Left - 230, lblD(t).Top - 60, 550, 305
intWekV = t Mod 7
Select Case intWekV
Case 0
strWekV = "星期日"
Case 1
strWekV = "星期一"
Case 2
strWekV = "星期二"
Case 3
strWekV = "星期三"
Case 4
strWekV = "星期四"
Case 5
strWekV = "星期五"
Case 6
strWekV = "星期六"
End Select
\\\' txtRemarkDate(1).Text = Year(Now) & "年" & Month(Now) & "月" & Day(Now) & "日, " & strWekV
End If
t = t + 1
Next
LblToday.Caption = "今天:" & Year(Now) & "-" & Month(Now) & "-" & Day(Now) & " "
For t = 0 To 34
If lblD(t).Caption = "" Then lblD(t).Enabled = False
Next
End Sub