الفريق العربي للبرمجةأرشيف المنتديات · 2000 – 2023
نسخة أرشيفية للقراءة فقط — التسجيل والمشاركة مغلقان، والمحتوى محفوظ كما كان.

استخدام ارقام علي النموذج بديلا عن ارقام الكيبورد

بدأه wael_rafat في 20 يوليو 2014 · 26 رد · 1,673 مشاهدة · في قواعد بيانات Microsoft Access
مشاركة: واتساب X فيسبوك تيليجرام
#1 صاحب الموضوع

السلام عليكم ورحمة الله

الاخوة والاخوات الافاضل أعضاء ومشرفي منتدانا الجميل

تحية طيبة وكل عام وانتم بخير وتقبل الله طاعتكم جميعا

 استفساري هو كيفية استخدام الأرقام الموجودة علي النموذج بديلا عن ارقام الكيبورد حيث يوجد لدي اكثر من حقل

وموضح بالمثال المرفق ، مع الشكر

 

 

post-280147-0-54972200-1405831618_thumb.

#2

أخي وائل أرفقت لك مثال عن كيبورد برمجي .. آمل ان ينفعك .. تحياتي

Keyboard2009.zip

ما من كاتبٍ إلا سيفنى ... ويبقي الدهر ما كتبت يداه

فلا تكتب بخطك غير شيءٍ ... يسرك في القيامة أن تراه

 

 

مواضيع مفيدة

 

منظومة حضور وغياب موظفين/index.php/topic/290636-%D8%A5%D9%87%D8%AF%D8%A7%D8%A1-%D8%A7%D9%84%D9%89-%D9%85%D9%86%D8%AA%D8%AF%D9%89-%D8%A7%D9%84%D8%A3%D9%83%D8%B3%D8%B3-%D9%85%D9%86%D8%B8%D9%88%D9%85%D8%A9-%D8%AA%D8%B3%D8%AC%D9%8A%D9%84-%D8%AD%D8%B6%D9%88%D8%B1-%D9%88%D8%BA%D9%8A%D8%A7%D8%A8-%D9%85/

#3

السلام عليكم

تسلم اخي الكريم sandanet علي المشاركة وجزاك الله كل خير

ولكنني وجدت هذا المثال بالبحث في المنتدي ولكنه لم يفي بالغرض وذلك لانني احتاج تعبئة اكثر من حقل في النموذج

والسؤال هو كيفية كتابة ارقام في كل حقل علي حدة وكيفية نقل التركير من حقل لاخر... وشكرا

#5

مشكور اخي msm علي المشاركة ولكن ايضا هذا المثال لم يفي بالغرض وذلك ﻻنه يعتمد علي حقل واحد فقط

#6

للاسف الشديد ، الاخ وائل لم يعطي اي تفصيل عن الطريقة اللي يريد الازرار تشتغل فيها :(

فمثلا ، ما عمل الزر Enter ؟؟

 

اللي انا قدرت عليه هو ، انك تكبس الزر على المربع اللي تدخل الارقام فيه ، ثم تكبس على الازرار ، واذا اردت الادخال في الحقل الاخر ، فاضغط فيه مرة ، ثم اضغط على الارقام.

 

post-273849-0-22478000-1405986213_thumb.

 

جعفر

223.OnScreen_Keyboard.mdb.zip

#7

الله عليك اخي الفاضل جعفر بارك الله في عمرك  وجزاك الله كل خير  ...  تمام هو المطلوب

+1

تم تعديل هذه المشاركة بواسطة wael_rafat في 22 يوليو 2014 في 18:12

#8

في إضافة جت على بالي ، قلت اضيفها لكم ، وهي:

 

طيب انا ما اريد امسح الحقل من اوله ، وانما اريد اضغط بالفأرة بين الارقام ، ثم امسح للامام Del ، او للخلف Backspace :)

 

شوفوا الصورة المتحركة (واذا ما كانت متحركة ، اضغط على الصورة ، فبتتحرك :) ):

post-273849-0-48807800-1406057900_thumb.

 

 

جعفر

 

223.OnScreen_Keyboard.mdb.zip

#9

ربنا يبارك في عمرك اخي الكريم جعفر

