'================================================================
'= キーボード情報を取得

'=    (KeyboardName.bas)
'================================================================
#include "Windows.bi"

#define KL_NAMELENGTH 9
#define KT_Type 0
#define KT_SUBType 1
#define KT_FunctionKEYS 2

' アクティブな入力ロケール識別子を取得
Declare Function Api_GetKeyboardLayoutName& Lib "user32" Alias "GetKeyboardLayoutNameA" (ByVal pwszKLID$)

' キーボードに関する情報を取得
Declare Function Api_GetKeyboardType& Lib "user32" Alias "GetKeyboardType" (ByVal nTypeFlag&)

Var Shared Text(5) As Object
For i = 0 To 5
    Text(i).Attach GetDLgItem("Text" & Trim$(Str$(i + 1)))
    Text(i).SetFontSize 14
Next

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Var strName As String
    Var kbType As String
    Var fKeys As String
    Var Ret As Long

    strName = String$(KL_NAMELENGTH, 0)

    'キーボード名の取得
    Ret = Api_GetKeyboardLayoutName(strName)

    Select Case Api_GetKeyboardType(KT_Type)
        Case 1
            kbType = "IBM PC/XT 及び互換(83-key)"
        Case 2
            kbType = "Olivetti ?ICO? (102-key)"
        Case 3
            kbType = "IBM PC/AT (84-key) 及び互換"
        Case 4
            kbType = "IBM enhanced (101- Or 102-key)"
        Case 5
            kbType = "Nokia 1050 及び互換"
        Case 6
            kbType = "Nokia 9140 及び互換"
        Case 7
            kbType = "日本語"
        Case Else
            kbType = "不明"
    End Select

    Select Case Api_GetKeyboardType(KT_FunctionKEYS)
        Case 1
            fKeys = "10"
        Case 2
            fKeys = "12"
        Case 3
            fKeys = "10"
        Case 4
            fKeys = "12"
        Case 5
            fKeys = "10"
        Case 6
            fKeys = "24"
        Case 7
            fKeys = "OEM"
        Case Else
            fKeys = "不明"
    End Select

    Text(3).SetWindowText Left$(strName, InStr(strName, Chr$(0)) - 1)
    Text(4).SetWindowText kbType
    Text(5).SetWindowText fKeys
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End