منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب

نسخة كاملة : هل يوجد كود تصحيح الي عند إدخال المستخدم الوقت في Text؟؟
أنت حالياً تتصفح نسخة خفيفة من المنتدى . مشاهدة نسخة كاملة مع جميع الأشكال الجمالية .
الاخوة الكرام
 السلام عليكم ورحمة وبركاتة
 هل يوجد كود  تصحيح الي عند إدخال المستخدم الوقت في Text؟؟
مثال
المستخدم ادخل الوقت  بشكل التالي
1.25ص
والوقت الصحيح  هوا
10:25ص

ومثال اخر
قد يدخل المستخدم الوقت بشكل التالي
1025
بدون :
  نامل من الله المساعدة والله يحفظكم ويرعاكم
السلام عليكم

ان شاء الله تجد طلبك في المرفقات

يعطيك العافية
(16-11-15, 09:39 PM)abulayth كتب : [ -> ]السلام عليكم

ان شاء الله تجد طلبك في المرفقات

يعطيك العافية
اخي العزيز
 السلام عليكم ورحمة وبركاته
 نامل التركيز على السوال والاجابة إذا سمحت ؟؟
اخي الكريم
اعتذر لك اشد الاعتذار عن محاولتي مساعدتك وان شاء الله لن تتكرر

Angry Angry Angry Angry
لماذا لا تعتمد خاصية الـ Input Mask في تصميم الجدول حيث تضع القناع بهذا الشكل : 00:00 .
أهلا أخي الكريم سالم , لقد عملت لك دالة خاصه لعمل ذلك في مشاركة سابقة ألم تعمل معك , هذه هي الدالة :

كود :
Private Function Check_Time(zMask As String, zTime As String) As Boolean

Dim Dots_Pos() As Integer
Dim Spaces_Pos() As Integer
Dim Char_Pos As Integer
Dim Dots_Count As Integer
Dim Spaces_Count As Integer
Dim zTestTime As String
Dim I As Integer, N As Integer

If Trim$(zMask) = "" Or Trim$(zTime) = "" Or Len(zMask) <> Len(zTime) Then
   Check_Time = False
   Exit Function
End If

Char_Pos = -1

For I = 1 To Len(zMask)

    If Mid$(zMask, I, 1) = ":" Then
       Dots_Count = Dots_Count + 1
       ReDim Preserve Dots_Pos(1 To Dots_Count) As Integer
       Dots_Pos(Dots_Count) = I
    End If
    
    If Mid$(zMask, I, 1) = " " Then
       Spaces_Count = Spaces_Count + 1
       ReDim Preserve Spaces_Pos(1 To Spaces_Count) As Integer
       Spaces_Pos(Spaces_Count) = I
    End If
    
    If Mid$(zMask, I, 1) = "ص" Or Mid$(zMask, I, 1) = "م" Then
       Char_Pos = I
    End If
    
Next

If Dots_Count = 0 And Spaces_Count = 0 And Char_Pos = -1 Then
  
   Check_Time = IsNumeric(zTime)
   Exit Function

Else

   If Dots_Count > 0 Then
  
      For I = LBound(Dots_Pos) To UBound(Dots_Pos)
          If Mid$(zTime, Dots_Pos(I), 1) <> ":" Then
             Check_Time = False
             Exit Function
          End If
      Next
      
   End If
  
   If Spaces_Count > 0 Then
  
      For I = LBound(Spaces_Pos) To UBound(Spaces_Pos)
          If Mid$(zTime, Spaces_Pos(I), 1) <> " " Then
             Check_Time = False
             Exit Function
          End If
      Next
      
   End If
  
   If Char_Pos > -1 Then
      If Mid$(zTime, Char_Pos, 1) <> "ص" And Mid$(zTime, Char_Pos, 1) <> "م" Then
         Check_Time = False
         Exit Function
      Else
         If Char_Pos = 1 Then
            zTestTime = Mid$(zTime, 2)
         ElseIf Char_Pos = Len(zTime) Then
            zTestTime = Left$(zTime, Len(zTime) - 1)
         End If
         zTime = zTestTime
      End If
      
   End If
  
   zTime = Replace$(zTime, ":", "")
   zTime = Replace$(zTime, " ", "")
  
   Check_Time = IsNumeric(zTime)
   Exit Function
  
End If

End Function

وطريقة إستخدامها لفحص الوقت المدخل في صندوق النص بهذه الطريقة :

كود :
If Check_Time("##:## " & "م", Text1.Text) Then
   MsgBox "الوقت صحيح"
Else
   MsgBox "الوقت خطأ"
End If

أو

كود :
If Check_Time("##:##", Text1.Text) Then
   MsgBox "الوقت صحيح"
Else
   MsgBox "الوقت خطأ"
End If

أو

