by ash (2 Submissions)
Category: Math/Dates
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Mon 29th January 2001
Date Added: Mon 8th February 2021
Rating: (1 Votes)
CALENDAR THAT IS LIKE THE MICROSOFT CALENDAR AND WITH EXCELLENT COLORS ACCOMPANIED BY UPDOWN CONTROL,TEXTBOX,COMBO BOX
API Declarations
Dim ASH, NEWVAR, VARIABLE, I As Integer
I = Combo1.ListIndex
MONTHs = I + 1
YEARS = Text1.Text
DATES = I + 1 & "-1-" & Text1.Text
NUMDAYS = Val(DateDiff("D", FIRST, DATES))
If NUMDAYS < 0 Then
D = NUMDAYS
NUMDAYS = -NUMDAYS
End If
VARIABLE = NUMDAYS Mod 7
If D < 0 Then
VARIABLE = 7 - VARIABLE
End If
NEWVAR = VARIABLE + ASH
J = 0
If Text1.Text Mod 400 Mod 4 = 0 Then
If MONTHs = 2 Then
List1.List(I) = List1.List(I) + 1
R = List1.List(I)
End If
End If
If Text1.Text Mod 400 Mod 4 <> 0 Then
If MONTHs = 2 Then
List1.List(I) = List1.List(I)
End If
End If
End If
M2 = M1 = 0
List1.List(1) = 28
Call changecap
End Sub
Private Sub Form_Click()
Combo1_Click
End Sub
Private Sub Form_Load()
For I = 1 To 6
Load Label1(I)
Label1(I).Visible = True
Label1(I).Left = Label1(I - 1).Left + Label1(I - 1).Width
Next I
For I = 0 To 6
For N = 7 To 35 Step 7
Load Label1(N + I)
Label1(N + I).Visible = True
Label1(N + I).Left = Label1(I).Left
Label1(N + I).Top = Label1(N + I - 7).Top + Label1(N + I - 7).Height
Next N
Next I
Combo1.AddItem "JAN"
Combo1.AddItem "FEB"
Combo1.AddItem "MAR"
Combo1.AddItem "APR"
Combo1.AddItem "MAY"
Combo1.AddItem "JUN"
Combo1.AddItem "JUL"
Combo1.AddItem "AUG"
Combo1.AddItem "SEP"
Combo1.AddItem "OCT"
Combo1.AddItem "NOV"
Combo1.AddItem "DEC"
Text1.Text = 2001
FIRST = "1-1-2001"
ASH = 1
Combo1.ListIndex = Month(Date) - 1
Text1.Text = Year(Date)
w = Date
'For a = 1 To 31
'If MONTH(Date) & "/" & a & "/" & Text1.Text = (w) Then
'u = a
'MsgBox u
'End If
'Next a
For f = 0 To 6
Label2(f).BackColor = vbBlack
Label2(f).ForeColor = vbYellow
Next f
Call changecap
End Sub
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
Combo1_Click
End Sub
Private Sub Timer1_Timer()
Form1.Caption = Now
End Sub
Private Sub UpDown1_DownClick()
Text1.Text = Text1.Text + 1
Combo1_Click
End Sub
Private Sub UpDown1_UpClick()
Text1.Text = Text1.Text - 1
Combo1_Click
End Sub
Sub changecap()
For I = 0 To 41
Label1(I).BackColor = vbBlack
Label1(I).ForeColor = vbGreen
If Label1(I).Caption = Day(Now) Then
Label1(I).BackColor = RGB(255, 255, 255)
Label1(I).ForeColor = vbBlue
End If
Next I
End Sub
M1 = NEWVAR
For NEWVAR = NEWVAR To NEWVAR + List1.List(I)
J = J + 1
Label1(NEWVAR).Caption = J
Next NEWVAR
M2 = NEWVAR
For T = 0 To M1 - 1
Label1(T).Caption = ""
Next T
For C = M2 To 41
Label1(C).Caption = ""
Next C
If MONTHs = 2 Then
Label1(M2 - 1).Caption = ""
No comments have been posted about CALENDAR THAT IS LIKE THE MICROSOFT CALENDAR AND WITH EXCELLENT COLORS ACCOMPANIED BY UPDOWN CONTRO. Why not be the first to post a comment about CALENDAR THAT IS LIKE THE MICROSOFT CALENDAR AND WITH EXCELLENT COLORS ACCOMPANIED BY UPDOWN CONTRO.