home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 6 / mastvb6.iso / ch_code / appx_c / readnums / readnum.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1998-07-01  |  9.3 KB  |  235 lines
  1. VERSION 5.00
  2. Begin VB.Form ReadNum 
  3.    Caption         =   "Read Numbers"
  4.    ClientHeight    =   1695
  5.    ClientLeft      =   1140
  6.    ClientTop       =   1470
  7.    ClientWidth     =   4140
  8.    LinkTopic       =   "PlayWave"
  9.    PaletteMode     =   1  'UseZOrder
  10.    ScaleHeight     =   1695
  11.    ScaleWidth      =   4140
  12.    Begin VB.TextBox Text2 
  13.       BackColor       =   &H80000000&
  14.       BorderStyle     =   0  'None
  15.       BeginProperty Font 
  16.          Name            =   "Verdana"
  17.          Size            =   9
  18.          Charset         =   0
  19.          Weight          =   400
  20.          Underline       =   0   'False
  21.          Italic          =   0   'False
  22.          Strikethrough   =   0   'False
  23.       EndProperty
  24.       Height          =   735
  25.       Left            =   120
  26.       MultiLine       =   -1  'True
  27.       TabIndex        =   2
  28.       Text            =   "readnum.frx":0000
  29.       Top             =   120
  30.       Width           =   3855
  31.    End
  32.    Begin VB.TextBox Text1 
  33.       BeginProperty Font 
  34.          Name            =   "Verdana"
  35.          Size            =   9.75
  36.          Charset         =   0
  37.          Weight          =   400
  38.          Underline       =   0   'False
  39.          Italic          =   0   'False
  40.          Strikethrough   =   0   'False
  41.       EndProperty
  42.       Height          =   375
  43.       Left            =   3000
  44.       TabIndex        =   1
  45.       Text            =   "9999"
  46.       Top             =   1200
  47.       Width           =   1095
  48.    End
  49.    Begin VB.CommandButton Play 
  50.       Caption         =   "Read Numbers"
  51.       BeginProperty Font 
  52.          Name            =   "Verdana"
  53.          Size            =   9.75
  54.          Charset         =   0
  55.          Weight          =   400
  56.          Underline       =   0   'False
  57.          Italic          =   0   'False
  58.          Strikethrough   =   0   'False
  59.       EndProperty
  60.       Height          =   375
  61.       Left            =   120
  62.       TabIndex        =   0
  63.       Top             =   1200
  64.       Width           =   1935
  65.    End
  66. Attribute VB_Name = "ReadNum"
  67. Attribute VB_GlobalNameSpace = False
  68. Attribute VB_Creatable = False
  69. Attribute VB_PredeclaredId = True
  70. Attribute VB_Exposed = False
  71. Option Explicit
  72. Private Declare Function mciSendStringA Lib "WinMM" _
  73.     (ByVal mciCommand As String, ByVal returnStr As String, _
  74.     ByVal returnLength As Integer, ByVal callBack As Integer) As Long
  75. Private Declare Function mciGetErrorStringA Lib "WinMM" _
  76.     (ByVal error As Long, ByVal buffer As String, _
  77.     ByVal length As Integer) As Integer
  78.         
  79. Private Sub ReadSingle(number)
  80. Dim errorCode As Integer
  81. Dim returnStr As Integer
  82. Dim returnCode As Integer
  83. Dim errorStr As String * 256
  84.     If number = 1 Then
  85.         errorCode = mciSendStringA("play numbers from 500 to 1500 wait", returnStr, 255, 0)
  86.     ElseIf number = 2 Then
  87.         errorCode = mciSendStringA("play numbers from 1500 to 2500 wait", returnStr, 255, 0)
  88.     ElseIf number = 3 Then
  89.         errorCode = mciSendStringA("play numbers from 2500 to 3500 wait", returnStr, 255, 0)
  90.     ElseIf number = 4 Then
  91.         errorCode = mciSendStringA("play numbers from 3500 to 4500 wait", returnStr, 255, 0)
  92.     ElseIf number = 5 Then
  93.         errorCode = mciSendStringA("play numbers from 4500 to 5500 wait", returnStr, 255, 0)
  94.     ElseIf number = 6 Then
  95.         errorCode = mciSendStringA("play numbers from 5500 to 6500 wait", returnStr, 255, 0)
  96.     ElseIf number = 7 Then
  97.         errorCode = mciSendStringA("play numbers from 6500 to 7500 wait", returnStr, 255, 0)
  98.     ElseIf number = 8 Then
  99.         errorCode = mciSendStringA("play numbers from 7500 to 8500 wait", returnStr, 255, 0)
  100.     ElseIf number = 9 Then
  101.         errorCode = mciSendStringA("play numbers from 8500 to 9500 wait", returnStr, 255, 0)
  102.     ElseIf number = 10 Then
  103.         errorCode = mciSendStringA("play numbers from 9500 to 10500 wait", returnStr, 255, 0)
  104.     ElseIf number = 11 Then
  105.         errorCode = mciSendStringA("play numbers from 10500 to 11500 wait", returnStr, 255, 0)
  106.     ElseIf number = 12 Then
  107.         errorCode = mciSendStringA("play numbers from 11500 to 12500 wait", returnStr, 255, 0)
  108.     ElseIf number = 13 Then
  109.         errorCode = mciSendStringA("play numbers from 12500 to 13500 wait", returnStr, 255, 0)
  110.     ElseIf number = 14 Then
  111.         errorCode = mciSendStringA("play numbers from 13500 to 14500 wait", returnStr, 255, 0)
  112.     ElseIf number = 15 Then
  113.         errorCode = mciSendStringA("play numbers from 14500 to 15500 wait", returnStr, 255, 0)
  114.     ElseIf number = 16 Then
  115.         errorCode = mciSendStringA("play numbers from 15500 to 16500 wait", returnStr, 255, 0)
  116.     ElseIf number = 17 Then
  117.         errorCode = mciSendStringA("play numbers from 16500 to 17500 wait", returnStr, 255, 0)
  118.     ElseIf number = 18 Then
  119.         errorCode = mciSendStringA("play numbers from 17500 to 18500 wait", returnStr, 255, 0)
  120.     ElseIf number = 19 Then
  121.         errorCode = mciSendStringA("play numbers from 18500 to 19500 wait", returnStr, 255, 0)
  122.     End If
  123. End Sub
  124. Private Sub ReadTenths(number)
  125. Dim errorCode As Integer
  126. Dim returnStr As Integer
  127. Dim returnCode As Integer
  128. Dim errorStr As String * 256
  129.     If number = 20 Then
  130.         errorCode = mciSendStringA("play numbers from 20000 to 20500 wait", returnStr, 255, 0)
  131.     ElseIf number = 30 Then
  132.         errorCode = mciSendStringA("play numbers from 21000 to 21500 wait", returnStr, 255, 0)
  133.     ElseIf number = 40 Then
  134.         errorCode = mciSendStringA("play numbers from 22000 to 22500 wait", returnStr, 255, 0)
  135.     ElseIf number = 50 Then
  136.         errorCode = mciSendStringA("play numbers from 23000 to 23500 wait", returnStr, 255, 0)
  137.     ElseIf number = 60 Then
  138.         errorCode = mciSendStringA("play numbers from 24000 to 24700 wait", returnStr, 255, 0)
  139.     ElseIf number = 70 Then
  140.         errorCode = mciSendStringA("play numbers from 25000 to 25700 wait", returnStr, 255, 0)
  141.     ElseIf number = 80 Then
  142.         errorCode = mciSendStringA("play numbers from 26100 to 26700 wait", returnStr, 255, 0)
  143.     ElseIf number = 90 Then
  144.         errorCode = mciSendStringA("play numbers from 27400 to 27900 wait", returnStr, 255, 0)
  145.     End If
  146. End Sub
  147. 'This is the routine to read numbers
  148. Private Sub ReadNum(number)
  149. Dim errorCode As Integer
  150. Dim returnStr As Integer
  151. Dim returnCode As Integer
  152. Dim errorStr As String * 256
  153. Dim tenth As Integer
  154. Dim leftover As Integer
  155. Dim hundred As Integer
  156. Dim thousand As Integer
  157.         
  158.     If number < 20 Then         'Reads unique numbers
  159.         ReadSingle (number)
  160.     ElseIf number < 100 Then    'Reads numbers less than 100
  161.         tenth = Fix(number / 10)
  162.         ReadTenths (tenth * 10)
  163.         leftover = number - (tenth * 10)
  164.         If leftover > 0 Then
  165.             ReadSingle (leftover)
  166.         End If
  167.     ElseIf number < 1000 Then   'Reads numbers between 100 and 999
  168.         
  169.         hundred = Fix(number / 100)
  170.         ReadSingle (hundred)
  171.         errorCode = mciSendStringA("play numbers from 28500 to 28900 wait", returnStr, 255, 0)
  172.         leftover = number - (hundred * 100)
  173.         If leftover > 0 Then
  174.             tenth = Fix(leftover / 10)
  175.             If tenth > 0 Then ReadTenths (tenth * 10)
  176.             leftover = number - (hundred * 100) - (tenth * 10)
  177.             If leftover > 0 Then
  178.                 ReadSingle (leftover)
  179.             End If
  180.         End If
  181.     Else                        'Reads number between 1000 and 9999
  182.         thousand = Fix(number / 1000)
  183.         ReadSingle (thousand)
  184.         errorCode = mciSendStringA("play numbers from 29500 to 30100 wait", returnStr, 255, 0)
  185.         leftover = number - (thousand * 1000)
  186.         If leftover > 0 Then
  187.             hundred = Fix(leftover / 100)
  188.             If hundred > 0 Then
  189.                 ReadSingle (hundred)
  190.                 errorCode = mciSendStringA("play numbers from 28500 to 28900 wait", returnStr, 255, 0)
  191.             End If
  192.             leftover = number - (thousand * 1000) - (hundred * 100)
  193.             If leftover > 0 Then
  194.                 tenth = Fix(leftover / 10)
  195.                 If tenth > 0 Then ReadTenths (tenth * 10)
  196.                 leftover = number - (thousand * 1000) - (hundred * 100) - (tenth * 10)
  197.                 If leftover > 0 Then
  198.                     ReadSingle (leftover)
  199.                 End If
  200.             End If
  201.         End If
  202.     End If
  203. End Sub
  204. Private Sub Play_Click()
  205.     Dim errorCode As Integer
  206.     Dim returnStr As Integer
  207.     Dim returnCode As Integer
  208.     Dim errorStr As String * 256
  209.     Dim number As Long
  210.     'Open file numbers.txt
  211.         
  212.     errorCode = mciSendStringA("open " & Chr(34) & App.Path & "\numbers.wav" & Chr(34) & " type waveaudio alias numbers", _
  213.                 returnStr, 255, 0)
  214.     returnCode = mciGetErrorStringA(errorCode, errorStr, 255)
  215.       
  216.     'Read numbers
  217.     If Not IsNumeric(Text1.Text) Then
  218.         MsgBox "Please enter a numeric value"
  219.         Exit Sub
  220.     Else
  221.         number = Val(Text1.Text)
  222.         If number < 1 Or number > 10000 Then
  223.             MsgBox "Please enter a value in the range 0 to 9999"
  224.             Exit Sub
  225.         Else
  226.             ReadNum number
  227.         End If
  228.     End If
  229.     'Close audio
  230.     errorCode = mciSendStringA("close waveaudio", _
  231.                 returnStr, 255, 0)
  232.     'Close file
  233.     Close #1
  234. End Sub
  235.