如何实现TEXT中限制输入类型字符

Question

各位好：
  在VB中，如何才能实现在TEXT中只能输入数字，不能输入其它类型的字符（即输入其它字符时无效）
急切待复！
谢谢！

Answer 1

'
'只允许输入数字
'函数:InNum
'参数:KeyCode ASCII码.LeachCode 自定义过滤字符串.
'返回值:无
'注:一般应用于KEYDOWN事件中.
Public Function InNum(ByRef SourVal As String, ByRef KeyAscii As Integer)
        If KeyAscii = 8 Then Exit Function
        If IsNumeric(SourVal & Chr(KeyAscii)) Then
           
        Else
           KeyAscii = 0
        End If
End Function

Answer 2

Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii < 48 Or KeyAscii > 57 Then
        KeyAscii = 0
    End If
End Sub

Answer 3

我觉得你们的老师也不是很专业，（得罪一个离我比较远的人好些）
也许有一天你会将代码改为Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii < 48 Or KeyAscii > 57 Then
        If KeyAscii <> 8 Then KeyAscii = 0
    End If
End Sub

Answer 4

楼上,看在我也是菜鸟的份上告诉我if KeyAscii=8 会怎么样?还有按那个键是KeyAscii=8 ?

Answer 5

如何才能实现在TEXT中只能输入字母和汉字呢?

Answer 6

楼上几位,都考虑鼠标右键的粘贴了吗？键盘上的右键菜单,SHIFT + F12 调出来的右键菜单,这里菜单里面都有粘贴!!===========
这是自定义的控件!!Option Explicit'属性初始值
Const ini_Text = "0"
Const ini_MaxLength = 0
Const ini_PointNum = 2
Const ini_SignFlag = True
Const ini_Align = 0'属性设置值
Private ls_Text As String
Private li_MaxLength As Integer
Private li_PointNum As Integer  '小数位数
Private lb_SignFlag As Boolean  '是否允许输入符号
Private ll_Align As LongPrivate Sub mnuCopy_Click()
    Clipboard.SetText txtMask.SelText
End SubPrivate Sub mnuCut_Click()
    Clipboard.SetText txtMask.SelText
    txtMask.SelText = ""
End SubPrivate Sub mnuDelete_Click()
    txtMask.SelText = ""
End SubPrivate Sub mnuPaste_Click()
    Dim ls_Clip As String, ls_Text As String
    
    ls_Clip = Clipboard.GetText
    ls_Text = txtMask.Text
    'If Val(ls_Clip) = Trim(ls_Clip) And ((Left(ls_Clip, 1) <> "-" Or txtMask.SelStart = 0) And InStr(ls_Text, "-") = 0) And IIf(InStr(ls_Clip, ".") = 0, True, InStr(ls_Text, ".") = 0) And (Left(ls_Clip, 1) <> 0 Or txtMask.SelStart <> 0) Then txtMask.SelText = ls_Clip
    If Trim(ls_Clip) <> "-." And Trim(ls_Clip) <> "-.0" And Val(ls_Clip) = Trim(ls_Clip) And ((Left(ls_Clip, 1) <> "-" Or txtMask.SelStart = 0) And InStr(ls_Text, "-") = 0) And (InStr(ls_Clip, ".") = 0 Or (InStr(StrReverse(ls_Clip), ".") + Len(ls_Text) - txtMask.SelStart < li_PointNum + 2 And InStr(ls_Text, ".") = 0)) And (Left(ls_Clip, 1) <> 0 Or txtMask.SelStart <> 0) Then txtMask.SelText = ls_Clip
End SubPrivate Sub mnuSelAll_Click()
    txtMask.SelStart = 0
    txtMask.SelLength = Len(txtMask.Text)
    txtMask.SetFocus
End SubPrivate Sub txtMask_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 93 Or KeyCode = 121 Then
        txtMask_MouseDown vbRightButton, 1, 0, 0
    End If
End SubPrivate Sub txtMask_KeyPress(KeyAscii As Integer)
    Dim ls_Text As String, ls_Reverse As String
    
    If KeyAscii = 24 Then mnuCut_Click    '剪切
    If KeyAscii = 3 Then mnuCopy_Click    '复制
    If KeyAscii = 22 Then mnuPaste_Click  '粘贴    ls_Text = txtMask.Text
    ls_Reverse = StrReverse(ls_Text)    'If (KeyAscii = 48 And txtMask.SelStart = 0 And txtMask.Text <> "") Or (Left(ls_Text, 1) = "-" And KeyAscii = 48 And txtMask.SelStart = 1) Then KeyAscii = 0
    If (KeyAscii = 48 And txtMask.SelStart = 0) Or (Left(ls_Text, 1) = "-" And KeyAscii = 48 And txtMask.SelStart = 1) Then KeyAscii = 0
    If KeyAscii <> 8 And InStr(ls_Reverse, ".") > li_PointNum And InStr(ls_Text, ".") < txtMask.SelStart + 1 Then KeyAscii = 0
    If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 And IIf(lb_SignFlag And KeyAscii = 45, txtMask.SelStart <> 0 Or InStr(ls_Text, "-") <> 0, True) And IIf(li_PointNum = 0, KeyAscii = 46, IIf(KeyAscii = 46, txtMask.SelStart <= Len(ls_Text) - li_PointNum - 1 Or InStr(ls_Text, ".") <> 0, True)) Then KeyAscii = 0
