Phương pháp chặn lỗi nhập số thập phân sai định dạng hệ thốn

Các thủ thuật liên quan đến xử lý chuỗi và thời gian
Post Reply
mrcoding
Thành viên danh dự
Thành viên danh dự
Posts: 72
Joined: Thu 19/03/2009 2:03 pm
Location: Đà Nẵng
Been thanked: 4 times
Contact:

Phương pháp chặn lỗi nhập số thập phân sai định dạng hệ thốn

Post by mrcoding »

Thủ thuật:
Tác giả: Sưu tầm + Mrcoding
Mô tả: Giúp chặn lỗi khi người dùng nhập số thập phân sai mới decimal symbol của hệ thống


Đầu tiên tạo 1 module có nội dung sau

Code: Select all

Const LOCALE_USER_DEFAULT = &H400
Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
Public Const LOCALE_SSHORTDATE = &H1F
Public Const WM_SETTINGCHANGE = &H1A
Const Hwnd_BROADCAST = &HFFFF&
Private Declare Function SetLocaleInfo Lib "kernel32" Alias "SetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String) As Boolean
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long

'==================================================================
Private Const LOCALE_SDECIMAL = &HE         '  decimal separator
'ham kiem tra ky tu decimol symbol cua he thong
Public Function GetDecimalChar() As String
    GetDecimalChar = GetInfo(LOCALE_SDECIMAL)
End Function

Public Function GetInfo(ByVal lInfo As Long) As String
    Dim Buffer As String, Ret As String
    Buffer = String$(256, 0)
    Ret = GetLocaleInfo(LOCALE_USER_DEFAULT, lInfo, Buffer, Len(Buffer))
    If Ret > 0 Then
        GetInfo = Left$(Buffer, Ret - 1)
    Else
        GetInfo = ""
    End If
End Function

'thu tuc chi cho phep nhap so va ky tu decimol symbol==============================
Private Sub CheckNumber()

Dim sTemplate As String
sTemplate = "0123456789" & GetDecimalChar 'Cac ky tu cho phep go vao textbox
If InStr(1, sTemplate, Chr(KeyAscii)) > 0 Then
Else
    If KeyAscii = 13 Or KeyAscii = vbKeyBack Then
    Else
        KeyAscii = 0
    End If
End If
End Sub
'ham dem so lan xuat hien cua ky tu trong chuoi==========
Public Function CharCount(ByVal OrigString As String, _
ByVal Chars As String, Optional ByVal CaseSensitive As Boolean = False) _
As Long

        '**********************************************
       'PURPOSE: Returns Number of occurrences of a character or
       'or a character sequencence within a string

        'PARAMETERS:
       'OrigString: String to Search in
       'Chars: Character(s) to search for
       'CaseSensitive (Optional): Do a case sensitive search
       'Defaults to false

        'RETURNS:
       'Number of Occurrences of Chars in OrigString

        'EXAMPLES:
       'Debug.Print CharCount("FreeVBCode.com", "E") -- returns 3
       'Debug.Print CharCount("FreeVBCode.com", "E", True) -- returns 0
       'Debug.Print CharCount("FreeVBCode.com", "co") -- returns 2
       ''**********************************************

        Dim lLen As Long
        Dim lCharLen As Long
        Dim lAns As Long
        Dim sInput As String
        Dim sChar As String
        Dim lCtr As Long
        Dim lEndOfLoop As Long
        Dim bytCompareType As Byte

        sInput = OrigString
        If sInput = "" Then Exit Function
        lLen = Len(sInput)
        lCharLen = Len(Chars)
        lEndOfLoop = (lLen - lCharLen) + 1
        bytCompareType = IIf(CaseSensitive, vbBinaryCompare, _
           vbTextCompare)

        For lCtr = 1 To lEndOfLoop
            sChar = Mid(sInput, lCtr, lCharLen)
            If StrComp(sChar, Chars, bytCompareType) = 0 Then _
                lAns = lAns + 1
        Next

        CharCount = lAns

    End Function

Sau đó tạo 1 from gồm 1 textbox và chèn lệnh này vào

Code: Select all

