BECKHOFF/四车间/M779-10号车（已改）/BACK-C/VisiWin/VisiWinStudio/Samples/VWSTouchKeyboard/VWSTouchKeyboard.bas

Attribute VB_Name = "MVWSTouchKeyBoard"
Option Explicit

Public gsngKeySize As Single     'Vegrößerungsfaktor für die Tastengröße
Public gnPosition As EPosition   'Positionierung der Tastatur:
Public gfShowLimits As Boolean

Public Enum EPosition
    vwScreenCorners
    vwAtControl
    vwCenter
End Enum

Public Enum EPad 'Aufzählung der Tastaturtypen
    vwNumPad
    vwAlphaPad
    vwHexPad
    vwBinPad
End Enum

Public glHwndController As Long 'Fensterkennung im VWTouchCtrl.OCX
Public glThreadID As Long       'Thread-ID der Applikation
Public gsVWProjectName As String  'VisiWin-Projektname
Public gsVWProjectPath As String 'Projektpfad
Public gsVWTouchKeyboardINI As String

'Parameter zur aktuellen Sprache
Public glLCID As Long            'Windows-Sprachkennung
Public gnCharset As Integer      'Font-Characterset

'automatisch ermittelte Nachrichtennummern
Public glVWM_KeyboardHandle As Long
Public glVWM_TerminateKeyboard As Long
Public glVWM_HideKeyboard As Long
Public glVWM_NotifyKeyboard As Long
Public glVWM_Language As Long
Public glVWM_TouchKeyboardHides As Long
Public glVWM_TouchPosition  As Long
Public glVWM_TouchShowLimits  As Long
Public glVWM_TouchKeySize  As Long

'Instanz des Schnittstellenformulars
Public gfrmVWTouchKeyBoard As FVWSTouchKeyboard
'dessen alte Fensterprozedur
Public gPrevWindowProcVWTouchKeyBoard As Long
'Fensterkennung des Steuerelementes in der Applikation mit dem Fokus
Public glHwndControl As Long
Public gsLimitMin As String
Public gsLimitMax As String

Public Const CmdLine_Controller = "/Controller:"
Public Const CmdLine_Thread = "/Thread:"
Public Const CmdLine_Project = "/Project:"

Public Const OC_BIT = &H131
Public Const OC_DIGI = &H131
Public Const OC_CHAR = &H132
Public Const OC_UCHAR = &H172
Public Const OC_BYTE = &H172
Public Const OC_INT = &H133
Public Const OC_UINT = &H173
Public Const OC_WORD = &H173
Public Const OC_BCD = &H164
Public Const OC_LONG = &H136
Public Const OC_ULONG = &H176
Public Const OC_DWORD = &H176
Public Const OC_FLOAT = &H127
Public Const OC_TEXT = &H109

Public Type TEditInfo
    SizeOfStruct As Integer
    DataType As Integer     'Typ der Prozessvariablen (Konstante OC_...)
    OutputFormat As Integer 'Formatierung im VWVarIn (Wert der Format-Eigenschaft)
    LimitMin(254) As Byte   'ASCII-String der LimitMin-Eigenschaft
    LimitMax(254) As Byte   'ASCII-String der LimitMax-Eigenschaft
End Type