End SubPrivate Sub txtMask_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton Then
        txtMask.Enabled = False
        txtMask.Enabled = True
        txtMask.SetFocus
        mnuCut.Enabled = txtMask.SelLength >= 1
        mnuCopy.Enabled = mnuCut.Enabled
        mnuDelete.Enabled = mnuCut.Enabled
        mnuPaste.Enabled = (Clipboard.GetText() <> "")
        mnuSelAll.Enabled = (txtMask.Text <> "")
        PopupMenu mnuPopup
    End If
End SubPrivate Sub UserControl_InitProperties()
    Text = ini_Text
    PointNum = ini_PointNum
    SignFlag = ini_SignFlag
    MaxLength = ini_MaxLength
End SubPrivate Sub UserControl_ReadProperties(PropBag As PropertyBag)
    With PropBag
        Text = .ReadProperty("Text", ini_Text)
        PointNum = .ReadProperty("PointNum", ini_PointNum)
        SignFlag = .ReadProperty("SignFlag", ini_SignFlag)
        MaxLength = .ReadProperty("MaxLength", ini_MaxLength)
        Align = .ReadProperty("Align", ini_Align)
    End With
End SubPrivate Sub UserControl_Resize()
    txtMask.Width = Width
    txtMask.Height = Height
End SubPublic Property Get Text() As String
    Text = ls_Text
End PropertyPublic Property Let Text(ByVal vNewValue As String)
    ls_Text = vNewValue
    txtMask.Text = ls_Text
    UserControl.PropertyChanged "Text"
End PropertyPublic Property Get PointNum() As Integer
    PointNum = li_PointNum
End PropertyPublic Property Let PointNum(ByVal vNewValue As Integer)
    li_PointNum = vNewValue
    UserControl.PropertyChanged "PointNum"
End PropertyPublic Property Get SignFlag() As Boolean
    SignFlag = lb_SignFlag
End PropertyPublic Property Let SignFlag(ByVal vNewValue As Boolean)
    lb_SignFlag = vNewValue
    UserControl.PropertyChanged "SignFlag"
End PropertyPublic Property Get MaxLength() As Integer
    MaxLength = li_MaxLength
End PropertyPublic Property Let MaxLength(ByVal vNewValue As Integer)
    li_MaxLength = vNewValue
    txtMask.MaxLength = li_MaxLength
    UserControl.PropertyChanged "MaxLength"
End PropertyPrivate Sub UserControl_WriteProperties(PropBag As PropertyBag)
    With PropBag
        Call .WriteProperty("Text", ls_Text, ini_Text)
        Call .WriteProperty("PointNum", li_PointNum, ini_PointNum)
        Call .WriteProperty("SignFlag", lb_SignFlag, ini_SignFlag)
        Call .WriteProperty("MaxLength", li_MaxLength, ini_MaxLength)
        Call .WriteProperty("Align", ll_Align, ini_Align)
    End With
End SubPublic Property Get Align() As Variant
    Align = ll_Align
End PropertyPublic Property Let Align(ByVal vNewValue As Variant)
    ll_Align = Align
End Property

Answer 7

里面用到一个弹出菜单,跟TEXTBOX右键弹出的菜单一模一样,用于替换它的菜单!!

Answer 8

再加上不处理退格健不就的了
（vbkeyback=8：BackSpace健）Private Sub Text1_KeyPress(KeyAscii As Integer)
    If (KeyAscii < 48 Or KeyAscii > 57)and (KeyAscii<>vbkeyback) Then
        KeyAscii = 0
    End If
End Sub

Answer 9

很多界面效果的原理是很简单的：坐标计算+事件响应+绘图操作可是有很多人受拖拉控件的设计思想影响
就是想不到这儿来现在的编程书籍好像只有三大类：
1.算法、数据结构
2.常用编程工具（VB、VC、Delphi）的基本使用、应用层次的数据库开发
3.专业方面（Win32 API、计算机图形学、数字图像处理……）从来没有一本书联系起来讲
空白区域太多了
（比如第二类书，只讲了事件在什么时候触发，没说过可以怎样处理）坐标计算：数学功底是必需的
事件响应：取得：控件的事件时一定要弄清楚地。有时为了一些VB没有封装事件（如鼠标滚轮），就得用API了
          处理：对于某些复杂的界面交互效果（如Word所见即所得的编辑环境），那就是要很好的算法/数据结构水平
绘图操作：VB的绘图操作太鸡肋了，Win32API的GDI函数集是唯一选择
现在外面的关于API的书要么讲单个函数什么用、有么只抄例子，很少有系统讲解的
Win32 API本来是就是一些底层函数，单个单个用没什么大作用（可VB连这些基本功能都没完全封装），只有配合使用才有威力
那些只抄例子只是一些少见的招式，只能唬唬菜鸟。当你看到系统讲解类的书的时候，千万不能犹豫。虽然看起来很枯燥，但这是修练内功