home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / VISUAL_B / CODIGO_2 / VB_CAL1 / CALENDER.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1993-07-06  |  7.8 KB  |  232 lines
  1. VERSION 2.00
  2. Begin Form Calender 
  3.    BackColor       =   &H00C0C0C0&
  4.    Caption         =   "Calender"
  5.    ClientHeight    =   5685
  6.    ClientLeft      =   90
  7.    ClientTop       =   375
  8.    ClientWidth     =   6315
  9.    Height          =   6090
  10.    Left            =   30
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   5685
  13.    ScaleWidth      =   6315
  14.    Top             =   30
  15.    Width           =   6435
  16.    Begin SSPanel Panel3D3 
  17.       AutoSize        =   3  'AutoSize Child To Panel
  18.       BackColor       =   &H00C0C0C0&
  19.       BevelOuter      =   1  'Inset
  20.       BorderWidth     =   8
  21.       Font3D          =   0  'None
  22.       Height          =   255
  23.       Left            =   3480
  24.       TabIndex        =   0
  25.       Top             =   4680
  26.       Width           =   1695
  27.       Begin Label DateField 
  28.          BackColor       =   &H00C0C0C0&
  29.          Height          =   225
  30.          Left            =   15
  31.          TabIndex        =   8
  32.          Top             =   15
  33.          Width           =   1665
  34.       End
  35.    End
  36.    Begin SSCommand GetDate 
  37.       Caption         =   "Pick a date"
  38.       Font3D          =   3  'Inset w/light shading
  39.       Height          =   555
  40.       Left            =   1200
  41.       TabIndex        =   7
  42.       Top             =   4500
  43.       Width           =   1455
  44.    End
  45.    Begin SSPanel CalenderForm 
  46.       Alignment       =   8  'Center - BOTTOM
  47.       BackColor       =   &H00C0C0C0&
  48.       BevelOuter      =   1  'Inset
  49.       BorderWidth     =   8
  50.       Caption         =   "Double click on a date to select"
  51.       Font3D          =   1  'Raised w/light shading
  52.       Height          =   2835
  53.       Left            =   960
  54.       TabIndex        =   1
  55.       Top             =   660
  56.       Visible         =   0   'False
  57.       Width           =   4215
  58.       Begin SSPanel Panel3D1 
  59.          Alignment       =   8  'Center - BOTTOM
  60.          AutoSize        =   3  'AutoSize Child To Panel
  61.          BackColor       =   &H00C0C0C0&
  62.          BevelOuter      =   1  'Inset
  63.          BorderWidth     =   8
  64.          Font3D          =   1  'Raised w/light shading
  65.          Height          =   255
  66.          Left            =   120
  67.          TabIndex        =   9
  68.          Top             =   60
  69.          Width           =   1455
  70.          Begin Label DateCaption 
  71.             BackColor       =   &H00C0C0C0&
  72.             Height          =   225
  73.             Left            =   15
  74.             TabIndex        =   6
  75.             Top             =   15
  76.             Width           =   1425
  77.          End
  78.       End
  79.       Begin SSPanel Panel3D2 
  80.          BackColor       =   &H00C0C0C0&
  81.          BevelOuter      =   1  'Inset
  82.          BorderWidth     =   8
  83.          Font3D          =   0  'None
  84.          Height          =   495
  85.          Left            =   120
  86.          TabIndex        =   3
  87.          Top             =   2100
  88.          Width           =   3975
  89.          Begin SSCommand Previous 
  90.             Caption         =   "Previous Month"
  91.             Font3D          =   3  'Inset w/light shading
  92.             Height          =   375
  93.             Left            =   240
  94.             TabIndex        =   5
  95.             Top             =   60
  96.             Width           =   1695
  97.          End
  98.          Begin SSCommand Next 
  99.             Caption         =   "Next Month"
  100.             Font3D          =   3  'Inset w/light shading
  101.             Height          =   375
  102.             Left            =   2040
  103.             TabIndex        =   4
  104.             Top             =   60
  105.             Width           =   1695
  106.          End
  107.       End
  108.       Begin Grid Calender 
  109.          BackColor       =   &H0000FFFF&
  110.          Cols            =   7
  111.          FixedCols       =   0
  112.          Height          =   1695
  113.          Left            =   120
  114.          Rows            =   7
  115.          ScrollBars      =   0  'None
  116.          TabIndex        =   2
  117.          Top             =   360
  118.          Width           =   3975
  119.       End
  120.    End
  121. Option Explicit
  122. ' Create module global variables
  123. Dim mgiCurrentMonth As Integer
  124. Dim mgiCurrentYear As Integer
  125. Dim mgiCurrentDay As Integer
  126. Dim mgiStartMonth As Integer
  127. Dim mgiStartDay As Integer
  128. Dim mgiStartYear As Integer
  129. Dim mgiStartDOW As Integer ' What day of the week does the 1st fall on
  130. Dim mgiLastDOW As Integer  ' What is the last day of the week
  131. Dim mgsDayNames(0 To 6) As String * 3   ' The names of the days. Change this for different languages
  132. Dim mgsPickDate As String ' This is the global variable used to transfer the date in
  133. Sub Calender_DblClick ()
  134. Dim s As String
  135.     If Calender.Text <> "" And Calender.CellSelected = True Then
  136.         ' Put the date in a module global varible to be picked up elsewhere
  137.         mgsPickDate = Calender.Text + "/" + Str$(mgiCurrentMonth) + "/" + Str$(mgiCurrentYear)
  138.     End If
  139. End Sub
  140. Sub DoCalender (lsStartDate As Variant)
  141. Dim lsStartString As String, liX As Integer, liY As Integer
  142.     ' Find the first day of the week for the month
  143.     mgiStartMonth = Month(lsStartDate)
  144.     mgiCurrentMonth = mgiStartMonth
  145.     mgiStartYear = Year(lsStartDate)
  146.     mgiCurrentYear = mgiStartYear
  147.     mgiCurrentDay = Day(lsStartDate)
  148.     lsStartString = "1/" + Str$(mgiStartMonth) + "/" + Str$(mgiStartYear)
  149.     mgiStartDOW = Weekday(Format$(lsStartString, "dd/mm/yyyy"))
  150.     DateCaption.Caption = Format$(lsStartDate, "mmmm yyyy")
  151.     On Error Resume Next
  152.     For liX = 27 To 32
  153.         lsStartString = Str$(liX) + "/" + Str$(mgiStartMonth) + "/" + Str$(mgiStartYear)
  154.         liY = Weekday(Format$(lsStartString, "dd/mm/yyyy"))
  155.         If Err <> 0 Then
  156.             Err = 0
  157.             Exit For
  158.         End If
  159.     Next liX
  160.     mgiLastDOW = liX - 1
  161.     ' Clear out the calender to remove any previous data
  162.     For liX = 0 To 6
  163.         For liY = 1 To 6
  164.             Calender.Col = liX
  165.             Calender.Row = liY
  166.             Calender.Text = ""
  167.         Next liY
  168.     Next liX
  169.     ' Now fill in the dates
  170.     Calender.Col = mgiStartDOW - 1 ' Weekdays go 1 to 7, cols go 0 to 6
  171.     Calender.Row = 1
  172.     For liX = 1 To mgiLastDOW
  173.         Calender.Text = liX
  174.         liY = Calender.Col + 1
  175.         If liY = 7 Then
  176.             Calender.Col = 0
  177.             Calender.Row = Calender.Row + 1
  178.         Else
  179.             Calender.Col = Calender.Col + 1
  180.         End If
  181.     Next liX
  182. End Sub
  183. Sub Form_Load ()
  184. Dim liX As Integer
  185.     mgsDayNames(0) = "Sun"
  186.     mgsDayNames(1) = "Mon"
  187.     mgsDayNames(2) = "Tue"
  188.     mgsDayNames(3) = "Wed"
  189.     mgsDayNames(4) = "Thu"
  190.     mgsDayNames(5) = "Fri"
  191.     mgsDayNames(6) = "Sat"
  192.     ' Set up the calender days
  193.     Calender.Row = 0
  194.     For liX = 0 To 6
  195.         Calender.Col = liX
  196.         Calender.ColAlignment(liX) = 2
  197.         Calender.Text = mgsDayNames(liX)
  198.     Next liX
  199. End Sub
  200. Sub GetDate_Click ()
  201.     GetDate.Enabled = False
  202.     CalenderForm.Visible = True
  203.     mgsPickDate = ""   ' For this demonstration we just test for the date string being there
  204.     DoCalender Now
  205.     Do While mgsPickDate = ""
  206.         DoEvents
  207.     Loop
  208.     CalenderForm.Visible = False
  209.     DateField.Caption = Format$(mgsPickDate, "dd-mmm-yyyy") ' Display the date
  210.     GetDate.Enabled = True
  211. End Sub
  212. Sub Next_Click ()
  213. Dim ls As String
  214.     mgiCurrentMonth = mgiCurrentMonth + 1
  215.     If mgiCurrentMonth = 13 Then
  216.         mgiCurrentMonth = 1
  217.         mgiCurrentYear = mgiCurrentYear + 1
  218.     End If
  219.     ls = Str$(mgiCurrentDay) + "/" + Str$(mgiCurrentMonth) + "/" + Str$(mgiCurrentYear)
  220.     DoCalender ls
  221. End Sub
  222. Sub Previous_Click ()
  223. Dim ls As String
  224.     mgiCurrentMonth = mgiCurrentMonth - 1
  225.     If mgiCurrentMonth = 0 Then
  226.         mgiCurrentMonth = 12
  227.         mgiCurrentYear = mgiCurrentYear - 1
  228.     End If
  229.     ls = Str$(mgiCurrentDay) + "/" + Str$(mgiCurrentMonth) + "/" + Str$(mgiCurrentYear)
  230.     DoCalender ls
  231. End Sub
  232.