Visual Basic Source Code

home *** CD-ROM | disk | FTP | other *** search

/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / calendek / calendar.frm (.txt) < prev next >

Wrap

Visual Basic Form | 1995-03-02 | 23.6 KB | 778 lines

VERSION 2.00 Begin Form frmDate BackColor = &H00C0C0C0& BorderStyle = 3 'Fixed Double Caption = "Select Date" ClientHeight = 2235 ClientLeft = 2430 ClientTop = 3375 ClientWidth = 3390 ClipControls = 0 'False ControlBox = 0 'False Height = 2640 Left = 2370 LinkTopic = "Form1" ScaleHeight = 149 ScaleMode = 3 'Pixel ScaleWidth = 226 Top = 3030 Width = 3510 Begin Image Image1 Height = 255 Left = 90 Picture = CALENDAR.FRX:0000 Top = 60 Width = 3225 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H00000000& Height = 240 Index = 36 Left = 570 TabIndex = 37 Top = 1920 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H000000FF& Height = 240 Index = 35 Left = 120 TabIndex = 38 Top = 1920 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H00000000& Height = 240 Index = 34 Left = 2820 TabIndex = 39 Top = 1680 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H00000000& Height = 240 Index = 33 Left = 2370 TabIndex = 40 Top = 1680 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H00000000& Height = 240 Index = 32 Left = 1920 TabIndex = 41 Top = 1680 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H00000000& Height = 240 Index = 31 Left = 1470 TabIndex = 43 Top = 1680 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H00000000& Height = 240 Index = 30 Left = 1020 TabIndex = 42 Top = 1680 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H00000000& Height = 240 Index = 29 Left = 570 TabIndex = 36 Top = 1680 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H000000FF& Height = 240 Index = 28 Left = 120 TabIndex = 35 Top = 1680 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H00000000& Height = 240 Index = 27 Left = 2820 TabIndex = 34 Top = 1440 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H00000000& Height = 240 Index = 26 Left = 2370 TabIndex = 33 Top = 1440 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H00000000& Height = 240 Index = 25 Left = 1920 TabIndex = 32 Top = 1440 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H00000000& Height = 240 Index = 24 Left = 1470 TabIndex = 31 Top = 1440 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H00000000& Height = 240 Index = 23 Left = 1020 TabIndex = 30 Top = 1440 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H00000000& Height = 240 Index = 22 Left = 570 TabIndex = 29 Top = 1440 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H000000FF& Height = 240 Index = 21 Left = 120 TabIndex = 28 Top = 1440 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H00000000& Height = 240 Index = 20 Left = 2820 TabIndex = 27 Top = 1200 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H00000000& Height = 240 Index = 19 Left = 2370 TabIndex = 26 Top = 1200 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H00000000& Height = 240 Index = 18 Left = 1920 TabIndex = 25 Top = 1200 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H00000000& Height = 240 Index = 17 Left = 1470 TabIndex = 24 Top = 1200 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H00000000& Height = 240 Index = 16 Left = 1020 TabIndex = 23 Top = 1200 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H00000000& Height = 240 Index = 15 Left = 570 TabIndex = 22 Top = 1200 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H000000FF& Height = 240 Index = 14 Left = 120 TabIndex = 21 Top = 1200 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H00000000& Height = 240 Index = 13 Left = 2820 TabIndex = 20 Top = 960 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H00000000& Height = 240 Index = 12 Left = 2370 TabIndex = 19 Top = 960 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H00000000& Height = 240 Index = 11 Left = 1920 TabIndex = 18 Top = 960 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H00000000& Height = 240 Index = 10 Left = 1470 TabIndex = 17 Top = 960 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H00000000& Height = 240 Index = 9 Left = 1020 TabIndex = 16 Top = 960 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H00000000& Height = 240 Index = 8 Left = 570 TabIndex = 15 Top = 960 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H000000FF& Height = 240 Index = 7 Left = 120 TabIndex = 14 Top = 960 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H00000000& Height = 240 Index = 6 Left = 2820 TabIndex = 13 Top = 720 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H00000000& Height = 240 Index = 5 Left = 2370 TabIndex = 12 Top = 720 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H00000000& Height = 240 Index = 4 Left = 1920 TabIndex = 11 Top = 720 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H00000000& Height = 240 Index = 3 Left = 1470 TabIndex = 10 Top = 720 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H00000000& Height = 240 Index = 2 Left = 1020 TabIndex = 9 Top = 720 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H00000000& Height = 240 Index = 1 Left = 570 TabIndex = 8 Top = 720 Width = 465 End Begin Label lblDay Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "1" ForeColor = &H000000FF& Height = 240 Index = 0 Left = 120 TabIndex = 7 Top = 720 Width = 465 End Begin Label lbl Alignment = 2 'Center BackColor = &H00000000& BackStyle = 0 'Transparent Caption = "Sat" ForeColor = &H00000000& Height = 225 Index = 6 Left = 2820 TabIndex = 0 Top = 390 Width = 480 End Begin Label lbl Alignment = 2 'Center BackColor = &H00000000& BackStyle = 0 'Transparent Caption = "Fri" ForeColor = &H00000000& Height = 225 Index = 5 Left = 2370 TabIndex = 3 Top = 390 Width = 480 End Begin Label lbl Alignment = 2 'Center BackColor = &H00000000& BackStyle = 0 'Transparent Caption = "Thu" ForeColor = &H00000000& Height = 225 Index = 4 Left = 1950 TabIndex = 6 Top = 390 Width = 480 End Begin Label lbl Alignment = 2 'Center BackColor = &H00000000& BackStyle = 0 'Transparent Caption = "Wed" ForeColor = &H00000000& Height = 225 Index = 3 Left = 1500 TabIndex = 5 Top = 390 Width = 480 End Begin Label lbl Alignment = 2 'Center BackColor = &H00000000& BackStyle = 0 'Transparent Caption = "Tue" ForeColor = &H00000000& Height = 225 Index = 2 Left = 1050 TabIndex = 4 Top = 390 Width = 480 End Begin Label lbl Alignment = 2 'Center BackColor = &H00000000& BackStyle = 0 'Transparent Caption = "Mon" ForeColor = &H00000000& Height = 225 Index = 1 Left = 600 TabIndex = 2 Top = 390 Width = 480 End Begin Label lbl Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "Sun" ForeColor = &H000000FF& Height = 225 Index = 0 Left = 120 TabIndex = 1 Top = 390 Width = 480 End Begin Line Line1 BorderColor = &H00808080& Index = 0 X1 = 0 X2 = 232 Y1 = 43 Y2 = 43 End Begin Line Line1 BorderColor = &H00FFFFFF& Index = 1 X1 = -2 X2 = 232 Y1 = 44 Y2 = 44 End DefInt A-Z Option Explicit Dim curIndex As Integer Dim prevMonat As Integer Dim prevJahr As Integer Sub Form_KeyDown (keycode As Integer, Shift As Integer) Select Case keycode Case &H23 'KEY_END 'determine number of days in month Dim monat As Integer Dim jahr As Integer Dim maxDays As Integer monat = Month(DateInfo.thisDate) jahr = Year(DateInfo.thisDate) Select Case monat Case 1, 3, 5, 7, 8, 10, 12 maxDays = 31 Case 4, 6, 9, 11 maxDays = 30 Case 2 If jahr Mod 4 = 0 Then maxDays = 29 Else maxDays = 28 End If End Select DateInfo.thisDate = monat & "/" & maxDays & "/" & jahr loadCalendar Case &H24 'KEY_HOME - first of month DateInfo.thisDate = Month(DateInfo.thisDate) & "/1/" & Year(DateInfo.thisDate) loadCalendar Case &H25: gotoDate 5 'KEY_LEFT - yesterday Case &H26: gotoDate 7 'KEY_UP - previous week Case &H27: gotoDate 6 'KEY_RIGHT - tomorrow Case &H28: gotoDate 8 'KEY_DOWN - next week Case &H21: gotoDate 1 'KEY_PRIOR - previous month Case &H22: gotoDate 3 'KEY_NEXT - next month Case &HD: 'KEY_RETURN DateInfo.Action = True Unload Me Case &H1B 'KEY_ESCAPE DateInfo.Action = False Unload Me End Select End Sub Sub Form_Load () loadCalendar End Sub Sub gotoDate (whichOne As Integer) Select Case whichOne Case 0 'back one year DateInfo.thisDate = DateAdd("yyyy", -1, DateInfo.thisDate) loadCalendar Case 1 'back one month DateInfo.thisDate = DateAdd("m", -1, DateInfo.thisDate) loadCalendar Case 2 'today DateInfo.thisDate = Format(Now, "m/d/yyyy") loadCalendar Case 3 'forward one month DateInfo.thisDate = DateAdd("m", 1, DateInfo.thisDate) loadCalendar Case 4 'forward one year DateInfo.thisDate = DateAdd("yyyy", 1, DateInfo.thisDate) loadCalendar Case 5 'yesterday DateInfo.thisDate = DateAdd("y", -1, DateInfo.thisDate) loadCalendar Case 6 'tomorrow DateInfo.thisDate = DateAdd("y", 1, DateInfo.thisDate) loadCalendar Case 7 'previous week DateInfo.thisDate = DateAdd("ww", -1, DateInfo.thisDate) loadCalendar Case 8 'next week DateInfo.thisDate = DateAdd("ww", 1, DateInfo.thisDate) loadCalendar End Select End Sub Sub Image1_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single) image1.Refresh End Sub Sub Image1_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single) If Button <> 1 Then Exit Sub Dim lpRect As RECT Dim tp!, lf!, mouseX! mouseX! = X / screen.TwipsPerPixelX tp! = image1.top lf! = image1.left Select Case mouseX! Case Is < 21 lpRect.top = 0 + tp! lpRect.left = 0 + lf! lpRect.right = 21 + lf! lpRect.bottom = 16 + tp! InvertRect Me.hDC, lpRect gotoDate 0 Case 21 To 42 lpRect.top = 0 + tp! lpRect.left = 21 + lf! lpRect.right = 42 + lf! lpRect.bottom = 16 + tp! InvertRect Me.hDC, lpRect gotoDate 1 Case 85 To 130 lpRect.top = 0 + tp! lpRect.left = 85 + lf! lpRect.right = 130 + lf! lpRect.bottom = 16 + tp! InvertRect Me.hDC, lpRect gotoDate 2 Case 173 To 194 lpRect.top = 0 + tp! lpRect.left = 173 + lf! lpRect.right = 194 + lf! lpRect.bottom = 16 + tp! InvertRect Me.hDC, lpRect gotoDate 3 Case Is >= 195 lpRect.top = 0 + tp! lpRect.left = 195 + lf! lpRect.right = 214 + lf! lpRect.bottom = 16 + tp! InvertRect Me.hDC, lpRect gotoDate 4 End Select DoEvents image1.Refresh End Sub Sub lblDay_click (index As Integer) 'check which panel clicked If lblDay(index).Caption = "" Then Exit Sub 'turn off colors of old number Dim startPos As Integer startPos = Val(Format(Str$(Month(DateInfo.thisDate)) & "/1/" & Str$(Year(DateInfo.thisDate)), "w")) - 1 lblDay(startPos + Day(DateInfo.thisDate) - 1).BorderStyle = 0 'set to new date DateInfo.thisDate = Str(Month(DateInfo.thisDate)) & "/" & lblDay(index).Caption & "/" & Str(Year(DateInfo.thisDate)) 'turn on colors lblDay(startPos + Val(lblDay(index).Caption) - 1).BorderStyle = 1 curIndex = index End Sub Sub lblDay_DblClick (index As Integer) lblDay_click index DateInfo.Action = True Unload Me End Sub Sub loadCalendar () Dim startPos As Integer Dim pos As Integer Dim maxDays As Integer Dim i As Integer Dim monat As Integer Dim jahr As Integer Dim tag As Integer tag = Day(DateInfo.thisDate) monat = Month(DateInfo.thisDate) jahr = Year(DateInfo.thisDate) 'get variables startPos = Val(Format(Str$(monat) & "/1/" & Str$(jahr), "w")) - 1 pos = startPos 'determine number of days in month Select Case monat Case 1, 3, 5, 7, 8, 10, 12 maxDays = 31 Case 4, 6, 9, 11 maxDays = 30 Case 2 If jahr Mod 4 = 0 Then maxDays = 29 Else maxDays = 28 End If End Select If tag > maxDays Then tag = maxDays DateInfo.thisDate = DateValue(monat & "/" & tag & "/" & jahr) 'load the calendar If monat <> prevMonat Or jahr <> prevJahr Or IsNull(prevMonat) Or IsNull(prevJahr) Then For i = 0 To 36 lblDay(i).Caption = "" lblDay(i).BorderStyle = 0 Next For i = 1 To maxDays lblDay(pos).Caption = i pos = pos + 1 Next i Me.Caption = Format$(DateInfo.thisDate, "mmmm, yyyy") Else For i = 0 To 36 If lblDay(i).BorderStyle Then lblDay(i).BorderStyle = 0 Next End If 'set calendar lblDay(startPos + tag - 1).BorderStyle = 1 curIndex = startPos + tag - 1 prevMonat = monat prevJahr = jahr End Sub