كود :
If Check_Time("##:## " & "م", Text1.Text) Then
   MsgBox "الوقت صحيح"
Else
   MsgBox "الوقت خطأ"
End If

أو

كود :
If Check_Time("م" & " ##:##", Text1.Text) Then
   MsgBox "الوقت صحيح"
Else
   MsgBox "الوقت خطأ"
End If

على حسب التنسيق الذي تريده , وخذ بعين الإعتبار إذا كنت تريد أن يكون في تنسيق الوقت حرف إما "ص" أو "م" أن يكون يكون إما عن يمين أو يسار التنسيق مفصولا بمسافه , بالتوفيق .
(20-11-15, 07:21 PM)Ahmed_Mansoor كتب : [ -> ]أهلا أخي الكريم سالم , لقد عملت لك دالة خاصه لعمل ذلك في مشاركة سابقة ألم تعمل معك , هذه هي الدالة :

كود :
Private Function Check_Time(zMask As String, zTime As String) As Boolean

Dim Dots_Pos() As Integer
Dim Spaces_Pos() As Integer
Dim Char_Pos As Integer
Dim Dots_Count As Integer
Dim Spaces_Count As Integer
Dim zTestTime As String
Dim I As Integer, N As Integer

If Trim$(zMask) = "" Or Trim$(zTime) = "" Or Len(zMask) <> Len(zTime) Then
  Check_Time = False
  Exit Function
End If

Char_Pos = -1

For I = 1 To Len(zMask)

   If Mid$(zMask, I, 1) = ":" Then
      Dots_Count = Dots_Count + 1
      ReDim Preserve Dots_Pos(1 To Dots_Count) As Integer
      Dots_Pos(Dots_Count) = I
   End If
   
   If Mid$(zMask, I, 1) = " " Then
      Spaces_Count = Spaces_Count + 1
      ReDim Preserve Spaces_Pos(1 To Spaces_Count) As Integer
      Spaces_Pos(Spaces_Count) = I
   End If
   
   If Mid$(zMask, I, 1) = "ص" Or Mid$(zMask, I, 1) = "م" Then
      Char_Pos = I
   End If
   
Next

If Dots_Count = 0 And Spaces_Count = 0 And Char_Pos = -1 Then
 
  Check_Time = IsNumeric(zTime)
  Exit Function

Else

  If Dots_Count > 0 Then
 
     For I = LBound(Dots_Pos) To UBound(Dots_Pos)
         If Mid$(zTime, Dots_Pos(I), 1) <> ":" Then
            Check_Time = False
            Exit Function
         End If
     Next
     
  End If
 
  If Spaces_Count > 0 Then
 
     For I = LBound(Spaces_Pos) To UBound(Spaces_Pos)
         If Mid$(zTime, Spaces_Pos(I), 1) <> " " Then
            Check_Time = False
            Exit Function
         End If
     Next
     
  End If
 
  If Char_Pos > -1 Then
     If Mid$(zTime, Char_Pos, 1) <> "ص" And Mid$(zTime, Char_Pos, 1) <> "م" Then
        Check_Time = False
        Exit Function
     Else
        If Char_Pos = 1 Then
           zTestTime = Mid$(zTime, 2)
        ElseIf Char_Pos = Len(zTime) Then
           zTestTime = Left$(zTime, Len(zTime) - 1)
        End If
        zTime = zTestTime
     End If
     
  End If
 
  zTime = Replace$(zTime, ":", "")
  zTime = Replace$(zTime, " ", "")
 
  Check_Time = IsNumeric(zTime)
  Exit Function
 
End If

End Function

وطريقة إستخدامها لفحص الوقت المدخل في صندوق النص بهذه الطريقة :

كود :
If Check_Time("##:## " & "م", Text1.Text) Then
  MsgBox "الوقت صحيح"
Else
  MsgBox "الوقت خطأ"
End If

أو

كود :
If Check_Time("##:##", Text1.Text) Then
  MsgBox "الوقت صحيح"
Else
  MsgBox "الوقت خطأ"
End If

أو

كود :
If Check_Time("##:## " & "م", Text1.Text) Then
  MsgBox "الوقت صحيح"
Else
  MsgBox "الوقت خطأ"
End If

أو

كود :
If Check_Time("م" & " ##:##", Text1.Text) Then
  MsgBox "الوقت صحيح"
Else
  MsgBox "الوقت خطأ"
End If

على حسب التنسيق الذي تريده , وخذ بعين الإعتبار إذا كنت تريد أن يكون في تنسيق الوقت حرف إما "ص" أو "م" أن يكون يكون إما عن يمين أو يسار التنسيق مفصولا بمسافه , بالتوفيق .

اخي العزيز
 لكم مني جزيل الشكر والتقدير على ما تقدمه لنا من دعم فني والله يحفظكم ويرعاكم