جاري التجربة وابلاغك بالنتيجة إن شاء الله

#10

ماهذا الإبداع أخي جعفر ؟؟ والله إنك خطير   :D وهذه إضافة بسيطة .. ضع الأمر التالي On Error Resume Next لتجنب ظهور رسالة الخطأ التالية Run-time error عندما يكون الحقل فارغ 

تم تعديل هذه المشاركة بواسطة SANDANET في 23 يوليو 2014 في 03:26

ما من كاتبٍ إلا سيفنى ... ويبقي الدهر ما كتبت يداه

فلا تكتب بخطك غير شيءٍ ... يسرك في القيامة أن تراه

 

 

مواضيع مفيدة

 

منظومة حضور وغياب موظفين/index.php/topic/290636-%D8%A5%D9%87%D8%AF%D8%A7%D8%A1-%D8%A7%D9%84%D9%89-%D9%85%D9%86%D8%AA%D8%AF%D9%89-%D8%A7%D9%84%D8%A3%D9%83%D8%B3%D8%B3-%D9%85%D9%86%D8%B8%D9%88%D9%85%D8%A9-%D8%AA%D8%B3%D8%AC%D9%8A%D9%84-%D8%AD%D8%B6%D9%88%D8%B1-%D9%88%D8%BA%D9%8A%D8%A7%D8%A8-%D9%85/

#11

شكرا جزيلا اخي :)

 

وشكرا على الملاحظة :)

 

انا عادة لا استعمل On Error Resume Next ، انما ارى رقم الخطأ ، وعلى اساسه اعمل

On Error goto err_FieldName

ثم في اسطر كود التقاط الخطأ ، وقد يكون هناك اكثر من رقم للخطأ ، فاتعامل مع كل خطأ بالطريقة المناسبة ، مثلا:

if err.number=3021 then
Resume next
elseif err.number = 94 then
msgbox "File Not found"
exit sub
else
msgbox err.number & vbcrlf & err.description

endif

 

