View Full Version : سوال: پیست و نوشته شدن فقط حروف فارسی در ComboBox
Hassan2500
دوشنبه 01 آبان 1391, 14:09 عصر
سلام
کدی میخوام که در ComboBox فقط حروف زیر پیست و نوشته بشن
حروف: ابپتثجچحخدذرزژسشصضطظعغفقک گلمنوهي
امین مستانی
دوشنبه 01 آبان 1391, 15:04 عصر
سلام علیکم
Private Sub Combo1_KeyPress(KeyAscii As Integer)
Dim Str As String
Str = "abcd"
If InStr(Str, Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub
حروف خودتون رو جایگزین abcd کنید
موفق باشید
Hassan2500
دوشنبه 01 آبان 1391, 15:13 عصر
جناب مستانی میخوام بجزء این حروفی که نوشتم در ComboBox دیگه هیچی هم پیست نشه
امین مستانی
دوشنبه 01 آبان 1391, 15:26 عصر
این پست جناب واژدی رو بررسی کنید
http://barnamenevis.org/showthread.php?299217-%D8%AC%D9%84%D9%88%DA%AF%DB%8C%D8%B1%DB%8C-%D8%A7%D8%B2-Paste-%D8%AD%D8%B1%D9%88%D9%81-%D8%A7%D9%86%DA%AF%D9%84%DB%8C%D8%B3%DB%8C-%D9%88-%D8%A8%D8%B9%D8%B6%DB%8C-%D8%B9%D9%84%D8%A7%D9%85%D8%AA%D9%87%D8%A7-%D8%AF%D8%A7%D8%AE%D9%84-Text&p=1312900&viewfull=1#post1312900
موفق باشید
Hassan2500
دوشنبه 01 آبان 1391, 15:44 عصر
این پست رو دیدم که برای TextBox نوشته شده و نمیدونم چطوری باید کدهاش رو برای ComboBox تغییر داد
امین مستانی
سه شنبه 02 آبان 1391, 02:07 صبح
نمونه زیر رو ببینید
Private Sub Combo1_Change()
Dim Str, StrI As String
Str = "ابپتثجچحخدذرزژسشصضطظعغفقک گلمنوهي"
For i = 1 To Len(Combo1.text)
StrI = Mid(Combo1.text, i, 1)
If InStr(Str, StrI) = 0 Then
Combo1.text = Replace(Combo1.text, StrI, "")
End If
Next i
End Sub
میتونید با کمی تغییر بهترش کنید
موفق باشید
Hassan2500
سه شنبه 02 آبان 1391, 12:55 عصر
جناب مستانی اگه زحمت بکشید و این کد رو که برای اینه که فقط حروف فارسی در TextBox نوشته و پیست بشن رو واسه ComboBox تغییرش بدید ممنون میشم در ضمن کد خودتون هم عالی بود
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const WM_DESTROY = &H2
Private Const GWL_WNDPROC = (-4)
Private Const WM_CONTEXTMENU = &H7B
Private Const WM_KEYDOWN = &H100
Private Const WM_KEYPRESS = &H102
Private Const WM_CHAR = &H102
Private Const WM_PASTE As Long = &H302
Private lPProc&
Private m_bAlsoDisableRightClickMenu As Boolean
Private Const sValidChrs$ = "ابپتثجچحخدذرزژسشصضطظعغفقک گلمنوهي"
Public Sub TextBoxClipboardHook(tTextBox As TextBox, Optional bAlsoDisableRightClickMenu As Boolean = False)
On Error Resume Next
If lPProc& <> 0 Then SetWindowLong tTextBox.hWnd, GWL_WNDPROC, lPProc&
m_bAlsoDisableRightClickMenu = bAlsoDisableRightClickMenu
lPProc& = SetWindowLong(tTextBox.hWnd, GWL_WNDPROC, AddressOf ProcMessages)
End Sub
Private Function ProcMessages(ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error Resume Next
Dim sCBText$
Debug.Print wParam, lParam
If msg = WM_CONTEXTMENU And m_bAlsoDisableRightClickMenu Then
Exit Function
ElseIf msg = WM_DESTROY Then
SetWindowLong hWnd, GWL_WNDPROC, lPProc&
Exit Function
ElseIf msg = WM_PASTE Then
sCBText$ = Clipboard.GetText
Clipboard.Clear
Clipboard.SetText SepValidChrs(sCBText$)
ElseIf (msg = 258) And Not wParam = 22 And Not wParam = 24 And Not wParam = 3 And Not lParam = 3080193 Then
If InStr(sValidChrs$, Chr(wParam)) = 0 And Not wParam = 8 Then Exit Function
End If
ProcMessages = CallWindowProc(lPProc&, hWnd, msg, wParam, lParam)
End Function
Private Function SepValidChrs(sText$) As String
On Error Resume Next
Dim i&, sTmpHold$, sChr$
For i = 1 To Len(sText$)
sChr$ = Mid(sText$, i, 1)
If InStr(1, sValidChrs$, sChr$) > 0 Then
sTmpHold$ = sTmpHold$ & sChr$
End If
Next 'i
SepValidChrs = sTmpHold$
End Function
Private Sub Form_Load()
TextBoxClipboardHook Text1
End Sub
محسن واژدی
سه شنبه 02 آبان 1391, 13:25 عصر
سلام علیکم
با اجازه آقای مستانی
تابع:
Public Sub TextBoxClipboardHook(oTB_CB As Object, Optional bAlsoDisableRightClickMenu As Boolean = False)
On Error Resume Next
If lPProc& <> 0 Then SetWindowLong oTB_CB.hWnd, GWL_WNDPROC, lPProc&
m_bAlsoDisableRightClickMenu = bAlsoDisableRightClickMenu
lPProc& = SetWindowLong(oTB_CB.hWnd, GWL_WNDPROC, AddressOf ProcMessages)
End Sub
را جایگزین:
Public Sub TextBoxClipboardHook(tTextBox As TextBox, Optional bAlsoDisableRightClickMenu As Boolean = False)
On Error Resume Next
If lPProc& <> 0 Then SetWindowLong tTextBox.hWnd, GWL_WNDPROC, lPProc&
m_bAlsoDisableRightClickMenu = bAlsoDisableRightClickMenu
lPProc& = SetWindowLong(tTextBox.hWnd, GWL_WNDPROC, AddressOf ProcMessages)
End Sub
کنید
موفق باشید
Hassan2500
سه شنبه 02 آبان 1391, 20:41 عصر
جناب واژدی تابع رو جایگزین کردم اما عمل نمیکنه و حروف غیر فارسی در Combo1 نوشته و پست میشن اگه امکان داره سورس قرار بدید
محسن واژدی
سه شنبه 02 آبان 1391, 21:22 عصر
جناب واژدی تابع رو جایگزین کردم اما عمل نمیکنه و حروف غیر فارسی در Combo1 نوشته و پست میشن اگه امکان داره سورس قرار بدید
ظاهرا" تابع مشکلی نداشت، چه کاراکترهایی نوشته میشن؟
Hassan2500
سه شنبه 02 آبان 1391, 21:27 عصر
حروف غیر فارسی هم نوشته میشن هم پیست میشن و اون کدی که در پست8 گفتید جایگزین کنید رو جایگزین کردم ولی کار نمیکنه دوست عزیز اگه زحمتی نیست سورس قرار بدید
محسن واژدی
سه شنبه 02 آبان 1391, 22:18 عصر
حروف غیر فارسی هم نوشته میشن هم پیست میشن و اون کدی که در پست8 گفتید جایگزین کنید رو جایگزین کردم ولی کار نمیکنه دوست عزیز اگه زحمتی نیست سورس قرار بدید
اینطور که دیدم تنها مشکل در پذیرفتن کاراکتر V بود که آنهم بگونه ای جلوگیری شد، ضمیمه زیر را بررسی کنید
موفق باشید
Hassan2500
سه شنبه 02 آبان 1391, 22:55 عصر
آقای واژدی این کدتون برای TextBox درست عمل میکنه من میخوام کد رو واسه ComboBox تغییرش بدید یعنی در ComboBox حروف غیر فارسی نوشته و پیست نشن در واقع سورس رو من برای ComboBox خواستم
محسن واژدی
سه شنبه 02 آبان 1391, 23:04 عصر
دوباره ضمیمه پست 12 رو بررسی کنید انشاءا... درسته
موفق باشید
vBulletin® v4.2.5, Copyright ©2000-1403, Jelsoft Enterprises Ltd.