VBcoders Guest



Don't have an account yet? Register
 


Forgot Password?



Accept's Valid Dates & Years Between 1900 & Current System Year. If Better Code Is Made From It Ple

by Ravinrda R . Joglekar (1 Submission)
Category: OLE/COM/DCOM/Active-X
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Mon 19th March 2001
Date Added: Mon 8th February 2021
Rating: (1 Votes)

Accept's Valid Dates & Years Between 1900 & Current System Year. If Better Code Is Made From It Please E-Mail Me.

Rate Accept's Valid Dates & Years Between 1900 & Current System Year. If Better Code Is Made From It Ple



Text2.Text = ""
Text3.Text = ""
End Sub

Private Sub Label4_Click()
Dim stag As String
stag = "www.vbcode.com"
UserControl.Hyperlink.NavigateTo (stag)
End Sub

Private Sub Label4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
Call InKey
End Sub

Private Sub Text1_Validate(Cancel As Boolean)
Dim sd1 As Integer
sd1 = Val(Text1)
If sd1 < 1 Or sd1 > 12 Then Cancel = True
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
Call InKey
End Sub

Private Sub Text2_Validate(Cancel As Boolean)
Dim sd1 As Integer, sd2 As Integer, sd3 As Integer
sd1 = Val(Text1)
sd2 = Val(Text2)
sd3 = Val(Text3)

If sd1 = 1 Then
      If sd2 < 1 Or sd2 > 31 Then
      Cancel = True
      Else
      Cancel = False
      End If
ElseIf sd1 = 3 Then
  If sd2 < 1 Or sd2 > 31 Then
      Cancel = True
      Else
      Cancel = False
      End If
ElseIf sd1 = 5 Then
  If sd2 < 1 Or sd2 > 31 Then
      Cancel = True
      Else
      Cancel = False
      End If
ElseIf sd1 = 7 Then
       If sd2 < 1 Or sd2 > 31 Then
      Cancel = True
      Else
      Cancel = False
      End If
ElseIf sd1 = 8 Then
  If sd2 < 1 Or sd2 > 31 Then
      Cancel = True
      Else
      Cancel = False
      End If
ElseIf sd1 = 10 Then
      If sd2 < 1 Or sd2 > 31 Then
      Cancel = True
      Else
      Cancel = False
      End If
ElseIf sd1 = 12 Then
      If sd2 < 1 Or sd2 > 31 Then
      Cancel = True
      Else
      Cancel = False
      End If
ElseIf sd1 = 4 Then
 If sd2 < 1 Or sd2 > 30 Then
 Cancel = True
 Else
 Cancel = False
 End If
ElseIf sd1 = 6 Then
 If sd2 < 1 Or sd2 > 30 Then
 Cancel = True
 Else
 Cancel = False
 End If
ElseIf sd1 = 9 Then
 If sd2 < 1 Or sd2 > 30 Then
 Cancel = True
 Else
 Cancel = False
 End If
ElseIf sd1 = 11 Then
 If sd2 < 1 Or sd2 > 30 Then
 Cancel = True
 Else
 Cancel = False
 End If
ElseIf sd1 = 2 Then
     Select Case sd3 Mod 4
     Case 0
      If sd2 < 1 Or sd2 > 29 Then
      Cancel = True
      Else
      Cancel = False
      End If
     Case Else
      If sd2 < 1 Or sd2 > 28 Then
      Cancel = True
      Else
      Cancel = False
      End If
     End Select
Else
      Cancel = True
End If
End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)
Call InKey
End Sub

Private Sub Text3_Validate(Cancel As Boolean)
Dim sdt As Date, sd3 As Integer
sdt = DatePart("yyyy", Date)
sd3 = Val(Text3)
 If sd3 < 1900 Or sd3 > sdt Then
 Cancel = True
 Else
 Cancel = False
 End If
End Sub

Public Sub WrongKey()
MsgBox ("Enter Valid Dates")
End Sub

Public Sub BadKey()
MsgBox ("Enter Only Numerical Values")
End Sub

Private Sub Timer1_Timer()
If Label1.ForeColor = QBColor(0) Then
Label1.ForeColor = QBColor(10)
Else
Label1.ForeColor = QBColor(0)
End If
End Sub

Private Sub UserControl_Terminate()
MsgBox App.CompanyName
End Sub

Public Sub InKey()
Select Case KeyAscii
Case vbKeyRight, vbKeyLeft, vbKeyDelete, vbKeyBack, vbKeyTab
Case Asc("0") To Asc("9")
Case Else
     KeyAscii = 0
End Select
End Sub


Download this snippet    Add to My Saved Code

Accept's Valid Dates & Years Between 1900 & Current System Year. If Better Code Is Made From It Ple Comments

No comments have been posted about Accept's Valid Dates & Years Between 1900 & Current System Year. If Better Code Is Made From It Ple. Why not be the first to post a comment about Accept's Valid Dates & Years Between 1900 & Current System Year. If Better Code Is Made From It Ple.

Post your comment

Subject:
Message:
0/1000 characters