BackSpace در یک تابع

[Mohamad ghorbani]

سلام
من یه تابع خیلی ساده نوشتم که طرز کارش اینه:
اگه شما یه کاراکتر غیر فارسی تایپ کنی، به شما ارور می ده.
اینم کدش:

Public Function none(InputText As String)
Dim x As String, y As Integer
y = Len(InputText) 'محاسبه تعداد کاراکترهاي ورودي

If InputText <> "" Then
x = Mid(InputText, y, 1) 'به دست آوردن آخرين کاراکتر وارد شده

If Asc(x) >= 193 And Asc(x) <= 237 Then 'اگر در مقدار ورودي غير از کارکتر فارسي وارد شود پيغام مي دهد
Else
MsgBox "Error, Please Type Just Farsi Char(s)"
End If

End If


End Function

Private Sub Text1_Change()
Dim value1 As String
value1 = Text1.Text
Call none(value1)
End Sub


حالا می خوام وقتی که ارور داد آخرین حرفی که وارد شده رو پاک کنه.
یعنی وقتی که یه کاراکتر غیر از فارسی وارد شد، خودش اون کاراکتر رو پاک کنه.


متشکرم

[محسن واژدی]

سلام
بنظر بنده بهترین گزینه پیش رو استفاده از sub-classing است
در صورتیکه با sub-classing کار کرده اید، کد موجود در پست زیر را میتوانید برای محدود سازی textbox ویرایش کنید:
http://barnamenevis.org/showthread.php?318010-%DA%A9%D9%84%DB%8C%DA%A9-%D8%B1%D8%A7%D8%B3%D8%AA&goto=newpost

موفق باشید

[محسن واژدی]

