home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / code / design / vbcal / calender.txt < prev    next >
Text File  |  1995-02-26  |  4KB  |  136 lines
  1. Option Explicit
  2.  
  3. ' Create module global variables
  4. Dim mgiCurrentMonth As Integer
  5. Dim mgiCurrentYear As Integer
  6. Dim mgiCurrentDay As Integer
  7. Dim mgiStartMonth As Integer
  8. Dim mgiStartDay As Integer
  9. Dim mgiStartYear As Integer
  10. Dim mgiStartDOW As Integer ' What day of the week does the 1st fall on
  11. Dim mgiLastDOW As Integer  ' What is the last day of the week
  12. Dim mgsDayNames(0 To 6) As String * 3   ' The names of the days. Change this for different languages
  13. Dim mgsPickDate As String ' This is the global variable used to transfer the date in
  14.  
  15. Sub Calender_DblClick ()
  16. Dim s As String
  17.  
  18.     If Calender.Text <> "" And Calender.CellSelected = True Then
  19.         ' Put the date in a module global varible to be picked up elsewhere
  20.         mgsPickDate = Calender.Text + "/" + Str$(mgiCurrentMonth) + "/" + Str$(mgiCurrentYear)
  21.     End If
  22.  
  23. End Sub
  24.  
  25. Sub DoCalender (lsStartDate As Variant)
  26. Dim lsStartString As String, liX As Integer, liY As Integer
  27.  
  28.     ' Find the first day of the week for the month
  29.     mgiStartMonth = Month(lsStartDate)
  30.     mgiCurrentMonth = mgiStartMonth
  31.     mgiStartYear = Year(lsStartDate)
  32.     mgiCurrentYear = mgiStartYear
  33.     mgiCurrentDay = Day(lsStartDate)
  34.     lsStartString = "1/" + Str$(mgiStartMonth) + "/" + Str$(mgiStartYear)
  35.     mgiStartDOW = Weekday(Format$(lsStartString, "dd/mm/yyyy"))
  36.     DateCaption.Caption = Format$(lsStartDate, "mmmm yyyy")
  37.     
  38.     On Error Resume Next
  39.     For liX = 27 To 32
  40.         lsStartString = Str$(liX) + "/" + Str$(mgiStartMonth) + "/" + Str$(mgiStartYear)
  41.         liY = Weekday(Format$(lsStartString, "dd/mm/yyyy"))
  42.         If Err <> 0 Then
  43.             Err = 0
  44.             Exit For
  45.         End If
  46.     Next liX
  47.     mgiLastDOW = liX - 1
  48.  
  49.     ' Clear out the calender to remove any previous data
  50.     For liX = 0 To 6
  51.         For liY = 1 To 6
  52.             Calender.Col = liX
  53.             Calender.Row = liY
  54.             Calender.Text = ""
  55.         Next liY
  56.     Next liX
  57.  
  58.     ' Now fill in the dates
  59.     Calender.Col = mgiStartDOW - 1 ' Weekdays go 1 to 7, cols go 0 to 6
  60.     Calender.Row = 1
  61.     For liX = 1 To mgiLastDOW
  62.         Calender.Text = liX
  63.         liY = Calender.Col + 1
  64.         If liY = 7 Then
  65.             Calender.Col = 0
  66.             Calender.Row = Calender.Row + 1
  67.         Else
  68.             Calender.Col = Calender.Col + 1
  69.         End If
  70.     Next liX
  71.  
  72.  
  73. End Sub
  74.  
  75. Sub Form_Load ()
  76. Dim liX As Integer
  77.  
  78.     mgsDayNames(0) = "Sun"
  79.     mgsDayNames(1) = "Mon"
  80.     mgsDayNames(2) = "Tue"
  81.     mgsDayNames(3) = "Wed"
  82.     mgsDayNames(4) = "Thu"
  83.     mgsDayNames(5) = "Fri"
  84.     mgsDayNames(6) = "Sat"
  85.  
  86.     ' Set up the calender days
  87.     Calender.Row = 0
  88.     For liX = 0 To 6
  89.         Calender.Col = liX
  90.         Calender.ColAlignment(liX) = 2
  91.         Calender.Text = mgsDayNames(liX)
  92.     Next liX
  93.  
  94. End Sub
  95.  
  96. Sub GetDate_Click ()
  97.     
  98.     GetDate.Enabled = False
  99.     CalenderForm.Visible = True
  100.     mgsPickDate = ""   ' For this demonstration we just test for the date string being there
  101.     DoCalender Now
  102.     Do While mgsPickDate = ""
  103.         DoEvents
  104.     Loop
  105.     CalenderForm.Visible = False
  106.     DateField.Caption = Format$(mgsPickDate, "dd-mmm-yyyy") ' Display the date
  107.     GetDate.Enabled = True
  108.  
  109. End Sub
  110.  
  111. Sub Next_Click ()
  112. Dim ls As String
  113.  
  114.     mgiCurrentMonth = mgiCurrentMonth + 1
  115.     If mgiCurrentMonth = 13 Then
  116.         mgiCurrentMonth = 1
  117.         mgiCurrentYear = mgiCurrentYear + 1
  118.     End If
  119.     ls = Str$(mgiCurrentDay) + "/" + Str$(mgiCurrentMonth) + "/" + Str$(mgiCurrentYear)
  120.     DoCalender ls
  121.  
  122. End Sub
  123.  
  124. Sub Previous_Click ()
  125. Dim ls As String
  126.  
  127.     mgiCurrentMonth = mgiCurrentMonth - 1
  128.     If mgiCurrentMonth = 0 Then
  129.         mgiCurrentMonth = 12
  130.         mgiCurrentYear = mgiCurrentYear - 1
  131.     End If
  132.     ls = Str$(mgiCurrentDay) + "/" + Str$(mgiCurrentMonth) + "/" + Str$(mgiCurrentYear)
  133.     DoCalender ls
  134. End Sub
  135.  
  136.