والسبب اني نادرا استخدم On Error Resume Next هو ، ان الكود لا يظهر لي اي اخطاء اخرى في الكود ، وخصوصا اذا كان في مشكلة في الكود ، فلن استطيع معرف الخطأ وحله :(

 

وهذا الكود الكامل بعد التعديل:

Option Compare Database
Option Explicit


Dim ctl As Control

'start position of the cursor within field
Private CursorPosition As Integer

'selection length of the cursor within field
Private CursorLen As Integer


'Add
Public Function Add_Numbers(N) As String

    ctl.Value = Nz(ctl.Value, "") & N
    
End Function

'Erase
Public Function Erase_Numbers()
On Error GoTo err_Erase_Numbers

    ctl.Value = Mid(Nz(ctl.Value, ""), 1, Len(Nz(ctl.Value, "")) - 1)
    
Exit Function
err_Erase_Numbers:

    If Err.Number = 5 Or Err.Number = 6 Then
        Resume Next
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If
            
End Function

'Del
Public Function Del_Numbers() As String
On Error GoTo err_Del_Numbers

    Dim L, R As String
    
    If CursorPosition < 0 Then CursorPosition = Len(Nz(ctl.Value, ""))
    
    L = Left(Nz(ctl.Value, ""), CursorPosition)
    R = Mid(Nz(ctl.Value, ""), CursorPosition + 2)
    ctl.Value = L & R
    
Exit Function
err_Del_Numbers:

    If Err.Number = 5 Or Err.Number = 6 Then
        Resume Next
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If
        
End Function

'Backspace
Public Function Backspace_Numbers() As String
On Error GoTo err_Backspace_Numbers

    Dim L, R As String
    
    If CursorPosition < 0 Then CursorPosition = Len(Nz(ctl.Value, ""))
        
    L = Left(Nz(ctl.Value, ""), CursorPosition - 1)
    R = Mid(Nz(ctl.Value, ""), CursorPosition + 1)
    ctl.Value = L & R
    
    CursorPosition = CursorPosition - 1
    
Exit Function
err_Backspace_Numbers:

    If Err.Number = 5 Or Err.Number = 6 Then
        Resume Next
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If
    
End Function

'cmd_Backspace
Private Sub cmd_Backspace_Click()

    Call Backspace_Numbers
End Sub

'cmd_Del
Private Sub cmd_Del_Click()

    Call Del_Numbers
End Sub

'cmd_Erase
Private Sub cmd_Erase_Click()

    Call Erase_Numbers
End Sub

'cmd_enter
Private Sub cmd_enter_Click()
End Sub

'0
Private Sub int_0_Click()

    Call Add_Numbers(0)
End Sub

'1
Private Sub int_1_Click()

    Call Add_Numbers(1)
End Sub

'2
Private Sub int_2_Click()

    Call Add_Numbers(2)
End Sub

'3
Private Sub int_3_Click()

    Call Add_Numbers(3)
End Sub

'4
Private Sub int_4_Click()

    Call Add_Numbers(4)
End Sub

'5
Private Sub int_5_Click()

    Call Add_Numbers(5)
End Sub

'6
Private Sub int_6_Click()

    Call Add_Numbers(6)
End Sub

'7
Private Sub int_7_Click()

    Call Add_Numbers(7)
End Sub

'8
Private Sub int_8_Click()

    Call Add_Numbers(8)
End Sub

'9
Private Sub int_9_Click()

    Call Add_Numbers(9)
End Sub

'.
Private Sub int_Period_Click()

    Call Add_Numbers(".")
End Sub


'A
Private Sub str_A_Click()

    Set ctl = Screen.ActiveControl
End Sub

'track the cursor state when a key is released
'from http://www.utteraccess.com/wiki/index.php/Tracking_A_Textbox_Cursor
Private Sub str_A_KeyUp(KeyCode As Integer, Shift As Integer)

    CursorPosition = Me.str_A.SelStart
    CursorLen = Me.str_A.SelLength
End Sub

'track the cursor state when the mouse button is released
Private Sub str_A_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

    CursorPosition = Me.str_A.SelStart
    CursorLen = Me.str_A.SelLength
End Sub


'B
Private Sub str_B_Click()

    Set ctl = Screen.ActiveControl
End Sub

Private Sub str_B_KeyUp(KeyCode As Integer, Shift As Integer)
    
    CursorPosition = Me.str_B.SelStart
    CursorLen = Me.str_B.SelLength
End Sub

Private Sub str_B_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

    CursorPosition = Me.str_B.SelStart
    CursorLen = Me.str_B.SelLength
End Sub


'C
Private Sub str_C_Click()

    Set ctl = Screen.ActiveControl
End Sub

Private Sub str_C_KeyUp(KeyCode As Integer, Shift As Integer)

    CursorPosition = Me.str_C.SelStart
    CursorLen = Me.str_C.SelLength
End Sub

Private Sub str_C_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

    CursorPosition = Me.str_C.SelStart
    CursorLen = Me.str_C.SelLength
End Sub


'Form_Load
Private Sub Form_Load()

    Set ctl = [str_A]
End Sub

جعفر

تم تعديل هذه المشاركة بواسطة jjafferr في 23 يوليو 2014 في 11:14

#12

أخي جعفر بارك الله فيك على التوضيح الجميل وبالحقيقة فإن الأمر  On Error Resume Next هو للناس اللي ماعندها وسعة بال طويلة (مثلي أنا  :D ) عكس الأمر ((  :ph34r: On Error goto police station)) فهو للناس المحترفة يلي يدققوا في كل حاجة ولو مسكوا خطأ صغير يعتقلوه ويعملوله قضية هههه

ما من كاتبٍ إلا سيفنى ... ويبقي الدهر ما كتبت يداه

فلا تكتب بخطك غير شيءٍ ... يسرك في القيامة أن تراه

 

 

مواضيع مفيدة

 

منظومة حضور وغياب موظفين/index.php/topic/290636-%D8%A5%D9%87%D8%AF%D8%A7%D8%A1-%D8%A7%D9%84%D9%89-%D9%85%D9%86%D8%AA%D8%AF%D9%89-%D8%A7%D9%84%D8%A3%D9%83%D8%B3%D8%B3-%D9%85%D9%86%D8%B8%D9%88%D9%85%D8%A9-%D8%AA%D8%B3%D8%AC%D9%8A%D9%84-%D8%AD%D8%B6%D9%88%D8%B1-%D9%88%D8%BA%D9%8A%D8%A7%D8%A8-%D9%85/

#13

:)

