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

Dragokas · Регистрация: 25.12.2011

Студворк — интернет-сервис помощи студентам

Здравствуйте !!!

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

@The trick · 07.09.2014, 20:13

Нужно дополнительно копировать локаль CF_LOCALE.

Данные - дескриптор идентификатора местности (страны), связанного с текстом в буфере обмена. Когда Вы закрываете буфер обмена, если он содержит данные формата CF_TEXT, а не данные формата CF_LOCALE, система автоматически устанавливает формат CF_LOCALE на текущий язык ввода данных. Вы можете использовать формат CF_LOCALE, чтобы связать различные национальные языки с текстом буфера обмена.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Option Explicit
 
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hmem As Long) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd 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 GetMem4 Lib "msvbvm60" (Src As Any, Dst As Any) As Long
 
Private Const CF_LOCALE     As Long = 16
Private Const WM_COPY       As Long = &H301
Private Const GMEM_MOVEABLE As Long = &H2
 
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_COPY Then
        ' Копируем текст по умолчанию
        s.CallDef hwnd, Msg, wParam, lParam, False
        ' Копируем локаль
        Dim hmem As Long
        Dim ptr  As Long
        If OpenClipboard(hwnd) Then
            hmem = GlobalAlloc(GMEM_MOVEABLE, 4)
            If hmem = 0 Then Exit Sub
            ptr = GlobalLock(hmem)
            If ptr = 0 Then Exit Sub
            GetMem4 &H419, ByVal ptr
            GlobalUnlock hmem
            SetClipboardData CF_LOCALE, hmem
            CloseClipboard
            GlobalFree hmem
        End If
    Else: DefCall = True
    End If
End Sub

Dragokas · 07.09.2014, 23:06 **[ТС]**

Так. Только мне нужно наоборот, не скопировать из TextBox-a, а вставить в него текст.

Переставил блоки. Так не работает:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Const WM_PASTE      As Long = &H302
 
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
        If OpenClipboard(hwnd) Then
            hmem = GlobalAlloc(GMEM_MOVEABLE, 4)
            If hmem = 0 Then Exit Sub
            ptr = GlobalLock(hmem)
            If ptr = 0 Then Exit Sub
            GetMem4 &H419, ByVal ptr
            GlobalUnlock hmem
            SetClipboardData CF_LOCALE, hmem
            CloseClipboard
            GlobalFree hmem
        End If
        ' Копируем текст по умолчанию
        s.CallDef hwnd, Msg, wParam, lParam, False
    Else: DefCall = True
    End If
End Sub

На этом этапе вставки, изменения локали уже не дают эффекта?

Добавлено через 1 час 10 минут
The trick, попробовал "помутузить" код из 2-го поста:
- когда запускаешь из IDE. Закрываешь форму крестиком. И так по кругу.
Где-то на 3-5-ый раз, OpenClipboard почему-то возвращает 0.

В скомпилированном приложении такой проблемы не наблюдается.

@The trick · 07.09.2014, 23:16

Сообщение от Dragokas

На этом этапе вставки, изменения локали уже не дают эффекта?

Текст уже находится в преобразованном виде, и символы отсутствующие в данной кодовой странице преобразуются в "?". Для вставки можно брать текст не в CF_TEXT формате, а в CF_UNICODETEXT:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
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

Добавлено через 2 минуты

Сообщение от Dragokas

The trick, попробовал "помутузить" код из 2-го поста:
- когда запускаешь из IDE. Закрываешь форму крестиком. И так по кругу.
Где-то на 3-5-ый раз, OpenClipboard почему-то возвращает 0.

GlobalFree убери, я его в попыхах написал - он не нужен. Каждому удачному вызову OpenClipboard должен быть соответствующий вызов CloseClipboard.

Dragokas · 07.09.2014, 23:44 **[ТС]**

Сообщение от The trick

GlobalFree убери, я его в попыхах написал - он не нужен. Каждому удачному вызову OpenClipboard должен быть соответствующий вызов CloseClipboard.

Неа. Что-то еще.
GlobalFree убрал. Debug.Print-ы расставил.
Предыдущий вызов перед неудачным показывает, что CloseClipboard вернул 1. hmem и ptr тоже не 0.

Вообщем, в скомпилированном приложении оба сведенных вместе кода работают идеально.
CloseClipboard расставил во все досрочные выходы из веток.
Тема решена. Спасибо огромное.

Dragokas · 11.06.2015, 14:17 **[ТС]**

Анатолий, нет ли идей, почему в некоторых случаях может не срабатывать?
Например, если скопировать русский текст из окна редактора VBE при англ. раскладке.
(функции не возвращают ошибок)

Это тот же самый код, только с дебагами.

Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
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 txt  As String
        txt = GetClipboard_UnicodeText()
        If txt <> "" Then
            ' Здесь можно изменить буфер, а можно просто вставить текст
            SendMessage hwnd, EM_REPLACESEL, True, ByVal StrPtr(txt)
            Exit Sub
        End If
    End If
    DefCall = True
End Sub
 
