home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 5 / MasteringVisualBasic5.iso / ch_code / ch08 / readnum / readnum.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1997-02-20  |  7.7 KB  |  183 lines
  1. VERSION 5.00
  2. Begin VB.Form ReadNum 
  3.    Caption         =   "Read Numbers"
  4.    ClientHeight    =   1350
  5.    ClientLeft      =   1140
  6.    ClientTop       =   1470
  7.    ClientWidth     =   3135
  8.    LinkTopic       =   "PlayWave"
  9.    PaletteMode     =   1  'UseZOrder
  10.    ScaleHeight     =   1350
  11.    ScaleWidth      =   3135
  12.    Begin VB.CommandButton Play 
  13.       Caption         =   "Read Numbers"
  14.       Height          =   615
  15.       Left            =   480
  16.       TabIndex        =   0
  17.       Top             =   360
  18.       Width           =   2175
  19.    End
  20. Attribute VB_Name = "ReadNum"
  21. Attribute VB_GlobalNameSpace = False
  22. Attribute VB_Creatable = False
  23. Attribute VB_PredeclaredId = True
  24. Attribute VB_Exposed = False
  25. Option Explicit
  26.     Private Declare Function mciSendStringA Lib "WinMM" _
  27.         (ByVal mciCommand As String, ByVal returnStr As String, _
  28.         ByVal returnLength As Integer, ByVal callBack As Integer) As Long
  29.     Private Declare Function mciGetErrorStringA Lib "WinMM" _
  30.         (ByVal error As Long, ByVal buffer As String, _
  31.         ByVal length As Integer) As Integer
  32.         
  33. Private Sub ReadSingle(number)
  34.     Dim errorCode As Integer
  35.     Dim returnStr As Integer
  36.     Dim returnCode As Integer
  37.     Dim errorStr As String * 256
  38.     If number = 1 Then
  39.         errorCode = mciSendStringA("play numbers from 500 to 1500 wait", returnStr, 255, 0)
  40.     ElseIf number = 2 Then
  41.         errorCode = mciSendStringA("play numbers from 1500 to 2500 wait", returnStr, 255, 0)
  42.     ElseIf number = 3 Then
  43.         errorCode = mciSendStringA("play numbers from 2500 to 3500 wait", returnStr, 255, 0)
  44.     ElseIf number = 4 Then
  45.         errorCode = mciSendStringA("play numbers from 3500 to 4500 wait", returnStr, 255, 0)
  46.     ElseIf number = 5 Then
  47.         errorCode = mciSendStringA("play numbers from 4500 to 5500 wait", returnStr, 255, 0)
  48.     ElseIf number = 6 Then
  49.         errorCode = mciSendStringA("play numbers from 5500 to 6500 wait", returnStr, 255, 0)
  50.     ElseIf number = 7 Then
  51.         errorCode = mciSendStringA("play numbers from 6500 to 7500 wait", returnStr, 255, 0)
  52.     ElseIf number = 8 Then
  53.         errorCode = mciSendStringA("play numbers from 7500 to 8500 wait", returnStr, 255, 0)
  54.     ElseIf number = 9 Then
  55.         errorCode = mciSendStringA("play numbers from 8500 to 9500 wait", returnStr, 255, 0)
  56.     ElseIf number = 10 Then
  57.         errorCode = mciSendStringA("play numbers from 9500 to 10500 wait", returnStr, 255, 0)
  58.     ElseIf number = 11 Then
  59.         errorCode = mciSendStringA("play numbers from 10500 to 11500 wait", returnStr, 255, 0)
  60.     ElseIf number = 12 Then
  61.         errorCode = mciSendStringA("play numbers from 11500 to 12500 wait", returnStr, 255, 0)
  62.     ElseIf number = 13 Then
  63.         errorCode = mciSendStringA("play numbers from 12500 to 13500 wait", returnStr, 255, 0)
  64.     ElseIf number = 14 Then
  65.         errorCode = mciSendStringA("play numbers from 13500 to 14500 wait", returnStr, 255, 0)
  66.     ElseIf number = 15 Then
  67.         errorCode = mciSendStringA("play numbers from 14500 to 15500 wait", returnStr, 255, 0)
  68.     ElseIf number = 16 Then
  69.         errorCode = mciSendStringA("play numbers from 15500 to 16500 wait", returnStr, 255, 0)
  70.     ElseIf number = 17 Then
  71.         errorCode = mciSendStringA("play numbers from 16500 to 17500 wait", returnStr, 255, 0)
  72.     ElseIf number = 18 Then
  73.         errorCode = mciSendStringA("play numbers from 17500 to 18500 wait", returnStr, 255, 0)
  74.     ElseIf number = 19 Then
  75.         errorCode = mciSendStringA("play numbers from 18500 to 19500 wait", returnStr, 255, 0)
  76.     End If
  77. End Sub
  78. Private Sub ReadTenths(number)
  79.     Dim errorCode As Integer
  80.     Dim returnStr As Integer
  81.     Dim returnCode As Integer
  82.     Dim errorStr As String * 256
  83.     If number = 20 Then
  84.         errorCode = mciSendStringA("play numbers from 20000 to 20500 wait", returnStr, 255, 0)
  85.     ElseIf number = 30 Then
  86.         errorCode = mciSendStringA("play numbers from 21000 to 21500 wait", returnStr, 255, 0)
  87.     ElseIf number = 40 Then
  88.         errorCode = mciSendStringA("play numbers from 22000 to 22500 wait", returnStr, 255, 0)
  89.     ElseIf number = 50 Then
  90.         errorCode = mciSendStringA("play numbers from 23000 to 23500 wait", returnStr, 255, 0)
  91.     ElseIf number = 60 Then
  92.         errorCode = mciSendStringA("play numbers from 24000 to 24700 wait", returnStr, 255, 0)
  93.     ElseIf number = 70 Then
  94.         errorCode = mciSendStringA("play numbers from 25000 to 25700 wait", returnStr, 255, 0)
  95.     ElseIf number = 80 Then
  96.         errorCode = mciSendStringA("play numbers from 26100 to 26700 wait", returnStr, 255, 0)
  97.     ElseIf number = 90 Then
  98.         errorCode = mciSendStringA("play numbers from 27400 to 27900 wait", returnStr, 255, 0)
  99.     End If
  100. End Sub
  101. 'This is the routine to read numbers
  102. Private Sub ReadNum(number)
  103.     Dim errorCode As Integer
  104.     Dim returnStr As Integer
  105.     Dim returnCode As Integer
  106.     Dim errorStr As String * 256
  107.     Dim tenth As Integer
  108.     Dim leftover As Integer
  109.     Dim hundred As Integer
  110.     Dim thousand As Integer
  111.         
  112.     If number < 20 Then         'Reads unique numbers
  113.         ReadSingle (number)
  114.     ElseIf number < 100 Then    'Reads numbers less than 100
  115.         tenth = Fix(number / 10)
  116.         ReadTenths (tenth * 10)
  117.         leftover = number - (tenth * 10)
  118.         If leftover > 0 Then
  119.             ReadSingle (leftover)
  120.         End If
  121.     ElseIf number < 1000 Then   'Reads numbers between 100 and 999
  122.         
  123.         hundred = Fix(number / 100)
  124.         ReadSingle (hundred)
  125.         errorCode = mciSendStringA("play numbers from 28500 to 28900 wait", returnStr, 255, 0)
  126.         leftover = number - (hundred * 100)
  127.         If leftover > 0 Then
  128.             tenth = Fix(leftover / 10)
  129.             If tenth > 0 Then ReadTenths (tenth * 10)
  130.             leftover = number - (hundred * 100) - (tenth * 10)
  131.             If leftover > 0 Then
  132.                 ReadSingle (leftover)
  133.             End If
  134.         End If
  135.     Else                        'Reads number between 1000 and 9999
  136.         thousand = Fix(number / 1000)
  137.         ReadSingle (thousand)
  138.         errorCode = mciSendStringA("play numbers from 29500 to 30100 wait", returnStr, 255, 0)
  139.         leftover = number - (thousand * 1000)
  140.         If leftover > 0 Then
  141.             hundred = Fix(leftover / 100)
  142.             If hundred > 0 Then
  143.                 ReadSingle (hundred)
  144.                 errorCode = mciSendStringA("play numbers from 28500 to 28900 wait", returnStr, 255, 0)
  145.             End If
  146.             leftover = number - (thousand * 1000) - (hundred * 100)
  147.             If leftover > 0 Then
  148.                 tenth = Fix(leftover / 10)
  149.                 If tenth > 0 Then ReadTenths (tenth * 10)
  150.                 leftover = number - (thousand * 1000) - (hundred * 100) - (tenth * 10)
  151.                 If leftover > 0 Then
  152.                     ReadSingle (leftover)
  153.                 End If
  154.             End If
  155.         End If
  156.     End If
  157. End Sub
  158. Private Sub Play_Click()
  159.     Dim errorCode As Integer
  160.     Dim returnStr As Integer
  161.     Dim returnCode As Integer
  162.     Dim errorStr As String * 256
  163.     Dim number As Long
  164.     'Open file numbers.txt
  165.         
  166.     errorCode = mciSendStringA("open numbers.wav type waveaudio alias numbers", _
  167.                 returnStr, 255, 0)
  168.     returnCode = mciGetErrorStringA(errorCode, errorStr, 255)
  169.       
  170.     'Read numbers
  171.     Do
  172.         number = Val(InputBox("Enter another number, 0 to end"))
  173.         If number < 0 Or number > 9999 Then GoTo NextNumber
  174.         ReadNum (number)
  175. NextNumber:
  176.     Loop While number <> 0
  177.     'Close audio
  178.     errorCode = mciSendStringA("close waveaudio", _
  179.                 returnStr, 255, 0)
  180.     'Close file
  181.     Close #1
  182. End Sub
  183.