#14

ماشالله عليك اخي الفاضل جعفر وربنا يزيدك من علمه

ولي استفسار أخير بعد إذنك وهو .... لو يوجد لدينا حقل داخل نموذج فرعي من النموذج فكيف يكون الكود في هذه الحالة

وشكرا وسامحني علي الاطالة .

#15

حياك الله :)

 

رجاء عمل النموذج والحقول اللي تريدها ، واشرح لي شو تريد :)

 

جعفر

#16

السلام عليكم  ... اخي الكريم جعفر

المطلوب هو ادخال الأرقام في الحقول ذات اللون الأخضر الموجودة في النموذج الأساسي  وهي ( رقم العميل - رقم السائق - الخصم )

وحقل الكمية الموجود في النموذج الفرعي .. حيث انني اعمل علي شاشة تاتش   مع الشكر

المرفقات

 

 

post-280147-0-24528700-1406143141_thumb.

#17

ارفق لي البرنامج لوسمحت :)

#18

والله اخي الكريم عدة محاولات لرفع الملف ولكنه لم يقبل

#19

الموقع يقبل ملفات مضغوطة مثل zip , rar , 7z

#21

إن شاء الله يكون المطلوب واضح ... وهو إمكانية ادخال الأرقام في الحقول الخضراء سواء في النموذج الأساسي او النموذج الفرعي

وطبعا مع إمكانية المسح ... وشكرا جزيلا وسامحني على الاطالة

#22

اخي الكريم جعفر

لعل المانع خير إن شاء الله

#23

السلام عليكم :)

 

ها ، طولت عليكم ومشتاقين لي  :P

 

في الواقع عملت تغيير شامل للبرنامج ، والتغييرات تعبتني ، ولكن الحمدلله الله ستر :)

 

البرنامج كما هو في الصورة المتحركة (واذا الصورة ما كانت متحركة ، اضغط على الصورة وبتتحرك :) ) :

 

post-273849-0-47748900-1406375250_thumb.

 

 

عمل البرنامج:

1. اضغط على اي من الحقول في النموذج الرئيسي (طبعاَ الحقل لازم يكون فيه هذه الاحداث الثلاث) :

Private Sub str_B_Click()
 
    A_Main_Form = Screen.ActiveForm.Name    '"frm_OnScreen_Keyboard"
    A_SubForm = ""
    A_SubSubForm = ""
    A_Control = Screen.ActiveControl.Name
End Sub
 
Private Sub str_B_KeyUp(KeyCode As Integer, Shift As Integer)
    
    CursorPosition = Me.str_B.SelStart
    CursorLen = Me.str_B.SelLength
End Sub
 
Private Sub str_B_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
    CursorPosition = Me.str_B.SelStart
    CursorLen = Me.str_B.SelLength
End Sub

2. او حقل في النموذج الفرعي (او اذا كان نموذج فرعي داخل نموذج فرعي ثاني) ، وهذا كود الحقل في النموذج الفرعي (لاحظ اني ادخلت اسم النموذج الفرعي في الكود ، اما اذا كان عندنا نموذج فرعي داخل نموذج فرعي ، فلازم ندخل اسم هذا النموذج كذلك اذا اردنا العمل على احد حقوله) :

Private Sub Qty_Click()
 
    A_Main_Form = "frm_OnScreen_Keyboard"
    A_SubForm = "Torder_subform"
    A_SubSubForm = ""
    A_Control = Screen.ActiveControl.Name

End Sub

Private Sub Qty_KeyUp(KeyCode As Integer, Shift As Integer)

    CursorPosition = Me.Qty.SelStart
    CursorLen = Me.Qty.SelLength
End Sub

Private Sub Qty_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
    CursorPosition = Me.Qty.SelStart
    CursorLen = Me.Qty.SelLength
End Sub

3. اضغط على اي من ازرار الارقام ، وهذا حدث الرقم 2 مثلا:

Private Sub int_2_Click()     Call Add_Numbers(2)End Sub