کد زیر را هم امتحان کنید:

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii >= 193 And KeyAscii <= 237 Or KeyAscii = vbKeyBack Or KeyAscii = vbKeySpace Then 'اگر در مقدار ورودي غير از کارکتر فارسي وارد شود پيغام مي دهد
'''
Else
Select Case KeyAscii
Case vbKeyA Or vbKeyA + 32: KeyAscii = Asc("ش")
Case vbKeyB Or vbKeyB + 32: KeyAscii = Asc("ذ")
Case vbKeyC Or vbKeyC + 32: KeyAscii = Asc("ز")
Case vbKeyD Or vbKeyD + 32: KeyAscii = Asc("ي")
Case vbKeyE Or vbKeyE + 32: KeyAscii = Asc("ث")
Case vbKeyF Or vbKeyF + 32: KeyAscii = Asc("ب")
Case vbKeyG Or vbKeyG + 32: KeyAscii = Asc("ل")
Case vbKeyH Or vbKeyH + 32: KeyAscii = Asc("ا")
Case vbKeyI Or vbKeyI + 32: KeyAscii = Asc("ه")
Case vbKeyJ Or vbKeyJ + 32: KeyAscii = Asc("ت")
Case vbKeyK Or vbKeyK + 32: KeyAscii = Asc("ن")
Case vbKeyL Or vbKeyL + 32: KeyAscii = Asc("م")
Case vbKeyM Or vbKeyM + 32: KeyAscii = Asc("ئ")
Case vbKeyN Or vbKeyN + 32: KeyAscii = Asc("د")
Case vbKeyO Or vbKeyO + 32: KeyAscii = Asc("خ")
Case vbKeyP Or vbKeyP + 32: KeyAscii = Asc("ح")
Case vbKeyQ Or vbKeyQ + 32: KeyAscii = Asc("ض")
Case vbKeyR Or vbKeyR + 32: KeyAscii = Asc("ق")
Case vbKeyS Or vbKeyS + 32: KeyAscii = Asc("س")
Case vbKeyT Or vbKeyT + 32: KeyAscii = Asc("ف")
Case vbKeyU Or vbKeyU + 32: KeyAscii = Asc("ع")
Case vbKeyV Or vbKeyV + 32: KeyAscii = Asc("ر")
Case vbKeyW Or vbKeyW + 32: KeyAscii = Asc("ص")
Case vbKeyX Or vbKeyX + 32: KeyAscii = Asc("ط")
Case vbKeyY Or vbKeyY + 32: KeyAscii = Asc("غ")
Case vbKeyZ Or vbKeyZ + 32: KeyAscii = Asc("ظ")
Case 39, 144: KeyAscii = Asc("گ")
Case 59, 152: KeyAscii = Asc("ک")
Case 44: KeyAscii = Asc("و")
Case 91: KeyAscii = Asc("ج")
Case 93, 141: KeyAscii = Asc("چ")

Case Else
KeyAscii = 0
End Select
End If
End Sub

در کدبالا فرقی نمیکند صفحه کلید انگلیسی باشد یا فارسی بهرحال فارسی تایپ میشود :)
برای غیرفعال کردن گزینه paste هم میتوانید کدهای لینکی که در پست قبل اشاره شد تغییر دهید

موفق باشید

[IamOverlord]

برای پاک کردن آخرین کاراکتر :
YourString = Mid(YourString, 1, Len(YourString) - 1)

[محسن واژدی]

برای پاک کردن آخرین کاراکتر :

YourString = Mid(YourString, 1, Len(YourString) - 1)


سلام
متاسفانه اگر آخرین کاراکتر تایپ شده جایی بجز انتهای متن باشد به عنوان مثال در وسط متن ، حذف نمیشود

[IamOverlord]

خوب پس باید متغیر رشته ای LastYourString رو هم تعریف کنی.

[Mohamad ghorbani]

با تشکر از همه .
ولی فکر کنم منظورم رو متوجه نشدید.
من می خوام وقتی که کاراکتر غیر از فارسی وارد شد کاراکتر آخر حذف بشه.
توی کد بالا وقتی که تشخیص میده که کاراکتر غیر فارسی وارد شده، نمیشه آخرین کاراکتر رو از توی تکس باکس پاک کرد.
اگه کامپایلش کنید متوجه میشید مشکلم چیه.
اگه باز هم بد توضیح دادم بگید کاملتر توضیح بدم.

[vb6_man]

Text1.SetFocus
SendKeys "{backSpace}"
:بامزه:

[Mohamad ghorbani]

Text1.SetFocus
SendKeys "{backSpace}"
با تشکر ولی اگه می شه توی تابع توضیح بدید.
توی تابع که نمیشه نوشت :
text1.setfocus
میشه؟ نمیشه

[vb6_man]

چرا نمی شه؟
Form1.Text1.Setfocus

[Mohamad ghorbani]

آخه توی تابع شما نمیدونی که می خوای از کدوم تکس باکس استفاده کنی.

[vb6_man]

خب Text رو بفرست واسه تابع

public Function (Txt as TextBox)
....
end Function

[Mohamad ghorbani]

من که نتونستم. یه لطفی میکنی توی پروژه برام ضمینه کنی؟
البته با همون کدی که خودم فرستادم
خیلی ممنون

[vb6_man]

من که نتونستم. یه لطفی میکنی توی پروژه برام ضمینه کنی؟
البته با همون کدی که خودم فرستادم
خیلی ممنون

بفرمایید
البته این کد که شما نوشتی (همینی که ضمیمه کردم)یه اشکال داره
البته جزئی هست
ببینیم متوجه می شی:لبخند:

[Mohamad ghorbani]

تشکر فراوان از vb6_man عزیز.
ولی ارور میده. کامپایلش کرده بودی؟
روی خطی که SendKeys هست ارور میده

[vb6_man]

واااااااااااااا:متعجب:
پ نه پ کامپایل نکردم فایل Exe رو با Notepad نوشتم چون تو این خط Error می داد:بامزه:

شما دقیقا همین فایل رو گرفتی و اجرا کردی و error داد واست؟:متفکر:
تو سیستم من Error نمی ده فکر کنم از من می ترسه
راستشو بگو
سیخ دادی خرابش کردی؟:شیطان::اشتباه:
:قهقهه:

[Mohamad ghorbani]

روی سیستم من که ارور داد.
به هر حال متشکرم.
دوستان عزیز اگه میتونید شما هم امتحان کنید. ببینید اشکال از برنامه هست یا از سیستم من.
با تشکر

[sr2m72]

روی سیستم من که ارور داد.
به هر حال متشکرم.
دوستان عزیز اگه میتونید شما هم امتحان کنید. ببینید اشکال از برنامه هست یا از سیستم من.
با تشکر

منم امتحان كردم.
اررور نداد.

[محسن واژدی]

روی سیستم من که ارور داد.
به هر حال متشکرم.
دوستان عزیز اگه میتونید شما هم امتحان کنید. ببینید اشکال از برنامه هست یا از سیستم من.
با تشکر

سلام
کد جناب vb6_man مشکلی نداشت، فقط تنها مشکلی که وجود دارد Ctrl+V و RClick است که این را هم میتوانید به شیوه های مختلف از جمله جایگزین کردن منویی بجای منوی استاندارد یا کنترل کردن میانبرهای ctrl+v

موفق باشید