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

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

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

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

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

textual
Листинг программы
Option Explicit
 
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GetMem4 Lib "msvbvm60" (Src As Any, Dst As Any) As Long
Private Declare Function lstrcpyn Lib "kernel32" Alias "lstrcpynW" (lpString1 As Any, lpString2 As Any, ByVal iMaxLength As Long) As Long
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
 
Private Const WM_PASTE          As Long = &H302
Private Const CF_UNICODETEXT    As Long = 13
Private Const EM_REPLACESEL     As Long = &HC2
 
Dim WithEvents s As clsTrickSubclass
 
Private Sub Form_Load()
    Set s = New clsTrickSubclass
    s.Hook Text1.hwnd
End Sub
 
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)
    If Msg = WM_PASTE Then
        ' Копируем локаль
        Dim hMem As Long
        Dim ptr  As Long
        Dim size As Long
        Dim txt  As String
        
        If OpenClipboard(0) Then
            
            hMem = GetClipboardData(CF_UNICODETEXT)
            
            If hMem Then
                
                size = GlobalSize(hMem)
                
                If size Then
                
                    txt = Space(size \ 2 - 1)
                    ptr = GlobalLock(hMem)
                    lstrcpyn ByVal StrPtr(txt), ByVal ptr, size
                    GlobalUnlock hMem
                    
                    ' Здесь можно изменить буфер, а можно просто вставить текст
                    
                    SendMessage hwnd, EM_REPLACESEL, True, ByVal StrPtr(txt)
                    
                End If
                
            End If
            
            CloseClipboard
 
            Exit Sub
        End If
    End If
    DefCall = True
End Sub

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


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

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

8   голосов , оценка 4.125 из 5
Похожие ответы