4. الازرار الاخرى Del , BackSpace , Erase ، حدث كل منهم :

'cmd_Backspace
Private Sub cmd_Backspace_Click()
 
    Call Backspace_Numbers
End Sub
 
'cmd_Del
Private Sub cmd_Del_Click()
 
    Call Del_Numbers
End Sub
 
'cmd_Erase
Private Sub cmd_Erase_Click()
 
    Call Erase_Numbers
End Sub

5. والكود المخ للعملية كلها ، هي هذه الوحدة النمطية:

Option Compare Database
Option Explicit
 

    Public A_Main_Form As String
    Public A_SubForm  As String
    Public A_SubSubForm  As String
    Public A_Control  As String
    
    Public CursorPosition As Integer    'start position of the cursor within field
    Public CursorLen As Integer         'selection length of the cursor within field
    
    Dim ctl As Control
    Dim N, L, R As String
    Dim iformat As Integer

 
'set Forms and Controls
Public Function Set_Form_Control()

    iformat = 0
    If Not A_SubSubForm = "" Then iformat = iformat + 2
    If Not A_SubForm = "" Then iformat = iformat + 1
    Select Case iformat
        Case 0:
            Set ctl = Forms(A_Main_Form).Controls(A_Control) 'return Form!control
        Case 1:
            Set ctl = Forms(A_Main_Form).Controls(A_SubForm).Controls(A_Control) 'return form!subform!control
        Case 3:
            Set ctl = Forms(A_Main_Form).Controls(A_SubForm).Controls(A_SubSubForm).Controls(A_Control) 'return form!subform!subsubform!control
        Case Else:
            Set ctl = Null 'wrong number of parameters return null
            MsgBox "wrong number of parameters, Control is null"
    End Select
    
End Function


'Add
Public Function Add_Numbers(N)
 
    Call Set_Form_Control
    
    'don't add more than one "."
    If N = "." And InStr(Nz(ctl.Value, ""), ".") Then Exit Function
    
    
    If CursorPosition < 0 Then CursorPosition = Len(Nz(ctl.Value, 1))
    
    L = Left(Nz(ctl.Value, ""), CursorPosition)
    R = Mid(Nz(ctl.Value, ""), CursorPosition + 1 + CursorLen)

    ctl.Value = L & N & R
  
    CursorPosition = CursorPosition + 1
    CursorLen = 0
    
End Function
 
'Erase
Public Function Erase_Numbers()
On Error GoTo err_Erase_Numbers
 
    Call Set_Form_Control
    
    If CursorLen <> 0 Then
        L = Left(Nz(ctl.Value, ""), CursorPosition)
        R = Mid(Nz(ctl.Value, ""), CursorPosition + 1 + CursorLen)
        ctl.Value = L & R
    Else
        ctl.Value = Mid(Nz(ctl.Value, ""), 1, Len(Nz(ctl.Value, "")) - 1)
    End If

    CursorPosition = Len(Nz(ctl.Value, ""))
    CursorLen = 0
    
Exit Function
err_Erase_Numbers:
 
    If Err.Number = 5 Or Err.Number = 6 Then
        Resume Next
    ElseIf Err.Number = 3314 Then
        MsgBox "You cannot Delete this value"
        Resume Next
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If
            
End Function
 
'Del
Public Function Del_Numbers() As String
On Error GoTo err_Del_Numbers
 
    
    Call Set_Form_Control
    
    If CursorLen <> 0 Then
        L = Left(Nz(ctl.Value, ""), CursorPosition)
        R = Mid(Nz(ctl.Value, ""), CursorPosition + 1 + CursorLen)
        ctl.Value = L & R
    Else
        If CursorPosition < 0 Then CursorPosition = Len(Nz(ctl.Value, 1))
    
        L = Left(Nz(ctl.Value, ""), CursorPosition)
        R = Mid(Nz(ctl.Value, ""), CursorPosition + 2)
        ctl.Value = L & R
    End If
    
    CursorLen = 0
    
Exit Function
err_Del_Numbers:
 
    If Err.Number = 5 Or Err.Number = 6 Then
        Resume Next
    ElseIf Err.Number = 3314 Then
        MsgBox "You cannot Delete this value"
        Resume Next
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If
        
