（原创）用TextBox实现日期的输入
目的：获得一个输入日期的TextBox。日期格式：YYYY-MM-DD。关键是在输入数字的同时，“-”要保留。
我这个是用一个TextBox控件做的，在做之前想用3个控件来做，后来发现也麻烦的。
思路：比如日期20070608，其实是由2*10000000+0*1000000+0*100000+7*10000。。。。所组成的。那么我在TextBox按入一个数字键，其实就是再做加法运算，然后把结果输出到文本中，即可，“-”可以使用Format()函数来实现，4-2-2的形式
首先在新建一个Form，在Form中放入一个Text1文本
Dim tempint As Long '计算的值
Dim index As Integer '定义某一个按键
Dim textarray(7) As Integer '日期数据
Dim textcount As Integer '定位光标的, 把光标停在要修改数字的前面
Dim prevstr As String '没有修改之前的文本
Private Sub Form_Load()
Dim i As Integer
For i = 0 To 7 Step 1
textarray(i) = 0
tempint = tempint + textarray(i) * 10 ^ (7 - i)
Next i
pos = 100000000
textcount = 0
Text1.Text = Format(tempint, "0000-00-00")
End Sub
Private Sub Text1_Change()
Dim i As Integer
Dim temp As Integer
Debug.Print Text1.Text
If index = 100 Then '防止在更改Text文本以后第2次调用
If textcount <= 0 Then '防止在开始的时候,就死命的按退格键,
textcount = 0
Else
For i = 1 To textcount '在正常情况下 ,文本的光标掉过textcount个字符,停在要修改的数字前面
SendKeys "{RIGHT}"
Next i
End If
End If
tempint = 0
temp = CompareText(prevstr, Text1.Text) '比较以前的数字和现在的数字 看看那一个位置上面的数字变化了
If temp <> -1 Then '有变化
If index = 11 Then '如果按的是推格键的话,计算现在光标的位置
textcount = textcount - 1
If textcount = 4 Or textcount = 7 Then
textcount = textcount - 1
End If
index = 0 '退格键的话,也就是把某一个为置0
Else
textcount = textcount + 1 '如果是0~9 的按钮的话
If textcount = 4 Or textcount = 7 Then
textcount = textcount + 1
End If
End If
Debug.Print "textcount=" + CStr(textcount)
textarray(temp) = index '放入数组
End If
If temp = -1 And index = 11 Then '防止出现,在"-"的时候,按了退格键,这样的话,比较出来的数字是没有变化的
textcount = textcount - 1
If textcount = 4 Or textcount = 7 Then
textcount = textcount - 1
End If
index = 0
Debug.Print "textcount=" + CStr(textcount)
If textcount = 6 Then '这个是由于在textcount和textarray()里面的相差2个"-"的位置所以在这边设置了
textarray(textcount - 1) = index
Else
textarray(textcount) = index
End If
End If
For i = 0 To UBound(textarray) '重新计算大小
tempint = tempint + textarray(i) * 10 ^ (7 - i)
Next i
index = 100 '由于要更新了,通知下一次如果没有按键,就不要再执行这个
prevstr = Format(tempint, "0000-00-00")
Text1.Text = Format(tempint, "0000-00-00")
End Sub
Private Sub Text1_Click()
Text1.SelStart = textcount
End Sub
Private Sub Text1_KeyPress(KeyAscII As Integer)
'将键值转换成索引号
index = GetKeyIndex(KeyAscII)
Debug.Print "index=" + CStr(index)
End Sub
'取键码索引值
Public Function GetKeyIndex(ByVal KeyAscII As Integer) As Integer
Dim i As Integer
Dim keymap(16) As Integer
keymap(0) = Asc("0") '0
keymap(1) = Asc("1") '1
keymap(2) = Asc("2") '2
keymap(3) = Asc("3") '3
keymap(4) = Asc("4") '4
keymap(5) = Asc("5") '5
keymap(6) = Asc("6") '6
keymap(7) = Asc("7") '7
keymap(8) = Asc("8") '8
keymap(9) = Asc("9") '9
keymap(11) = 8 '退格键
keymap(12) = 27 '放弃键
i = 0
GetKeyIndex = 255
'将键值转换成索引号
Do While i < 16
If keymap(i) = KeyAscII Then
GetKeyIndex = i
Exit Do
End If
i = i + 1
Loop
End Function
'按字节进行比较，返回不一样的的字节的位数,如果找到不同，则返回－１
Private Function CompareText(ByVal source As String, ByVal des As String) As Integer
Dim tempstr As String
Dim temp As String
Dim i As Integer
'首先去除掉非数字的部分
source = FilterNoDigital(source)
des = FilterNoDigital(des)
For i = 0 To Len(source) - 1 Step 1
temp = Mid$(source, i + 1, 1)
tempstr = Mid$(des, i + 1, 1)
If temp <> tempstr Then
CompareText = i
Exit Function
End If
Next i
CompareText = -1
End Function
Private Function FilterNoDigital(ByVal str As String) As String
Dim i As Integer
Dim tempstr As String
tempstr = ""
For i = 1 To Len(str) Step 1
If Mid$(str, i, 1) >= "0" And Mid$(str, i, 1) <= "9" Then
tempstr = tempstr + Mid$(str, i, 1)
End If
Next i
FilterNoDigital = tempstr
End Function