При копировании в TextBox буфера портится русский текст - VB

Узнай цену своей работы

Формулировка задачи:

Здравствуйте !!! Подскажите, пожалуйста, как при включенной английской раскладке клавиатуры сделать, чтобы копирование текста в TextBox не сопровождалось коверканьем русских символов?

Решение задачи: «При копировании в TextBox буфера портится русский текст»

textual
Листинг программы
  1. Option Explicit
  2.  
  3. Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
  4. Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
  5. Private Declare Function CloseClipboard Lib "user32" () As Long
  6. Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
  7. Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
  8. Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
  9. Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
  10. Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
  11. Private Declare Function GetMem4 Lib "msvbvm60" (Src As Any, Dst As Any) As Long
  12. Private Declare Function lstrcpyn Lib "kernel32" Alias "lstrcpynW" (lpString1 As Any, lpString2 As Any, ByVal iMaxLength As Long) As Long
  13. Private Declare Function SendMessage Lib "user32" Alias "SendMessageW" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  14.  
  15. Private Const WM_PASTE          As Long = &H302
  16. Private Const CF_UNICODETEXT    As Long = 13
  17. Private Const EM_REPLACESEL     As Long = &HC2
  18.  
  19. Dim WithEvents s As clsTrickSubclass
  20.  
  21. Private Sub Form_Load()
  22.     Set s = New clsTrickSubclass
  23.     s.Hook Text1.hwnd
  24. End Sub
  25.  
  26. Private Sub s_WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, Ret As Long, DefCall As Boolean)
  27.     If Msg = WM_PASTE Then
  28.         ' Копируем локаль
  29.        Dim hMem As Long
  30.         Dim ptr  As Long
  31.         Dim size As Long
  32.         Dim txt  As String
  33.        
  34.         If OpenClipboard(0) Then
  35.            
  36.             hMem = GetClipboardData(CF_UNICODETEXT)
  37.            
  38.             If hMem Then
  39.                
  40.                 size = GlobalSize(hMem)
  41.                
  42.                 If size Then
  43.                
  44.                     txt = Space(size \ 2 - 1)
  45.                     ptr = GlobalLock(hMem)
  46.                     lstrcpyn ByVal StrPtr(txt), ByVal ptr, size
  47.                     GlobalUnlock hMem
  48.                    
  49.                     ' Здесь можно изменить буфер, а можно просто вставить текст
  50.                    
  51.                     SendMessage hwnd, EM_REPLACESEL, True, ByVal StrPtr(txt)
  52.                    
  53.                 End If
  54.                
  55.             End If
  56.            
  57.             CloseClipboard
  58.  
  59.             Exit Sub
  60.         End If
  61.     End If
  62.     DefCall = True
  63. End Sub

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

8   голосов , оценка 4.125 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы