home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 6 / mastvb6.iso / ch_code / appx_c / readdate / readdate.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1998-07-01  |  5.2 KB  |  119 lines
  1. VERSION 5.00
  2. Begin VB.Form ReadDate 
  3.    Caption         =   "Read Date"
  4.    ClientHeight    =   1440
  5.    ClientLeft      =   1140
  6.    ClientTop       =   1470
  7.    ClientWidth     =   4335
  8.    LinkTopic       =   "PlayWave"
  9.    PaletteMode     =   1  'UseZOrder
  10.    ScaleHeight     =   1440
  11.    ScaleWidth      =   4335
  12.    Begin VB.TextBox Text1 
  13.       Height          =   375
  14.       Left            =   2280
  15.       TabIndex        =   1
  16.       Top             =   240
  17.       Width           =   1695
  18.    End
  19.    Begin VB.CommandButton Play 
  20.       Caption         =   "Read Date"
  21.       Height          =   420
  22.       Left            =   120
  23.       TabIndex        =   0
  24.       Top             =   240
  25.       Width           =   1905
  26.    End
  27. Attribute VB_Name = "ReadDate"
  28. Attribute VB_GlobalNameSpace = False
  29. Attribute VB_Creatable = False
  30. Attribute VB_PredeclaredId = True
  31. Attribute VB_Exposed = False
  32. Option Explicit
  33.     Private Declare Function mciSendStringA Lib "WinMM" _
  34.         (ByVal mciCommand As String, ByVal returnStr As String, _
  35.         ByVal returnLength As Integer, ByVal callBack As Integer) As Long
  36.     Private Declare Function mciGetErrorStringA Lib "WinMM" _
  37.         (ByVal error As Long, ByVal buffer As String, _
  38.         ByVal length As Integer) As Integer
  39.         
  40. Private Sub Form_Load()
  41. Dim curDate
  42. Dim myStr
  43.     Text1.Text = Format(Date)
  44. End Sub
  45. Private Sub Play_Click()
  46.     Dim errorCode As Integer
  47.     Dim returnStr As Integer
  48.     Dim returnCode As Integer
  49.     Dim errorStr As String * 256
  50.     Dim curDate
  51.     Dim myStr
  52.     Dim myDay As String * 256
  53.     errorCode = mciSendStringA("open " & Chr(34) & App.Path & "\days.wav" & Chr(34) & " type waveaudio alias days", _
  54.                 returnStr, 255, 0)
  55.     errorCode = mciSendStringA("open " & Chr(34) & App.Path & "\months.wav" & Chr(34) & " type waveaudio alias months", _
  56.                 returnStr, 255, 0)
  57.     errorCode = mciSendStringA("open " & Chr(34) & App.Path & "\years.wav" & Chr(34) & " type waveaudio alias years", _
  58.                 returnStr, 255, 0)
  59.     returnCode = mciGetErrorStringA(errorCode, errorStr, 255)
  60.     'Get Date
  61.     curDate = CDate(Text1.Text)
  62.     'Get Day
  63.     myStr = Format(curDate, "dddd")
  64.     If myStr = "Sunday" Then
  65.         errorCode = mciSendStringA("play days from 6000 to 7000 wait", returnStr, 255, 0)
  66.     ElseIf myStr = "Monday" Then
  67.         errorCode = mciSendStringA("play days from 0 to 1000 wait", returnStr, 255, 0)
  68.     ElseIf myStr = "Tuesday" Then
  69.         errorCode = mciSendStringA("play days from 1000 to 2000 wait", returnStr, 255, 0)
  70.     ElseIf myStr = "Wednesday" Then
  71.         errorCode = mciSendStringA("play days from 2000 to 3000 wait", returnStr, 255, 0)
  72.     ElseIf myStr = "Thursday" Then
  73.         errorCode = mciSendStringA("play days from 3000 to 4000 wait", returnStr, 255, 0)
  74.     ElseIf myStr = "Friday" Then
  75.         errorCode = mciSendStringA("play days from 4000 to 5000 wait", returnStr, 255, 0)
  76.     ElseIf myStr = "Saturday" Then
  77.         errorCode = mciSendStringA("play days from 5000 to 6000 wait", returnStr, 255, 0)
  78.     End If
  79.     'Get Month
  80.     myStr = Format(curDate, "mmm")
  81.     If myStr = "Jan" Then
  82.         errorCode = mciSendStringA("play months from 500 to 1300 wait", returnStr, 255, 0)
  83.     ElseIf myStr = "Feb" Then
  84.         errorCode = mciSendStringA("play months from 1500 to 2300 wait", returnStr, 255, 0)
  85.     ElseIf myStr = "Mar" Then
  86.         errorCode = mciSendStringA("play months from 2500 to 3100 wait", returnStr, 255, 0)
  87.     ElseIf myStr = "Apr" Then
  88.         errorCode = mciSendStringA("play months from 3400 to 4300 wait", returnStr, 255, 0)
  89.     ElseIf myStr = "May" Then
  90.         errorCode = mciSendStringA("play months from 4500 to 5300 wait", returnStr, 255, 0)
  91.     ElseIf myStr = "Jun" Then
  92.         errorCode = mciSendStringA("play months from 5500 to 6300 wait", returnStr, 255, 0)
  93.     ElseIf myStr = "Jul" Then
  94.         errorCode = mciSendStringA("play months from 6500 to 7100 wait", returnStr, 255, 0)
  95.     ElseIf myStr = "Aug" Then
  96.         errorCode = mciSendStringA("play months from 7500 to 8200 wait", returnStr, 255, 0)
  97.     ElseIf myStr = "Sep" Then
  98.         errorCode = mciSendStringA("play months from 8400 to 9200 wait", returnStr, 255, 0)
  99.     ElseIf myStr = "Oct" Then
  100.         errorCode = mciSendStringA("play months from 9400 to 10200 wait", returnStr, 255, 0)
  101.     ElseIf myStr = "Nov" Then
  102.         errorCode = mciSendStringA("play months from 10500 to 11200 wait", returnStr, 255, 0)
  103.     ElseIf myStr = "Dec" Then
  104.         errorCode = mciSendStringA("play months from 11200 to 12000 wait", returnStr, 255, 0)
  105.     End If
  106.     'Get Year
  107.     myStr = Format(curDate, "yyyy")
  108.     If myStr = "1996" Then
  109.         errorCode = mciSendStringA("play years from 4000 to 5500 wait", returnStr, 255, 0)
  110.     ElseIf myStr = "1997" Then
  111.         errorCode = mciSendStringA("play years from 5500 to 7500 wait", returnStr, 255, 0)
  112.     ElseIf myStr = "1998" Then
  113.         errorCode = mciSendStringA("play years from 7500 to 9000 wait", returnStr, 255, 0)
  114.     ElseIf myStr = "1999" Then
  115.         errorCode = mciSendStringA("play years from 9000 to 10500 wait", returnStr, 255, 0)
  116.     End If
  117.        
  118. End Sub
  119.