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