home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 4 Power Pack / Visual_Basic4_Power_Pack.bin / vb4files / pclvbw11 / simpline.bas < prev    next >
Encoding:
BASIC Source File  |  1996-11-20  |  4.1 KB  |  180 lines
  1. ' SIMPLINE.BAS
  2.  
  3. Option Explicit
  4.  
  5. Dim FatalFlag As Integer
  6. Dim Code As Integer
  7.  
  8. Sub Aborting ()
  9.   Dim Code As Integer
  10.   SIMPLE.Print "Fatal Error, Aborting..."
  11.   Code = SioDone(ThePort)
  12.   End
  13. End Sub
  14.  
  15. Sub DisplayChar (ByVal C As Integer)
  16.   Dim Row As Integer
  17.   Dim Col As Integer
  18.   C = &H7F And C
  19.   'process char
  20.   If C = 13 Then
  21.     'carriage control
  22.     CurrentCol = 0
  23.     'plus assumed line feed
  24.     If CurrentRow < 23 Then
  25.       CurrentRow = CurrentRow + 1
  26.       'print CR+LF
  27.       SIMPLE.Print
  28.     Else
  29.       'scroll !
  30.       SIMPLE.Cls
  31.       For Row = 0 To 22
  32.         'print row
  33.         ScreenBuffer(Row) = ScreenBuffer(Row + 1)
  34.         SIMPLE.Print ScreenBuffer(Row)
  35.       Next Row
  36.       'clear bottom row
  37.       ScreenBuffer(23) = Space$(80)
  38.     End If
  39.   ElseIf C = 10 Then
  40.     'throw away line feeds
  41.   Else
  42.     'not CR or LF
  43.     CurrentCol = CurrentCol + 1
  44.     If CurrentCol > 79 Then
  45.       'throw away !
  46.       Exit Sub
  47.     Else
  48.       'save in screen buffer & display
  49.       Mid$(ScreenBuffer(CurrentRow), CurrentCol, 1) = Chr$(C)
  50.       SIMPLE.Print Chr$(C);
  51.     End If
  52.   End If
  53. End Sub
  54.  
  55. Sub DisplayString (Text As String)
  56.   Dim I As Integer
  57.   Dim Length As Integer
  58.   Length = Len(Text)
  59.   For I = 1 To Length
  60.     Call DisplayChar(Asc(Mid$(Text, I, 1)))
  61.   Next I
  62.   Call DisplayChar(13)
  63. End Sub
  64.  
  65. Function GetDosMemory (SizeCode As Integer)
  66.   Dim Size As Long
  67.   Dim Value As Long
  68.   If SizeCode > Size32K Then
  69.     SIMPLE.Print "SizeCode out of range"
  70.     GetDosMemory = 0
  71.     Exit Function
  72.   End If
  73.   Size = 2 ^ (SizeCode + 4)
  74.   Value = GlobalDosAlloc(Size)
  75.   If Value Then
  76.     'return selector
  77.     GetDosMemory = (&HFFFF& And Value)
  78.   Else
  79.     SIMPLE.Print "Cannot allocate Dos memory ("; Size; ")"
  80.     GetDosMemory = 0
  81.   End If
  82.  
  83. End Function
  84.  
  85. Sub GetIncoming ()
  86.   Dim I As Integer
  87.   Dim TheChar As Integer
  88.   For I = 1 To 1000
  89.     TheChar = SioGetc(ThePort, 0)
  90.     If TheChar >= 0 Then
  91.       '''IncomingCount = IncomingCount + 1
  92.       Call DisplayChar(TheChar)
  93.     Else
  94.       Exit For
  95.     End If
  96.   Next I
  97. End Sub
  98.  
  99. Sub GoOffLine ()
  100.   Dim Code As Integer
  101.   OnLineFlag = 0
  102.   'shut down port
  103.   Code = SioDone(ThePort)
  104.   'free DOS memory
  105.   If TxSelector <> 0 Then
  106.     '''Code = GlobalPageUnlock(TxSelector)
  107.     Code = GlobalDosFree(TxSelector)
  108.     TxSelector = 0
  109.   End If
  110.   If RxSelector <> 0 Then
  111.     '''Code = GlobalPageUnlock(RxSelector)
  112.     Code = GlobalDosFree(RxSelector)
  113.     RxSelector = 0
  114.   End If
  115.  
  116. End Sub
  117.  
  118. Sub GoOnLine ()
  119.   Dim I As Integer
  120.   If OnLineFlag Then
  121.     Exit Sub
  122.   End If
  123.   'allocating RX buffer
  124.   RxSelector = GetDosMemory(Size1024)
  125.   Code = SioRxBuf(ThePort, RxSelector, Size1024)
  126.   If Code < 0 Then
  127.     SIMPLE.Print "Cannot allocate RX buffer"
  128.     Exit Sub
  129.   End If
  130.   'allocate TX buffer
  131.   TxSelector = GetDosMemory(Size128)
  132.   Code = SioTxBuf(ThePort, TxSelector, Size128)
  133.   If Code < 0 Then
  134.     SIMPLE.Print "Cannot allocate TX buffer"
  135.     Exit Sub
  136.   End If
  137.   'reset the port
  138.   Code = SioReset(ThePort, TheBaudCode)
  139.   If Code < 0 Then
  140.     Call SioError(SIMPLE,Code)
  141.     Exit Sub
  142.   End If
  143.   'call Aborting() if detect error after resetting port
  144.   Call DisplayString("COM" + LTrim$(Str$(1 + ThePort)) + " reset")
  145.   'set DTR & RTS
  146.   Code = SioDTR(ThePort, Asc("S"))
  147.   Code = SioRTS(ThePort, Asc("S"))
  148.   'turn on hardware flow control
  149.   Code = SioFlow(ThePort, 18)
  150.   Call DisplayString("RTS/CTS flow control on")
  151.   'turn on UART FIFO if 16550
  152.   Code = SioFIFO(ThePort, LEVEL_8)
  153.   If Code > 0 Then
  154.     Call DisplayString("16550 Detected")
  155.   End If
  156.   ' set parms
  157.   Code = SioParms(ThePort, TheParity, TheStopBits, TheDataBits)
  158.   ' we're online !
  159.   OnLineFlag = 1
  160. End Sub
  161.  
  162. Sub ShowConfig ()
  163.   Dim A As String
  164.   Dim B As String
  165.   Dim C As String
  166.   Dim D As String
  167.   Dim E As String
  168.   If OnLineFlag Then
  169.     A = " (Online)"
  170.   Else
  171.     A = " (Offline)"
  172.   End If
  173.   B = "COM" + LTrim$(Str$(ThePort + 1))
  174.   C = " @ " + BaudText(TheBaudCode) + " "
  175.   D = Str$(5 + TheDataBits) + ParityText(TheParity)
  176.   E = LTrim$(Str$(1 + TheStopBits))
  177.   SIMPLE.Caption = "SIMPLE: " + B + C + D + E + A
  178. End Sub
  179.  
  180.