Public Sub Main()
    '<<< in dieser Prozedur keine Änderungen vornehmen >>>
    'Startprozedur des Programms
    'Eingabe:
    '  Command$: Parameter in der Kommandozeile
    '  VWTouchKeyboard.ini: Programmeinstellungen
    'Ausgabe:
    '  folgende globale Variablen (siehe oben):
    '  glKeySize, gfAutoPosition
    '  gsProjectName, glHwndController, glThreadID
    '  glVWM_KeyboardHandle, glVWM_TerminateKeyboard, glVWM_HideKeyboard,
    '  glVWM_NotifyKeyboard, glVWM_Language
    '  gfrmVWTouchKeyBoard
    
    Dim nPos As Integer, scPuffer As String * 255, lR As Long
    
    gsVWTouchKeyboardINI = App.Path & "\VW4TouchKeyboard.ini"
    gsngKeySize = 1
    
    'Kommandozeile auswerten
    nPos = InStr(Command$, CmdLine_Project) + Len(CmdLine_Project)
    gsVWProjectName = Trim$(Mid$(Command$, nPos))
    nPos = InStr(gsVWProjectName, "/")
    If nPos Then
        gsVWProjectName = Trim$(Left$(gsVWProjectName, nPos - 1))
    End If
    nPos = InStr(Command$, CmdLine_Controller) + Len(CmdLine_Controller)
    glHwndController = Val(Mid$(Command$, nPos))
    nPos = InStr(Command$, CmdLine_Thread) + Len(CmdLine_Thread)
    glThreadID = Val(Mid$(Command$, nPos))
    
    'Nachrichtennummern ermitteln
    glVWM_KeyboardHandle = RegisterWindowMessage("VWM32_1_KEYBOARDHANDLE")
    glVWM_TerminateKeyboard = RegisterWindowMessage("VWM32_1_TERMINATEKEYBOARD")
    glVWM_HideKeyboard = RegisterWindowMessage("VWM32_1_HIDEKEYBOARD")
    glVWM_NotifyKeyboard = RegisterWindowMessage("VWM32_1_NOTIFYKEYBOARD")
    glVWM_Language = RegisterWindowMessage("VWM1_LANGUAGE")
    glVWM_TouchKeyboardHides = RegisterWindowMessage("VWM32_1_TOUCHKEYBOARDHIDES")
    glVWM_TouchPosition = RegisterWindowMessage("VWM32_1_TOUCHPOSITION")
    glVWM_TouchShowLimits = RegisterWindowMessage("VWM32_1_TOUCHSHOWLIMITS")
    glVWM_TouchKeySize = RegisterWindowMessage("VWM32_1_TOUCHKEYSIZE")
    
    '  Load FHexPad
    '  DoEvents
    '  Load FAlphaPad
    '  DoEvents
    '  Load FNumPad
    '  DoEvents
    '  Load FBinPad
    '  DoEvents
    'Schnittstellenformular erzeugen
    CreateVWTouchKeyBoard
End Sub

Public Function CreateVWTouchKeyBoard() As Boolean
    '<<< in dieser Prozedur keine Änderungen vornehmen >>>
    'Erzeugt das Schnittstellenformular für die Kommunikation
    'vom VWTouchCtrl.ocx zum VWTouchKeyboard.exe
    'Eingabe:
    '  glHwndController: VWTouchCtrl.ocx
    'Ausgabe:
    '  gfrmVWTouchKeyBoard: Instanz des Schnittstellenformulars
    '  gPrevWindowProcVWTouchKeyBoard: Adresse der Originalfensterprozedur
    
    Dim f As Boolean, lR As Long
    
    f = True
    If gfrmVWTouchKeyBoard Is Nothing Then
        Set gfrmVWTouchKeyBoard = New FVWSTouchKeyboard
        Load gfrmVWTouchKeyBoard
        f = f And (Not gfrmVWTouchKeyBoard Is Nothing)
        gPrevWindowProcVWTouchKeyBoard = GetWindowLong(gfrmVWTouchKeyBoard.hwnd, GWL_WNDPROC)
        f = f And (gPrevWindowProcVWTouchKeyBoard <> 0)
        lR = SetWindowLong(gfrmVWTouchKeyBoard.hwnd, GWL_WNDPROC, AddressOf WindowProcVWTouchKeyBoard)
        f = f And (lR <> 0)
        AttachThreadInput App.ThreadID, glThreadID, True
        SendMessage glHwndController, glVWM_KeyboardHandle, gfrmVWTouchKeyBoard.hwnd, ByVal 0&
    End If
    
    CreateVWTouchKeyBoard = f
End Function