End Function
 
'Backspace
Public Function Backspace_Numbers() As String
On Error GoTo err_Backspace_Numbers
 
    Call Set_Form_Control
    
    If CursorLen <> 0 Then
        L = Left(Nz(ctl.Value, ""), CursorPosition)
        R = Mid(Nz(ctl.Value, ""), CursorPosition + 1 + CursorLen)
        ctl.Value = L & R
    Else
        If CursorPosition < 0 Then CursorPosition = Len(Nz(ctl.Value, 1))
        
        L = Left(Nz(ctl.Value, ""), CursorPosition - 1)
        R = Mid(Nz(ctl.Value, ""), CursorPosition + 1)
        ctl.Value = L & R
    End If
    
    CursorPosition = CursorPosition - 1
    If CursorPosition < 0 Then CursorPosition = 0
    
    CursorLen = 0
    
Exit Function
err_Backspace_Numbers:
 
    If Err.Number = 5 Or Err.Number = 6 Then
        Resume Next
    ElseIf Err.Number = 3314 Then
        MsgBox "You cannot Delete this value"
        Resume Next
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If
    
End Function

6عند كتابة الارقام ،

أ- لا يسمح لك البرنامج إلا بإدخال خانة فاصلة واحدة "." ،

ب- زر الارقام تدخل الارقام للأمام ، وبين الارقام في مكان cursor ، واذا كان فيه مجموعة ارقام مختارة في الحقل ، فانه يستبدلها ،

ج- زر Del يمسح للأمام ، وبين الارقام  في مكان cursor ، واذا كان فيه مجموعة ارقام مختارة في الحقل ، فانه يمسحها ،

د- زر Backspace يمسح للخلف ، وبين الارقام  في مكان cursor ، واذا كان فيه مجموعة ارقام مختارة في الحقل ، فانه يمسحها ،

هـ- زر Erase يمسح للخلف من آخر رقم ، واذا كان فيه مجموعة ارقام مختارة في الحقل ، فانه يمسحها ،

 

وبس :)

 

ومرفق البرنامج الاصلي ، وبرنامج الاخ وائل اللي فيه النموذج الفرعي :)

 

جعفر

223.OnScreen_Keyboard.mdb.zip

223.ارقام الكيبورد.mdb.zip

تم تعديل هذه المشاركة بواسطة jjafferr في 26 يوليو 2014 في 15:30

#24

تسلم ايدك اخي الكريم جعفر وبارك الله في عمرك

تمت التجربة ممتاااز    ولكن بعد اذنك هناك مشكلة في العلامة العشرية ( " . " ) عند إدخالها في حقل الخصم لم يقبلها ؟؟؟ لماذا

 وجزالك الله كل خير

#25

شكرا على الملاحظة :)

 

تم عمل تغيير في الوحدة النمطية ، واضفت لها المتغير Period_Number ، وهي الان:

    Public A_Main_Form As String
    Public A_SubForm  As String
    Public A_SubSubForm  As String
    Public A_Control  As String
    Public Period_Number As String
    
    Public CursorPosition As Integer    'start position of the cursor within field
    Public CursorLen As Integer         'selection length of the cursor within field
    
    Dim ctl As Control
    Dim N, L, R As String
    Dim iformat As Integer

 
'set Forms and Controls
Public Function Set_Form_Control()

    iformat = 0
    If Not A_SubSubForm = "" Then iformat = iformat + 2
    If Not A_SubForm = "" Then iformat = iformat + 1
    Select Case iformat
        Case 0:
            Set ctl = Forms(A_Main_Form).Controls(A_Control) 'return Form!control
        Case 1:
            Set ctl = Forms(A_Main_Form).Controls(A_SubForm).Controls(A_Control) 'return form!subform!control
        Case 3:
            Set ctl = Forms(A_Main_Form).Controls(A_SubForm).Controls(A_SubSubForm).Controls(A_Control) 'return form!subform!subsubform!control
        Case Else:
            Set ctl = Null 'wrong number of parameters return null
            MsgBox "wrong number of parameters, Control is null"
    End Select
    
End Function