Dim yKey as Integer
Private Sub Text1_Change()
Text1_KeyPress ykEY
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
Dim sTemplate As String
Dim count As Long
ykEY = KeyAscii
sTemplate = "0123456789" & GetDecimalChar 'Cac ky tu cho phep go vao textbox
If CharCount(Text1.text, GetDecimalChar) > 0 And Chr(KeyAscii) = GetDecimalChar Then
    KeyAscii = 0
    Exit Sub
End If
If InStr(1, sTemplate, Chr(KeyAscii)) > 0 Then
Else
    If KeyAscii = 13 Or KeyAscii = vbKeyBack Then
    Else
        IMsgbox UnicodeTelex("Bajn chir dduwowjc phesp nhaajp soos vaf kys tuwj ngawn casch giuwxa casc soos thaajp phaan laf daasu '") & GetDecimalChar & ("'"), vbInformation
        KeyAscii = 0
    End If
End If
End Sub

Hy vọng là có ích cho các bạn
http://www.mediafire.com/hothanhnam
User avatar
truongphu
VIP
VIP
Posts: 4779
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 525 times

Re: Phương pháp chặn lỗi nhập số thập phân sai định dạng hệ

Post by truongphu »

1- VBLib có bài: chỉ cho phép nhập ký tự số, bài nầy bạn thêm phần chặn lỗi ký tự thập phân
2- phần chặn lỗi thập phân: ta có thể tìm ký hiệu thập phân, cho phép nó chỉ xuất hiện 1 lần là xong!

  1. Dim Dâu As String  ' Code tông hop bo'i truongphu
  2. Private Sub Form_Load()
  3. ' Tìm ký hiêu dinh dang thâp phân
  4.    Dâu = Format$(0, "#.#")
  5. End Sub
  6. Private Sub Text1_KeyPress(KeyAscii As Integer)
  7. If CharCount(Text1.Text, Dâu) > 0 And KeyAscii = Asc(Dâu) Then
  8. ' chi cho phép nhâp 1 ký tu .
  9.  KeyAscii = 0
  10.   Exit Sub
  11. End If
  12.  If InStr("1234567890" + Chr$(vbKeyBack) + Dâu, Chr$(KeyAscii)) = 0 Then
  13.   KeyAscii = 0
  14.  End If
  15. End Sub
  16.  
  17. Function CharCount(ByVal OrigString As String, ByVal Chars As String, _
  18. Optional ByVal CaseSensitive As Boolean = False) As Long
  19. ' Ðê'm sô' lâ`n môt ký tu
  20.    Dim sChar As String, i&
  21.     Dim bytCompareType As Byte
  22.  
  23.     If OrigString = "" Then Exit Function
  24.     bytCompareType = IIf(CaseSensitive, vbBinaryCompare, vbTextCompare)
  25.         For i = 1 To (Len(OrigString) - Len(Chars)) + 1
  26.             sChar = Mid(OrigString, i, Len(Chars))
  27.             If StrComp(sChar, Chars, bytCompareType) = 0 Then CharCount = CharCount + 1
  28.         Next
  29.     End Function


Nếu code trên có sai sót, nhờ các bạn sửa tiếp
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh
mrcoding
Thành viên danh dự
Thành viên danh dự
Posts: 72
Joined: Thu 19/03/2009 2:03 pm
Location: Đà Nẵng
Been thanked: 4 times
Contact:

Re: Phương pháp chặn lỗi nhập số thập phân sai định dạng hệ

Post by mrcoding »

He he. Đúng là pác Trương Phú.... Bái phục !!!!
http://www.mediafire.com/hothanhnam
vohuuhau
Posts: 1
Joined: Fri 29/10/2010 4:18 pm

Re: Phương pháp chặn lỗi nhập số thập phân sai định dạng hệ

Post by vohuuhau »

hay quá cảm ơn đã test thử và thấy thành công! cảm ơn nhiều
dandon
Thành viên chính thức
Thành viên chính thức
Posts: 23
Joined: Wed 29/07/2009 11:30 pm

Re: Phương pháp chặn lỗi nhập số thập phân sai định dạng hệ

Post by dandon »

Thường thì dấu thập phân được định dạng bằng dấu phẩy (,) hoặc dấu chấm (.). Đề nghị bác Phú viết tiếp trường hợp khi người dùng nhấn dấu phẩy (,) hoặc dấu chấm (.) thì chương trình đều nhận là dấu thập phân chứ không chỉ chặn lỗi như trên.
Post Reply

Return to “[VB] Chuỗi và Thời gian”