Public Function DestroyVWTouchKeyBoard() As Boolean
    '<<< in dieser Prozedur keine Änderungen vornehmen >>>
    'Löscht das Schnittstellenformular
    'vom VWTouchCtrl.ocx zum VWTouchKeyboard.exe
    'Eingabe:
    '  gfrmVWTouchKeyBoard: Instanz des Schnittstellenformulars
    '  gPrevWindowProcVWTouchKeyBoard: Adresse der Originalfensterprozedur
    '  glHwndController: VWTouchCtrl.ocx
    'Ausgabe:
    '  keine
    
    If Not gfrmVWTouchKeyBoard Is Nothing Then
        AttachThreadInput App.ThreadID, glThreadID, False
        SetWindowLong gfrmVWTouchKeyBoard.hwnd, GWL_WNDPROC, gPrevWindowProcVWTouchKeyBoard
        Unload gfrmVWTouchKeyBoard
        Set gfrmVWTouchKeyBoard = Nothing
    End If
    
    DestroyVWTouchKeyBoard = (gfrmVWTouchKeyBoard Is Nothing)
End Function

Public Function WindowProcVWTouchKeyBoard(ByVal hwnd As Long, _
        ByVal Msg As Long, _
        ByVal wParam As Long, _
        ByVal lParam As Long) As Long
    '<<< Vorsicht bei Änderungen in dieser Prozedur>>>
    'Neue Fensterprozedur für das Schnittstellenformular:
    'Hier kommen die Nachrichten an, die das VWTouchCtrl.ocx in der Applikation
    'an die VWTouchKeyboard.exe schickt.
    'Eingabe:
    '  hwnd: das eigene Fensterkennung
    '  Msg: Nummer der Nachricht
    '  wParam: 1. Parameter (abhängig von der Nachricht)
    '  lParam: 2. Parameter (abhängig von der Nachricht)
    
    'Nachricht auswerten
    Select Case Msg
        
    Case glVWM_TerminateKeyboard
        'Die Applikation wurde beendet, bzw. das VWTouchCtrl.ocx abgemeldet:
        DestroyVWTouchKeyBoard 'Schnittstellenformular entfernen
        'Alle Tastaturfenster entladen
        UnloadPads
        WindowProcVWTouchKeyBoard = 0
        'Jetzt ist alles aufgeräumt
        Exit Function '=> nach nächstem Befehl ist Programmende
        
    Case glVWM_HideKeyboard
        'Tastaturfenster verstecken, weil in der Applikation der Fokus auf
        'ein Steuerelement gesetzt wurde, welches keine Tastaturbedienung
        'benötigt.
        HidePads
        
    Case glVWM_Language
        'In der Applikation wurde die Sprache umgeschaltet:
        'wParam: LCID (VWLanguage.Language)
        'lParam: Charset
        glLCID = wParam
        SetKeyboardLayout
        UnloadPads
        LoadPads
        ChangeLanguage
        
    Case glVWM_TouchPosition
        gnPosition = lParam
        
    Case glVWM_TouchShowLimits
        gfShowLimits = lParam
        
    Case glVWM_TouchKeySize
        CopyMemory gsngKeySize, lParam, 4
        UnloadPads
        LoadPads
        
    Case WM_COPYDATA
        Dim uCopyData As COPYDATASTRUCT
        CopyMemory uCopyData, ByVal lParam, Len(uCopyData)
        Select Case uCopyData.dwData
        Case glVWM_NotifyKeyboard
            'Es soll eine Tastatur angezeigt werden.
            'wParam: Fensterkennung des Steuerelementes in der Applikation.
            'lParam: nur bei VWVarIn: Zeiger auf eine TEditInfo-Struktur
            Dim uEditInfo As TEditInfo
            CopyMemory uEditInfo, ByVal uCopyData.lpData, Len(uEditInfo)
            glHwndControl = wParam
            gsLimitMin = StrConv(uEditInfo.LimitMin, vbUnicode)
            gsLimitMin = Left$(gsLimitMin, InStr(gsLimitMin, vbNullChar) - 1)
            gsLimitMax = StrConv(uEditInfo.LimitMax, vbUnicode)
            gsLimitMax = Left$(gsLimitMax, InStr(gsLimitMax, vbNullChar) - 1)
            
            Select Case uEditInfo.DataType
            Case OC_BIT, OC_DIGI
                ShowPad vwNumPad
            Case OC_CHAR, OC_UCHAR, OC_BYTE, OC_INT, OC_UINT, OC_WORD, OC_LONG, OC_ULONG, OC_DWORD
                Select Case uEditInfo.OutputFormat
                Case 0 'Number
                    ShowPad vwNumPad
                Case 1 'Binary
                    ShowPad vwBinPad
                Case 2 'Hex
                    ShowPad vwHexPad
                Case 3 'Oktal
                    ShowPad vwNumPad
                End Select
            Case OC_BCD
                ShowPad vwNumPad
            Case OC_FLOAT
                ShowPad vwNumPad
            Case OC_TEXT
                ShowPad vwAlphaPad
            Case Else
                ShowPad vwAlphaPad
            End Select
            APISetFocus glHwndControl
        End Select
        
    End Select
    'Nachrichten weiterreichen an die Original-Fensterprozedur
    WindowProcVWTouchKeyBoard = CallWindowProc(gPrevWindowProcVWTouchKeyBoard, hwnd, Msg, wParam, lParam)
