Страница: 1 |
Страница: 1 |
Вопрос: Перключение раскладки клавиатуры в своей проге.
Добавлено: 07.11.07 20:46
Автор вопроса: werber | Web-сайт:
Уважаемы знатоки! Кто знает, каким образом можно переключать раскладку клавы в своей проге. Особенно будет полезно, если кто даст код функции, которая сохраняет информацию о том, какая раскладка используется сейчас в проге, после переключения пользователя на другую прогу. Надеюсь, смысл понятен.
Представлю пример: в одной проге (текстовый редактор) я пишу текст. У меня в данный момент стоит русская раскладка. Я переключаюсь на другое приложение (как это... А! Текстовый редактор теряет фокус.) Так вот, в том приложении я тоже чё- то пишу, при этом меняя раскладку на английскую. Когда я возвращаюсь к текстовому редактору, то раскладка клавы автоматически опять становится русской (так как с русской раскладкой я работал до этого).
Вот такую штуку и мне нужно сделать.
Ответы
Всего ответов: 6
Номер ответа: 1
Автор ответа:
Администратор
ICQ: 278109632
Вопросов: 42
Ответов: 3949
Web-сайт:
Профиль | | #1
Добавлено: 07.11.07 21:40
вот. скопируй это в Form1.frm
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 4755
ClientLeft = 60
ClientTop = 420
ClientWidth = 4500
LinkTopic = "Form1"
ScaleHeight = 4755
ScaleWidth = 4500
StartUpPosition = 3 'Windows Default
Begin VB.Frame Frame1
Caption = "Язык других окон"
Height = 1635
Left = 465
TabIndex = 2
Top = 1785
Width = 3420
Begin VB.ListBox List2
Height = 1230
ItemData = "Form1.frx":0000
Left = 90
List = "Form1.frx":0002
TabIndex = 3
Top = 240
Width = 3225
End
End
Begin VB.Frame Frame
Caption = "Наш язык"
Height = 1635
Left = 480
TabIndex = 0
Top = 30
Width = 3420
Begin VB.ListBox List1
Height = 1230
ItemData = "Form1.frx":0004
Left = 90
List = "Form1.frx":0006
TabIndex = 1
Top = 240
Width = 3225
End
End
Begin VB.Timer Timer
Interval = 100
Left = 3975
Top = 585
End
Begin VB.Label Label
Alignment = 2 'Center
BorderStyle = 1 'Fixed Single
Caption = "Сверни окно или сделай его неактивным."
Height = 915
Left = 450
TabIndex = 4
Top = 3660
Width = 3465
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const HKL_NEXT = 1
Const HKL_PREV = 0
Private Declare Function GetKeyboardLayoutList Lib "user32" (ByVal nBuff As Long, lpList As Long) As Long
Private Declare Function GetKeyboardLayout Lib "user32" (ByVal dwLayout As Long) As Long
Private Declare Function ActivateKeyboardLayout Lib "user32" (ByVal HKL As Long, ByVal flags As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Dim CurLayout As Long
Dim Layout(9) As Long 'массив для хранения списков языков
Dim N As Integer
Private Sub Form_Load()
GetKeyboardLayoutList 10, ByVal VarPtr(Layout(0)) 'грузим список языков
CurLayout = GetKeyboardLayout(0)
For N = 0 To 9
If Layout(N) <> 0 Then
List1.AddItem Layout(N), N
List2.AddItem Layout(N), N
End If
If CurLayout = Layout(N) Then Exit For
Next
List1.ListIndex = N
List2.ListIndex = 0
End Sub
Private Sub Timer_Timer()
If Me.hWnd = GetForegroundWindow Then
ActivateKeyboardLayout Layout(List1.ListIndex), 0
Else
ActivateKeyboardLayout Layout(List2.ListIndex), 0
End If
End Sub
Номер ответа: 2
Автор ответа:
Администратор
ICQ: 278109632
Вопросов: 42
Ответов: 3949
Web-сайт:
Профиль | | #2
Добавлено: 07.11.07 21:41
и еще вот это поможет, наверное
http://www.google.ru/search?hl=ru&q=site:www.vbnet.ru+%EF%F0%EE%E3%F0%E0%EC%EC%ED%EE%E5+%EF%E5%F0%E5%EA%EB%FE%F7%E5%ED%E8%E5+%F0%E0%F1%EA%EB%E0%E4%EA%E8&btnG=%D0%9F%D0%BE%D0%B8%D1%81%D0%BA+%D0%B2+Google&lr=
Номер ответа: 3
Автор ответа:
Mr.Smile
ICQ: 427682013
Вопросов: 14
Ответов: 464
Профиль | | #3
Добавлено: 07.11.07 21:43
Недавно уже обсуждали эту тему. Воспользуйся поиском
Номер ответа: 4
Автор ответа:
Stuart
Вопросов: 5
Ответов: 152
Профиль | | #4
Добавлено: 07.11.07 23:29
Для того чтобы Программно переключить клавиатуру с русского на английский и обратно, кинь на форму 1 кнопку, вот код:
Private Declare Function ActivateKeyboardLayout Lib "user32" (ByVal HKL As Long, ByVal flags As Long) As Long
Private Sub Command1_Click()
ActivateKeyboardLayout 0, 0
End Sub
Определение раскладки клавиатуры любого окна
=======================================================================
Хотите знать, какая раскладка клавиатуры у любой программы, запущенной в данный момент? Будь то Microsoft Word, простейший Блокнот или любая программа для редактирования текстов.
На основной форме добавьте элемент CommandButton.
'---КОД МОДУЛЯ---
Private Declare Function EnumWindows& Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long)
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function IsWindowVisible& Lib "user32" (ByVal hwnd As Long)
Private Declare Function GetParent& Lib "user32" (ByVal hwnd As Long)
Dim sPattern As String, hFind As Long
Function EnumWinProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
Dim k As Long, sName As String
If IsWindowVisible(hwnd) And GetParent(hwnd) = 0 Then
sName = Space$(128)
k = GetWindowText(hwnd, sName, 128)
If k > 0 Then
sName = Left$(sName, k)
If lParam = 0 Then sName = UCase(sName)
If sName Like sPattern Then
hFind = hwnd
EnumWinProc = 0
Exit Function
End If
End If
End If
EnumWinProc = 1
End Function
Public Function FindWindowWild(sWild As String, Optional bMatchCase As Boolean = True) As Long
sPattern = sWild
If Not bMatchCase Then sPattern = UCase(sPattern)
EnumWindows AddressOf EnumWinProc, bMatchCase
FindWindowWild = hFind
End Function
'---КОД ФОРМЫ---
Private Declare Function GetKeyboardLayout Lib "user32" (ByVal dwLayout As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
Private Const LOCALE_SENGLANGUAGE = &H1001
Public Function GetLanguageInfo(ByVal hwnd As Long) As String
Dim sReturn As String, nRet As Long
Dim pID As Long, tId As Long, LCID As Long
tId = GetWindowThreadProcessId(hwnd, pID)
LCID = LoWord(GetKeyboardLayout(tId))
sReturn = String$(128, 0)
nRet = GetLocaleInfo(LCID, LOCALE_SENGLANGUAGE, sReturn, Len(sReturn))
If nRet > 0 Then GetLanguageInfo = Left$(sReturn, nRet - 1)
End Function
Public Function LoWord(DWORD As Long) As Integer
If DWORD And &H8000& Then
LoWord = &H8000 Or (DWORD And &H7FFF&
Else
LoWord = DWORD And &HFFFF&
End If
End Function
Private Sub Command1_Click()
'MsgBox GetLanguageInfo(FindWindowWild("FineReader*", False))
MsgBox GetLanguageInfo(FindWindowWild("Microsoft Word*", False))
End Sub
Какая раскладка клавиатуры включена в данный момент
=======================================================================
Private Declare Function GetKeyboardLayoutName Lib "user32" Alias "GetKeyboardLayoutNameA" (ByVal pwszKLID As String) As Long
Private Sub Form_Load()
Dim KeybLayoutName As String
KeybLayoutName = String(9, 0)
GetKeyboardLayoutName KeybLayoutName
'Номер 409 - английская, 419 - русская
MsgBox "Текущая раскладка номер " & CStr(CLng(Left$(KeybLayoutName, _
InStr(1, KeybLayoutName, Chr(0)) - 1)))
End Sub
Номер ответа: 5
Автор ответа:
Stuart
Вопросов: 5
Ответов: 152
Профиль | | #5
Добавлено: 07.11.07 23:39
Вот возможно это пригодится
Номер ответа: 6
Автор ответа:
Администратор
ICQ: 278109632
Вопросов: 42
Ответов: 3949
Web-сайт:
Профиль | | #6
Добавлено: 07.11.07 23:55
а если три раскладки?
ActivateKeyboardLayout 0, 0 переключает с текущей на предыдущую вообще.