Sub TestTransmit()
TransmitText "Test2", 22, 16 'Sending the text "Test2" to the screen
SendTerminalKey rcIBMpf9Key 'Send the Terminal key corresponding to F9
End Sub
'---------------------------------------------------------------------------------------
' Procedure : TransmitText
' Author : Morten Broberg Kristensen
' Date : 17.01.2011
' Purpose : Send text to the host, either to a specified location or to where the
' cursor might be. Optional TextLength, and also it will truncate to fieldlen
'---------------------------------------------------------------------------------------
Public Function TransmitText(ByVal text As String, Optional Row As Long, Optional Column As Long, Optional TextLength As Long)
Dim fieldLen As Long
Dim MySession As Reflection.Session
Set MySession = GetObject("RIBM")
On Error GoTo TransmitText_Error
If Not Row = 0 Then 'If we give it a row then first move the cursor!
MySession.Movecursor Row, Column
MySession.WaitForEvent rcKbdEnabled, "30", "0", 1, 1 'Wait 30 sec for keyboard or time out
MySession.TransmitTerminalKey rcIBMEraseEOFKey 'Clear field
MySession.WaitForEvent rcKbdEnabled, "30", "0", 1, 1 'Wait 30 sec for keyboard or time out
End If
MySession.FindField CursorRow, CursorColumn, rcCurrent, rcAnyField 'Find any field in current field specified by cursorrow and cursorcol and set the properties
fieldLen = MySession.FoundFieldLength 'Get the foundfieldlength property and use that as amount of chars to retrieve, ie. the full length of the field.
If Not TextLength = 0 Then 'If textlengh is set then
text = VBA.Left$(text, Min(TextLength, fieldLen)) 'Truncate text by the lesser of the lengths
Else
text = VBA.Left$(text, fieldLen) 'If textlength is not set then truncate by fieldlength
End If
'And then just send the text
MySession.TransmitANSI text
MySession.WaitForEvent rcKbdEnabled, "30", "0", 1, 1 'Wait 30 sec for keyboard or time out
Set MySession = Nothing
On Error GoTo 0
Exit Function
TransmitText_Error:
Err.Raise Err.Number, "@[Parser.TransmitText] " & Err.Source, Err.Description
End Function
Public Function Min(ByVal num1 As Variant, ByVal num2 As Variant) As Variant
On Error GoTo ErrHandler:
If num1 < num2 Then
Min = num1
Else
Min = num2
End If
Exit Function
ErrHandler:
Debug.Print "Sommat went wrong"
End Function
'---------------------------------------------------------------------------------------
' Procedure : SendTerminalKey
' Author : Morten Broberg Kristensen
' Date : 15.09.2010
' Purpose : Will try to send the corresponding rc terminalkey
'---------------------------------------------------------------------------------------
Public Function SendTerminalKey(ByVal k As Long) As Boolean
On Error GoTo SendTerminalKey_Error
Dim MySession As Reflection.Session
Set MySession = GetObject("RIBM")
MySession.TransmitTerminalKey k
MySession.WaitForEvent rcKbdEnabled, "30", "0", 1, 1 'Try to wait for enabled keyboard before we continue
' The code outcommented below is just used internally in my code to count amount of transaction used, and the up'n'down keys are "free" on my system
' Select Case k
' Case rcIBMPf7Key
'
' Case rcIBMPf8Key
'
' Case Else
' Transactions = Transactions + 1 'increment the trans-counter
' End Select
Set MySession = Nothing
On Error GoTo 0
Exit Function
SendTerminalKey_Error:
Err.Raise Err.Number, "@[Parser.SendTerminalKey] " & Err.Source, Err.Description
End Function