End Function

Public Sub ShowPad(enmPad As EPad)
    '<<< Vorsicht bei Änderungen in dieser Prozedur>>>
    'Anzeigen der ausgewählten Tastatur, alle anderen werden versteckt.
    'Die neue Tastatur wird positioniert.
    'Eingabe:
    '  enmPad: Tastaturtyp, der angezeigt werden soll
    '  gnPosition: Positionsart der Tastatur
    '  Screen.ActiveForm: aktuell angezeigte Tastatur
    'Ausgabe:
    '  keine
    
    Dim frmNew As Form, frmRecent As Form
    Dim udtRectControl As RECT, udtRectPad As RECT, udtRectDest As RECT
    Dim lLeft As Long, lTop As Long, lBottom As Long
    
    'bisherige Tastatur
    Set frmRecent = Screen.ActiveForm
    
    'Festlegung der neuen Tastatur
    Select Case enmPad
    Case vwNumPad
        Set frmNew = FNumPad
    Case vwAlphaPad
        Set frmNew = FAlphaPad
    Case vwHexPad
        Set frmNew = FHexPad
    Case vwBinPad
        Set frmNew = FBinPad
    End Select
    
    'bisherige Tastatur verstecken
    If Not frmNew Is frmRecent Then
        If (Not frmRecent Is Nothing) And (Not frmRecent Is FVWSTouchKeyboard) Then
            frmRecent.Hide
        End If
    End If
    
    frmNew.CheckLimits
    
    'neue Tastatur positionieren
    If Not frmNew Is Nothing Then
        GetWindowRect glHwndControl, udtRectControl
        'Koordinaten in Twips umrechnen
        udtRectControl.Left = frmNew.ScaleX(udtRectControl.Left, vbPixels, vbTwips)
        udtRectControl.Top = frmNew.ScaleY(udtRectControl.Top, vbPixels, vbTwips)
        udtRectControl.Right = frmNew.ScaleX(udtRectControl.Right, vbPixels, vbTwips)
        udtRectControl.Bottom = frmNew.ScaleY(udtRectControl.Bottom, vbPixels, vbTwips)
        Select Case gnPosition
        Case vwAtControl
            '1. unterhalb vom Control
            lLeft = udtRectControl.Left
            If lLeft + frmNew.Width > Screen.Width Then
                '1a. bündig zum rechten Bildschirmrand
                lLeft = Screen.Width - frmNew.Width
            End If
            lTop = udtRectControl.Bottom + Screen.TwipsPerPixelY
            If lTop + frmNew.Height > Screen.Height Then
                '2. oberhalb vom Control
                lTop = udtRectControl.Top - Screen.TwipsPerPixelY - frmNew.Height
            End If
            If lTop < 0 Then
                '3. rechts vom Control
                lTop = udtRectControl.Top
                If lTop + frmNew.Height > Screen.Height Then
                    '3a. bündig zum unteren Bildschirmrand
                    lTop = Screen.Height - frmNew.Height
                End If
                lLeft = udtRectControl.Right + Screen.TwipsPerPixelX
                If lLeft + frmNew.Width > Screen.Width Then
                    '4. links vom Control
                    lLeft = udtRectControl.Left - Screen.TwipsPerPixelX - frmNew.Width
                End If
            End If
            'Sicherheitshalber nochmal prüfen, ob die Tastatur auch innerhalb des Bildschirms liegt.
            If lLeft < 0 Then
                lLeft = 0
            End If
            If lTop < 0 Then
                lTop = 0
            End If
            'endlich anzeigen
            frmNew.Move lLeft, lTop
        Case vwScreenCorners
            udtRectPad.Left = frmNew.Left
            udtRectPad.Right = udtRectPad.Left + frmNew.Width - Screen.TwipsPerPixelX
            udtRectPad.Top = frmNew.Top
            udtRectPad.Bottom = udtRectPad.Top + frmNew.Height - Screen.TwipsPerPixelY
            If IntersectRect(udtRectDest, udtRectPad, udtRectControl) Then
                '1. links oben
                frmNew.Move 0, 0
                udtRectPad.Left = frmNew.Left
                udtRectPad.Right = udtRectPad.Left + frmNew.Width - Screen.TwipsPerPixelX
                udtRectPad.Top = frmNew.Top
                udtRectPad.Bottom = udtRectPad.Top + frmNew.Height - Screen.TwipsPerPixelY
                If IntersectRect(udtRectDest, udtRectPad, udtRectControl) Then
                    '2. links unten
                    frmNew.Top = Screen.Height - frmNew.Height
                    udtRectPad.Left = frmNew.Left
                    udtRectPad.Right = udtRectPad.Left + frmNew.Width - Screen.TwipsPerPixelX
                    udtRectPad.Top = frmNew.Top
                    udtRectPad.Bottom = udtRectPad.Top + frmNew.Height - Screen.TwipsPerPixelY
                    If IntersectRect(udtRectDest, udtRectPad, udtRectControl) Then
                        '3. rechts oben
                        frmNew.Move Screen.Width - frmNew.Width, 0
                        udtRectPad.Left = frmNew.Left
                        udtRectPad.Right = udtRectPad.Left + frmNew.Width - Screen.TwipsPerPixelX
                        udtRectPad.Top = frmNew.Top
                        udtRectPad.Bottom = udtRectPad.Top + frmNew.Height - Screen.TwipsPerPixelY
                        If IntersectRect(udtRectDest, udtRectPad, udtRectControl) Then
                            '4. rechts unten
                            frmNew.Top = Screen.Height - frmNew.Height
                            'Das muss jetzt passen, ansonsten ist die Tastatur zu groß.
                        End If
                    End If
                End If
            End If
        Case vwCenter
            frmNew.Move (Screen.Width - frmNew.Width) / 2, (Screen.Height - frmNew.Height) / 2
        End Select
        'und anzeigen
        frmNew.Show
    End If