Function GetClipboard_UnicodeText() As String
    On Error GoTo ErrorHandler
        Dim hMem As Long
        Dim ptr  As Long
        Dim Size As Long
        Dim txt  As String
        
        If OpenClipboard(0) Then
            hMem = GetClipboardData(CF_UNICODETEXT)
            Debug.Print "hMem=" & hMem
            If hMem Then
                Size = GlobalSize(hMem)
                Debug.Print "Size=" & Size
                If Size Then
                    txt = Space(Size \ 2 - 1)
                    ptr = GlobalLock(hMem)
                    lstrcpyn ByVal StrPtr(txt), ByVal ptr, Size
                    GlobalUnlock hMem
                    GetClipboard_UnicodeText = txt
                    CloseClipboard
                    Exit Function
                End If
            End If
            CloseClipboard
        End If
    Exit Function
ErrorHandler:
    Debug.Print " - #" & Err.Number & " " & Err.Description & ". LastDllError = " & Err.LastDllError
End Function

@The trick · 11.06.2015, 14:49

При копировании из VBE при включенной английской раскладке юникод некорректен.

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

Поэтому нужно смотреть сначала локаль:

Если там 409 то значит текст был скопирован при включенной английской раскладке, поэтому бери данные из CF_TEXT или просто из Clipboard.GetText.

Dragokas · 11.06.2015, 17:35 **[ТС]**

Признателен. Спасибо.

Добавлено через 47 минут
Собственно, какое значение в CF_LOCALE не важно. С таким же успехом, в CF_UNICODE будут корректные данные, а в CF_TEXT нет (если скопировать с юникодного контрола в англ. раскладке).
Тут нужно как-то понять по какому признаку определить что данные, полученные в формате CF_UNICODE некорректны.

Новые блоги и статьи Все статьи Все блоги /
BOINC: 22 года — и всё ещё работает Programma_Boinc 12.03.2026 BOINC: 22 года — и всё ещё работает Дэвид Андерсон написал ретроспективу. Кратко: в 2001 году он ушёл из United Devices, где был CTO, и за несколько месяцев написал ядро BOINC — клиент, сервер,. . .	SDL3 для Desktop (MinGW): Создаём пустое окно с нуля для 2D-графики на SDL3, Си и C++ 8Observer8 10.03.2026 Содержание блога Финальные проекты на Си и на C++: hello-sdl3-c. zip hello-sdl3-cpp. zip Результат:	Установка CMake и MinGW 13.1 для сборки С и C++ приложений из консоли и из Qt Creator в EXE 8Observer8 10.03.2026 Содержание блога MinGW - это коллекция инструментов для сборки приложений в EXE. CMake - это система сборки приложений. Здесь описаны базовые шаги для старта программирования с помощью CMake и. . .	Как дизайн сайта влияет на конверсию: 7 решений, которые реально повышают заявки Neotwalker 08.03.2026 Многие до сих пор воспринимают дизайн сайта как “красивую оболочку”. На практике всё иначе: дизайн напрямую влияет на то, оставит человек заявку или уйдёт через несколько секунд. Даже если у вас. . .
Модульная разработка через nuget packages DevAlt 07.03.2026 Сложившийся в . Net-среде способ разработки чаще всего предполагает монорепозиторий в котором находятся все исходники. При создании нового решения, мы просто добавляем нужные проекты и имеем. . .	Модульный подход на примере F# DevAlt 06.03.2026 В блоге дяди Боба наткнулся на такое определение: В этой книге («Подход, основанный на вариантах использования») Ивар утверждает, что архитектура программного обеспечения — это структуры,. . .	Управление камерой с помощью скрипта OrbitControls.js на Three.js: Вращение, зум и панорамирование 8Observer8 05.03.2026 Содержание блога Финальная демка в браузере работает на Desktop и мобильных браузерах. Итоговый код: orbit-controls-threejs-js. zip. Сканируйте QR-код на мобильном. Вращайте камеру одним пальцем,. . .	SDL3 для Web (WebAssembly): Синхронизация спрайтов SDL3 и тел Box2D 8Observer8 04.03.2026 Содержание блога Финальная демка в браузере. Итоговый код: finish-sync-physics-sprites-sdl3-c. zip На первой гифке отладочные линии отключены, а на второй включены:. . .

Dragokas 18033 / 7736 / 892 Регистрация: 25.12.2011 Сообщений: 11,502 Записей в блоге: 16

	При копировании в TextBox буфера портится русский текст 07.09.2014, 17:20. Показов 3013. Ответов 7 Метки нет (Все метки) Здравствуйте !!! Подскажите, пожалуйста, как при включенной английской раскладке клавиатуры сделать, чтобы копирование текста в TextBox не сопровождалось коверканьем русских символов? 0

@The trick Модератор 10057 / 3902 / 884 Регистрация: 22.02.2013 Сообщений: 5,853 Записей в блоге: 79
	11.06.2015, 14:49
	При копировании из VBE при включенной английской раскладке юникод некорректен. Поэтому нужно смотреть сначала локаль: Если там 409 то значит текст был скопирован при включенной английской раскладке, поэтому бери данные из CF_TEXT или просто из Clipboard.GetText. 0

Dragokas 18033 / 7736 / 892 Регистрация: 25.12.2011 Сообщений: 11,502 Записей в блоге: 16
	11.06.2015, 17:35 [ТС]
	Признателен. Спасибо. Добавлено через 47 минут Собственно, какое значение в CF_LOCALE не важно. С таким же успехом, в CF_UNICODE будут корректные данные, а в CF_TEXT нет (если скопировать с юникодного контрола в англ. раскладке). Тут нужно как-то понять по какому признаку определить что данные, полученные в формате CF_UNICODE некорректны. 0

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

Решение