home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Programming Tool Box
/
SIMS_2.iso
/
code
/
design
/
vbcal
/
calender.txt
< prev
next >
Wrap
Text File
|
1995-02-26
|
4KB
|
136 lines
Option Explicit
' Create module global variables
Dim mgiCurrentMonth As Integer
Dim mgiCurrentYear As Integer
Dim mgiCurrentDay As Integer
Dim mgiStartMonth As Integer
Dim mgiStartDay As Integer
Dim mgiStartYear As Integer
Dim mgiStartDOW As Integer ' What day of the week does the 1st fall on
Dim mgiLastDOW As Integer ' What is the last day of the week
Dim mgsDayNames(0 To 6) As String * 3 ' The names of the days. Change this for different languages
Dim mgsPickDate As String ' This is the global variable used to transfer the date in
Sub Calender_DblClick ()
Dim s As String
If Calender.Text <> "" And Calender.CellSelected = True Then
' Put the date in a module global varible to be picked up elsewhere
mgsPickDate = Calender.Text + "/" + Str$(mgiCurrentMonth) + "/" + Str$(mgiCurrentYear)
End If
End Sub
Sub DoCalender (lsStartDate As Variant)
Dim lsStartString As String, liX As Integer, liY As Integer
' Find the first day of the week for the month
mgiStartMonth = Month(lsStartDate)
mgiCurrentMonth = mgiStartMonth
mgiStartYear = Year(lsStartDate)
mgiCurrentYear = mgiStartYear
mgiCurrentDay = Day(lsStartDate)
lsStartString = "1/" + Str$(mgiStartMonth) + "/" + Str$(mgiStartYear)
mgiStartDOW = Weekday(Format$(lsStartString, "dd/mm/yyyy"))
DateCaption.Caption = Format$(lsStartDate, "mmmm yyyy")
On Error Resume Next
For liX = 27 To 32
lsStartString = Str$(liX) + "/" + Str$(mgiStartMonth) + "/" + Str$(mgiStartYear)
liY = Weekday(Format$(lsStartString, "dd/mm/yyyy"))
If Err <> 0 Then
Err = 0
Exit For
End If
Next liX
mgiLastDOW = liX - 1
' Clear out the calender to remove any previous data
For liX = 0 To 6
For liY = 1 To 6
Calender.Col = liX
Calender.Row = liY
Calender.Text = ""
Next liY
Next liX
' Now fill in the dates
Calender.Col = mgiStartDOW - 1 ' Weekdays go 1 to 7, cols go 0 to 6
Calender.Row = 1
For liX = 1 To mgiLastDOW
Calender.Text = liX
liY = Calender.Col + 1
If liY = 7 Then
Calender.Col = 0
Calender.Row = Calender.Row + 1
Else
Calender.Col = Calender.Col + 1
End If
Next liX
End Sub
Sub Form_Load ()
Dim liX As Integer
mgsDayNames(0) = "Sun"
mgsDayNames(1) = "Mon"
mgsDayNames(2) = "Tue"
mgsDayNames(3) = "Wed"
mgsDayNames(4) = "Thu"
mgsDayNames(5) = "Fri"
mgsDayNames(6) = "Sat"
' Set up the calender days
Calender.Row = 0
For liX = 0 To 6
Calender.Col = liX
Calender.ColAlignment(liX) = 2
Calender.Text = mgsDayNames(liX)
Next liX
End Sub
Sub GetDate_Click ()
GetDate.Enabled = False
CalenderForm.Visible = True
mgsPickDate = "" ' For this demonstration we just test for the date string being there
DoCalender Now
Do While mgsPickDate = ""
DoEvents
Loop
CalenderForm.Visible = False
DateField.Caption = Format$(mgsPickDate, "dd-mmm-yyyy") ' Display the date
GetDate.Enabled = True
End Sub
Sub Next_Click ()
Dim ls As String
mgiCurrentMonth = mgiCurrentMonth + 1
If mgiCurrentMonth = 13 Then
mgiCurrentMonth = 1
mgiCurrentYear = mgiCurrentYear + 1
End If
ls = Str$(mgiCurrentDay) + "/" + Str$(mgiCurrentMonth) + "/" + Str$(mgiCurrentYear)
DoCalender ls
End Sub
Sub Previous_Click ()
Dim ls As String
mgiCurrentMonth = mgiCurrentMonth - 1
If mgiCurrentMonth = 0 Then
mgiCurrentMonth = 12
mgiCurrentYear = mgiCurrentYear - 1
End If
ls = Str$(mgiCurrentDay) + "/" + Str$(mgiCurrentMonth) + "/" + Str$(mgiCurrentYear)
DoCalender ls
End Sub