frmmessage.frm

产生打字机的声音效果

VERSION 5.00
Begin VB.Form frmMessage 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Write X-Files Type of Message"
   ClientHeight    =   3975
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6915
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   3975
   ScaleWidth      =   6915
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer tmrNewText 
      Interval        =   200
      Left            =   2160
      Top             =   1740
   End
   Begin VB.PictureBox picMessage 
      Appearance      =   0  'Flat
      BackColor       =   &H00000000&
      BeginProperty Font 
         Name            =   "Courier New"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000FF00&
      Height          =   3975
      Left            =   0
      ScaleHeight     =   3945
      ScaleWidth      =   6885
      TabIndex        =   0
      Top             =   0
      Width           =   6915
   End
End
Attribute VB_Name = "frmMessage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit ' Now I must declare variables (you really should (must) use this!)

  ' Declare message-stuff
Private strMessage As String    ' Define this in Form_Load (otherwise you can make a const, but then you won't be able to change it....)
Private lngLetterCount As Long  ' Will keep track of which letter we're on

Dim AppPath As String ' See in Form_Load
Const NL = vbCrLf ' Makes it faster/easier to write NewLines

Private Sub Form_Load()
    ' The real way to use App.Path
  AppPath = App.Path
  If Right(AppPath, 1) <> "\" Then _
    AppPath = AppPath & "\"
  
    ' Define the message
  strMessage = "Welcome to this demo!" & NL & _
                "Use this to make cool text-effects..." & NL & _
                "There is not much you can use this for..." & NL & _
                "I don't really know why I even did this..." & NL & _
                NL & _
                "Use as you wish," & NL & _
                "Mikael Nordfelth"
End Sub

Private Sub Form_Unload(Cancel As Integer)
    ' If there were more forms, then this would be neccessary...
  End
End Sub

Private Sub tmrNewText_Timer()  ' (Sounds are from ICQ... Hope it's legal...)
  On Error Resume Next
    ' Update message
  If lngLetterCount <= Len(strMessage) Then
    picMessage.Cls  ' Clear picturebox and reset CurrentX and CurrentY
    picMessage.Print Mid(strMessage, 1, lngLetterCount) ' Print what we want from the message
  End If
    ' Play fun sounds... =)
  If lngLetterCount > Len(strMessage) Then
    DoEvents  ' Gives Windows a chance to work with other stuff... (must-have in loops)
  ElseIf lngLetterCount = Len(strMessage) Then
    PlayWav AppPath & "Done.wav"  ' Bluing-sound
  Else
    If Asc(Mid(strMessage, lngLetterCount, 1)) = 13 Then  ' Enter
      PlayWav AppPath & "Enter.wav"
    ElseIf Asc(Mid(strMessage, lngLetterCount, 1)) = 32 Then  ' Space
      PlayWav AppPath & "Space.wav"
    Else  ' Other
      PlayWav AppPath & "Type.wav"  ' Click-sound
    End If
  End If
    ' Otherwise we won't write the next letter
  lngLetterCount = lngLetterCount + 1
  ' You can also make it type multiple messages, after each other... _
    but I just didn't feel like it this time...
End Sub