پیست و نوشته شدن فقط حروف فارسی در ComboBox

[Hassan2500]

سلام

کدی میخوام که در ComboBox فقط حروف زیر پیست و نوشته بشن

حروف: ابپتثجچحخدذرزژسشصضطظعغفقک گلمنوهي

[امین مستانی]

سلام علیکم

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]

جناب مستانی میخوام بجزء این حروفی که نوشتم در ComboBox دیگه هیچی هم پیست نشه

[امین مستانی]

این پست جناب واژدی رو بررسی کنید

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]

این پست رو دیدم که برای TextBox نوشته شده و نمیدونم چطوری باید کدهاش رو برای ComboBox تغییر داد

[امین مستانی]

نمونه زیر رو ببینید


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]

جناب مستانی اگه زحمت بکشید و این کد رو که برای اینه که فقط حروف فارسی در 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

[محسن واژدی]

سلام علیکم
با اجازه آقای مستانی

تابع:
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]

جناب واژدی تابع رو جایگزین کردم اما عمل نمیکنه و حروف غیر فارسی در Combo1 نوشته و پست میشن اگه امکان داره سورس قرار بدید

[محسن واژدی]

جناب واژدی تابع رو جایگزین کردم اما عمل نمیکنه و حروف غیر فارسی در Combo1 نوشته و پست میشن اگه امکان داره سورس قرار بدید
ظاهرا" تابع مشکلی نداشت، چه کاراکترهایی نوشته میشن؟

[Hassan2500]

حروف غیر فارسی هم نوشته میشن هم پیست میشن و اون کدی که در پست8 گفتید جایگزین کنید رو جایگزین کردم ولی کار نمیکنه دوست عزیز اگه زحمتی نیست سورس قرار بدید

[محسن واژدی]

حروف غیر فارسی هم نوشته میشن هم پیست میشن و اون کدی که در پست8 گفتید جایگزین کنید رو جایگزین کردم ولی کار نمیکنه دوست عزیز اگه زحمتی نیست سورس قرار بدید

اینطور که دیدم تنها مشکل در پذیرفتن کاراکتر V بود که آنهم بگونه ای جلوگیری شد، ضمیمه زیر را بررسی کنید

موفق باشید

[Hassan2500]

آقای واژدی این کدتون برای TextBox درست عمل میکنه من میخوام کد رو واسه ComboBox تغییرش بدید یعنی در ComboBox حروف غیر فارسی نوشته و پیست نشن در واقع سورس رو من برای ComboBox خواستم

[محسن واژدی]

دوباره ضمیمه پست 12 رو بررسی کنید انشاءا... درسته

موفق باشید