End Sub

Public Sub FormResize(frm As Form)
    '<<< Vorsicht bei Änderungen in dieser Prozedur >>>
    'Einstellungen für ein Tastaturfenster setzen.
    'Eingabe:
    '  frm: Verweis auf das Tastaturformular
    'Ausgabe:
    '  frm: Geändertes Formular
    
    Dim ctr As Control
    
    'Tastengröße und Schriftgröße anpassen
    For Each ctr In frm.Controls
        ctr.Move ctr.Left * gsngKeySize, ctr.Top * gsngKeySize, ctr.Width * gsngKeySize, ctr.Height * gsngKeySize
        ctr.Font.Size = ctr.Font.Size * gsngKeySize
    Next ctr
    'Fenstergröße anpassen
    frm.Width = frm.Width - frm.ScaleWidth + gsngKeySize * frm.ScaleWidth
    frm.Height = frm.Height - frm.ScaleHeight + gsngKeySize * frm.ScaleHeight
    
    'Fenster permanent und hartnäckig in den Vordergrund bringen
    SetWindowPos frm.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE + SWP_NOACTIVATE
End Sub

Public Sub SetKeyboardLayout()
    'Sucht ein Tastaturlayout passend zur gewünschten Sprachkennung
    'und ermittelt den Font-Characterset für die Tastenbeschriftung
    'Eingabe:
    '  glLCID: gewünschte Sprachkennung (Windows locale identifier)
    'Ausgabe:
    '  gnCharset: Characterset
    
    Dim lKbLayoutFirst As Long, lKbLayout As Long
    Dim lLCID As Long, l As Long
    Dim f As Boolean
    
    lLCID = GetPrivateProfileInt("Replace", CStr(glLCID), glLCID, gsVWTouchKeyboardINI)
    gnCharset = GetPrivateProfileInt("CharSet", CStr(lLCID), 0, gsVWTouchKeyboardINI)
    
    f = False
    lKbLayoutFirst = GetKeyboardLayout(0)
    lKbLayout = lKbLayoutFirst
    
    'alle installierten Keyboard-Layouts durchlaufen
    Do
        l = lKbLayout And &HFFFF&
        If l = lLCID Then
            'und bei passendem Layout Schleife verlassen und Einstellung beibehalten.
            f = True
            Exit Do
        End If
        ActivateKeyboardLayout HKL_NEXT, 0
        lKbLayout = GetKeyboardLayout(0)
    Loop Until lKbLayout = lKbLayoutFirst
    
    If Not f Then
    End If