'Add
Public Function Add_Numbers(N)
 
    Call Set_Form_Control
    
    'don't add more than one "."
    If N = "." And InStr(Nz(ctl.Value, ""), ".") Then Exit Function
    
    
    If CursorPosition < 0 Then CursorPosition = Len(Nz(ctl.Value, 1))
    
    L = Left(Nz(ctl.Value, ""), CursorPosition)
    R = Mid(Nz(ctl.Value, ""), CursorPosition + 1 + CursorLen)

    
    If N = "." Then
        ctl.Value = L & N & R
        Period_Number = L & N & R
    Else
        If Period_Number <> "" Then
            ctl.Value = Period_Number & N & R
            Period_Number = ""
        Else
            ctl.Value = L & N & R
        End If
    End If
    
        
    
    CursorPosition = CursorPosition + 1
    CursorLen = 0
    
End Function
 
'Erase
Public Function Erase_Numbers()
On Error GoTo err_Erase_Numbers
 
    Call Set_Form_Control
    
    If CursorLen <> 0 Then
        L = Left(Nz(ctl.Value, ""), CursorPosition)
        R = Mid(Nz(ctl.Value, ""), CursorPosition + 1 + CursorLen)
        ctl.Value = L & R
    Else
        ctl.Value = Mid(Nz(ctl.Value, ""), 1, Len(Nz(ctl.Value, "")) - 1)
    End If

    CursorPosition = Len(Nz(ctl.Value, ""))
    CursorLen = 0
    
Exit Function
err_Erase_Numbers:
 
    If Err.Number = 5 Or Err.Number = 6 Then
        Resume Next
    ElseIf Err.Number = 3314 Then
        MsgBox "You cannot Delete this value"
        Resume Next
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If
            
End Function
 
'Del
Public Function Del_Numbers() As String
On Error GoTo err_Del_Numbers
 
    
    Call Set_Form_Control
    
    If CursorLen <> 0 Then
        L = Left(Nz(ctl.Value, ""), CursorPosition)
        R = Mid(Nz(ctl.Value, ""), CursorPosition + 1 + CursorLen)
        ctl.Value = L & R
    Else
        If CursorPosition < 0 Then CursorPosition = Len(Nz(ctl.Value, 1))
    
        L = Left(Nz(ctl.Value, ""), CursorPosition)
        R = Mid(Nz(ctl.Value, ""), CursorPosition + 2)
        ctl.Value = L & R
    End If
    
    CursorLen = 0
    
Exit Function
err_Del_Numbers:
 
    If Err.Number = 5 Or Err.Number = 6 Then
        Resume Next
    ElseIf Err.Number = 3314 Then
        MsgBox "You cannot Delete this value"
        Resume Next
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If
        
End Function
 
'Backspace
Public Function Backspace_Numbers() As String
On Error GoTo err_Backspace_Numbers
 
    Call Set_Form_Control
    
    If CursorLen <> 0 Then
        L = Left(Nz(ctl.Value, ""), CursorPosition)
        R = Mid(Nz(ctl.Value, ""), CursorPosition + 1 + CursorLen)
        ctl.Value = L & R
    Else
        If CursorPosition < 0 Then CursorPosition = Len(Nz(ctl.Value, 1))
        
        L = Left(Nz(ctl.Value, ""), CursorPosition - 1)
        R = Mid(Nz(ctl.Value, ""), CursorPosition + 1)
        ctl.Value = L & R
    End If
    
    CursorPosition = CursorPosition - 1
    If CursorPosition < 0 Then CursorPosition = 0
    
    CursorLen = 0
    
Exit Function
err_Backspace_Numbers:
 
    If Err.Number = 5 Or Err.Number = 6 Then
        Resume Next
    ElseIf Err.Number = 3314 Then
        MsgBox "You cannot Delete this value"
        Resume Next
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If
    
End Function

جعفر

223.ارقام الكيبورد.mdb.zip

مواضيع مشابهة

عدد الزوار حالياً

المتواجدون خلال آخر دقيقتين · يتحدّث كل ٣٠ ثانية

—الإجمالي—أعضاء مسجّلون—زوار بدون تسجيل

جارٍ التحقق من المتواجدين…