home *** CD-ROM | disk | FTP | other *** search
- 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
- 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
-