visual basic 6.0 datetimepicker properties

Option Explicit
Private Sub main()
  Form1.Show
  MsgBox "Press Enter to change the format"
  'Now change the format
  Test "/"
  End
End Sub
 
Sub Test(ta As String)
 With Form1.txtBalGam
   If ta = "." Then
     .Text = sNewDate(.Text, "DMY", "MM.DD.YYYY")
   ElseIf ta = "/" Then
     'just to prive you can pass lowercase parameter if you want
     .Text = sNewDate(.Text, "dmy", "DD/MM/YYYY")
     MsgBox "Press Enter again for a different format"
     .Text = sNewDate(.Text, "dmy", "DD/MM/YY")
     MsgBox "Press Enter again for a different format"
     .Text = sNewDate(.Text, "dmy", "MM/DD/YYYY")
     MsgBox "Press Enter again for a different format"
     .Text = sNewDate(.Text, "mdy", "yyyy.mm.dd")
     MsgBox "...and back to the original format"
     .Text = sNewDate(.Text, "ymd", "MM.DD.YYYY")
   End If
 End With
End Sub
 
Public Function sNewDate(cDateStr As String, cOld As String, cNew As String) as String
 
'call this function by passing the following parameterd
' cDateStr :string to be converted,
' cOld     :the OLD format as a 3 character code ONLY
'           (e.g. "MDY" or "DMY")
' cNew     :the final format desired in full 
'           e.g. dd/mm/yy or mm/dd/yyyy or yyyy.mm.dd
 
  Dim nAt As Integer
  Dim cParts() As String
  Dim cOldParts(2) As String
  Dim cNewParts(2) As String
  Dim cDelim As String
  Dim nLen As Integer
  Const DD = 0
  Const MM = 1
  Const YY = 2
  
  cOld = UCase(cOld)
  If Len(cOld) > 3 Then
    MsgBox "Error in call to strNewDtFormat"
    sNewDate = cDateStr
    Exit Function
  End If
  
  cNew = UCase(cNew)
  
  nLen = Len(cDateStr)
  For nAt = 1 To nLen
    cDelim = Mid$(cDateStr, nAt, 1)
    If InStr("0123456789", cDelim) = 0 Then
      Exit For
    End If
  Next
  cParts = Split(cDateStr, cDelim)
  If UBound(cParts) > 2 Then
    MsgBox "Error in call to strNewDtFormat"
    sNewDate = cDateStr
    Exit Function
  End If
  Select Case cOld
    Case "DMY"
      cOldParts(DD) = cParts(0)
      cOldParts(MM) = cParts(1)
      cOldParts(YY) = cParts(2)
    Case "MDY"
      cOldParts(MM) = cParts(0)
      cOldParts(DD) = cParts(1)
      cOldParts(YY) = cParts(2)
    Case "YDM"
      cOldParts(YY) = cParts(0)
      cOldParts(DD) = cParts(1)
      cOldParts(MM) = cParts(2)
    Case "YMD"
      cOldParts(YY) = cParts(0)
      cOldParts(MM) = cParts(1)
      cOldParts(DD) = cParts(2)
  End Select
 
  nLen = Len(cNew)
  For nAt = 1 To nLen
    cDelim = Mid$(cNew, nAt, 1)
    If InStr("DMY", cDelim) = 0 Then
      Exit For
    End If
  Next
  cParts = Split(cNew, cDelim)
  If UBound(cParts) > 2 Then
    MsgBox "Error in call to strNewDtFormat"
    sNewDate = cDateStr
    Exit Function
  End If
  For nAt = 0 To 2
    If InStr(cParts(nAt), "D") > 0 Then
      cNewParts(nAt) = cOldParts(DD)
    Else
      If InStr(cParts(nAt), "M") > 0 Then
        cNewParts(nAt) = cOldParts(MM)
      Else
        If InStr(cParts(nAt), "Y") > 0 Then
          cNewParts(nAt) = cOldParts(YY)
          'sometimes between conversion the "century" is lost
          'so we will have to assume it is the current century that is required
          If Len(cNewParts(nAt)) = 2 Then
            cNewParts(nAt) = Left(CStr(Year(Now)), 2) + cNewParts(nAt)
          End If
        End If
        If Len(cParts(nAt)) = 2 Then
          cNewParts(nAt) = Right(cNewParts(nAt), 2)
        End If
      End If
    End If
  Next
  sNewDate = cNewParts(0) + cDelim + cNewParts(1) + cDelim + cNewParts(2)
End Function
                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124: