' СОРС ЗА ФОРМАТА

'При въвеждане на формата

Private Sub Form_Load()

Form1.Caption = MomentnaKlaviatura ' Надписът на формата изписва моментаната клавиатура

End Sub

'При кликане на бутона за опция Windows - XP

Private Sub Option1_Click()

FlagXP = 1 'Сменяме флага, за да използва друга константа за клавиатурата

End Sub

'При кликане на бутона за опция Windows - 7, 8, 10

Private Sub Option2_Click()

FlagXP = 0 ' Възстановяваме флага на О

End Sub

'При натискане на бутона - Английска

Private Sub Command1_Click()

KeyBordEn ' Задействаме процедурата от модула за смяна на английска клавиатура

Form1.Caption = MomentnaKlaviatura ' Сменяме надписа на формата

'Сменяме цвета на формата на бутоните

Command1.BackColor = vbRed: Command2.BackColor = vbWhite: Command3.BackColor = vbWhite

End Sub

'При натискане на бутона Българска - Фонетична

Private Sub Command2_Click()

KeyBordBUL ' Задействаме процедурата от модула за смяна на фонетична клавиатура

Form1.Caption = MomentnaKlaviatura ' Сменяме надписа на формата

'Сменяме цвета на формата на бутоните

Command1.BackColor = vbWhite: Command2.BackColor = vbGreen: Command3.BackColor = vbWhite

End Sub

'При натискане на бутона Българска - БДС

Private Sub Command3_Click()

KeyBordBUL2 ' Задействаме процедурата от модула за смяна на БДС клавиатура

Form1.Caption = MomentnaKlaviatura ' Сменяме надписа на формата

'Сменяме цвета на формата на бутоните

Command1.BackColor = vbWhite: Command2.BackColor = vbWhite: Command3.BackColor = vbYellow

End Sub

'Следва сорса за автоматичната смяна на клавиатурата

'При взимане на фокуса от Text1

Private Sub Text1_GotFocus()

Command1_Click ' Натискаме бутона command1, което сменя на английска клавиатура

End Sub

'Автоматична смяна на клавиатурата при промяна на последния написан знак

Private Sub Text1_Change()

On Error Resume Next ' Манипулатор на грешка

PosledenZnak = Mid(Text1.Text, Text1.SelStart, 1) 'Приxващаме последния написан знак

If PosledenZnak = Chr(10) Then Command1_Click ' Ако той е нов ред сработваме бутон1

If PosledenZnak = "-" Then Command2_Click ' Ако е тире сработваме бутон-2

End Sub

'СОРС ЗА МОДУЛА AutoChangeKeyboard

'Декларация на АПИ функции за манипулиране на клавиатурата

'За разпознаване на включената в момента клавиатура

Public Declare Function GetKeyboardLayoutName Lib "user32" Alias "GetKeyboardLayoutNameA" ( _

ByVal pwszKLID As String) As Long

'За въвеждане на нова клавиатура

Public Declare Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" ( _

ByVal pwszKLID As String, ByVal Flags As Long) As Long

'За активиране на налична вече клавиатура

Public Declare Function ActivateKeyboardLayout Lib "user32" ( _

ByVal HKL As Long, ByVal Flags As Long) As Long

'Константи съответстващи на различните клавиатури

Public Const KbdBul = "00010402" 'Bulagarian Phonetic Tradition

Public Const KbdBulXP = "A0000402" 'Bulagarian Phonetic Tradition

Public Const KbdBul2 = "00000402" 'Bulagarian BDS

Public Const KbdEn = "00000409" 'English(US) по подразбиране

'Константа в която ще се записва моментаната клавиатура

Public Konstanta As String

Public FlagXP

'Публична функция връщаща името на включената клавиатура

Public Function MomentnaKlaviatura()

'създаваме буфер, в който да се запише константата на включената клавиатура

Konstanta = "00000000"

'Получаваме константата съответстваща на включената в момента клавиатура

GetKeyboardLayoutName (Konstanta)

If Konstanta = KbdBul Then MomentnaKlaviatura = "Bulagarian Phonetic Tradition"

If Konstanta = KbdBulXP Then MomentnaKlaviatura = "Bulagarian Phonetic XP"

If Konstanta = KbdBul2 Then MomentnaKlaviatura = "Bulagarian BDS"

If Konstanta = KbdEn Then MomentnaKlaviatura = "English(US) "

End Function

'Публична процедура за преключване на българска фонетична клавиатура

Public Sub KeyBordBUL()

If FlagXP = 0 Then

Klaviatura = LoadKeyboardLayout(KbdBul, 0)

Else

Klaviatura = LoadKeyboardLayout(KbdBulXP, 0)

End If

ActivateKeyboardLayout Klaviatura, 0

End Sub

'Публична процедура за преключване на българска клавиатура - БДС

Public Sub KeyBordBUL2()

Klaviatura = LoadKeyboardLayout(KbdBul2, 0)

ActivateKeyboardLayout Klaviatura, 0

End Sub

'Публична процедура за преключване на английска клавиатура US

Public Sub KeyBordEn()

Klaviatura = LoadKeyboardLayout(KbdEn, 0)

ActivateKeyboardLayout Klaviatura, 0

End Sub