При копировании в 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 некорректны.

Новые блоги и статьи Все статьи Все блоги /
Советы по крайней бережливости. Внимание, это ОЧЕНЬ длинный пост. Programma_Boinc 28.12.2025 Советы по крайней бережливости. Внимание, это ОЧЕНЬ длинный пост. Налог на собак: https:/ / ********/ gallery/ V06K53e Финансовый отчет в Excel: https:/ / ********/ gallery/ bKBkQFf Пост отсюда. . .	Кто-нибудь знает, где можно бесплатно получить настольный компьютер или ноутбук? США. Programma_Boinc 26.12.2025 Нашел на реддите интересную статью под названием Anyone know where to get a free Desktop or Laptop? Ниже её машинный перевод. После долгих разбирательств я наконец-то вернула себе. . .	Thinkpad X220 Tablet — это лучший бюджетный ноутбук для учёбы, точка. Programma_Boinc 23.12.2025 Рецензия / Мнение/ Перевод Нашел на реддите интересную статью под названием The Thinkpad X220 Tablet is the best budget school laptop period . Ниже её машинный перевод. Thinkpad X220 Tablet —. . .	PhpStorm 2025.3: WSL Terminal всегда стартует в ~ and_y87 14.12.2025 PhpStorm 2025. 3: WSL Terminal всегда стартует в ~ (home), игнорируя директорию проекта Симптом: После обновления до PhpStorm 2025. 3 встроенный терминал WSL открывается в домашней директории. . .	Как объединить две одинаковые БД Access с разными данными VikBal 11.12.2025 Помогите пожалуйста !! Как объединить 2 одинаковые БД Access с разными данными.
Новый ноутбук volvo 07.12.2025 Всем привет. По скидке в "черную пятницу" взял себе новый ноутбук Lenovo ThinkBook 16 G7 на Амазоне: Ryzen 5 7533HS 64 Gb DDR5 1Tb NVMe 16" Full HD Display Win11 Pro	Музыка, написанная Искусственным Интеллектом volvo 04.12.2025 Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .	От async/await к виртуальным потокам в Python IndentationError 23.11.2025 Армин Ронахер поставил под сомнение async/ await. Создатель Flask заявляет: цветные функции - провал, виртуальные потоки - решение. Не threading-динозавры, а новое поколение лёгких потоков. Откат?. . .	Поиск "дружественных имён" СОМ портов Argus19 22.11.2025 Поиск "дружественных имён" СОМ портов На странице: https:/ / norseev. ru/ 2018/ 01/ 04/ comportlist_windows/ нашёл схожую тему. Там приведён код на С++, который показывает только имена СОМ портов, типа,. . .	Сколько Государство потратило денег на меня, обеспечивая инсулином. Programma_Boinc 20.11.2025 Сколько Государство потратило денег на меня, обеспечивая инсулином. Вот решила сделать интересный приблизительный подсчет, сколько государство потратило на меня денег на покупку инсулинов. . . .

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

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

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

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

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

Решение