End Sub

Public Sub ReadKeyParams(arrKey As Variant, PadType As String, KeyType As String)
    Dim key As VWSKey, lLCID As Long
    Dim lR As Long, scBuffer As String * 255
    Dim sText As String, sKeyCode As String
    
    lLCID = GetPrivateProfileInt("Replace", CStr(glLCID), glLCID, gsVWTouchKeyboardINI)
    
    sText = lLCID & " " & PadType & " Text"
    sKeyCode = lLCID & " " & PadType & " KeyCode"
    
    For Each key In arrKey
        'Beschriftung der Tasten einlesen
        lR = GetPrivateProfileString(sText, KeyType & key.Index, "", scBuffer, Len(scBuffer), gsVWTouchKeyboardINI)
        If lR Then
            key.Caption = Left$(scBuffer, lR)
            key.Font.Charset = gnCharset
        End If
        'Keycode für die Tasten einlesen
        Select Case KeyType
        Case "Std", "End"
            lR = GetPrivateProfileString(sKeyCode, KeyType & key.Index, "", scBuffer, Len(scBuffer), gsVWTouchKeyboardINI)
            If lR Then
                key.Tag = Left$(scBuffer, lR)
            End If
        End Select
        If KeyType = "Extra" Then
            'nur sichtbar schalten, wenn sie beschriftet sind
            key.Visible = Len(key.Caption)
        End If
    Next key
End Sub

Public Sub ReadLimitParams(frm As Form)
    Dim lR As Long, scBuffer As String * 255
    
    lR = GetPrivateProfileString(glLCID & " Text", "Max", "Maximum", scBuffer, Len(scBuffer), gsVWTouchKeyboardINI)
    frm.idxLabelLimits(0).TextOff = Left$(scBuffer, lR)
    lR = GetPrivateProfileString(glLCID & " Text", "Min", "Minimum", scBuffer, Len(scBuffer), gsVWTouchKeyboardINI)
    frm.idxLabelLimits(1).TextOff = Left$(scBuffer, lR)
    frm.idxLabelLimits(0).Font.Charset = gnCharset
    frm.idxLabelLimits(1).Font.Charset = gnCharset
    frm.idxLimitMin.Font.Charset = gnCharset
    frm.idxLimitMax.Font.Charset = gnCharset
End Sub

Public Sub ChangeLanguage()
    FHexPad.ChangeLanguage
    FAlphaPad.ChangeLanguage
    FNumPad.ChangeLanguage
    FBinPad.ChangeLanguage
End Sub

Public Sub HidePads()
    FHexPad.Hide
    FAlphaPad.Hide
    FNumPad.Hide
    FBinPad.Hide
End Sub

Public Sub LoadPads()
    Load FHexPad
    Load FAlphaPad
    Load FNumPad
    Load FBinPad
End Sub

Public Sub UnloadPads()
    Unload FHexPad
    Unload FAlphaPad
    Unload FNumPad
    Unload FBinPad
End Sub

#If TEST = 1 Then
Public Sub Log(ByVal Text As String)
    Dim nFNo As Integer
    
    nFNo = FreeFile
    Open App.Path & "\VWTouchKeyboard.log" For Append As #nFNo
    Print #nFNo, Now, Text
    Close #nFNo
End Sub
#End If