home *** CD-ROM | disk | FTP | other *** search
VERSION 5.00 Begin VB.Form frmHangman AutoRedraw = -1 'True BackColor = &H80000004& BorderStyle = 3 'Fixed Dialog Caption = " Hangman" ClientHeight = 4680 ClientLeft = 4350 ClientTop = 3315 ClientWidth = 4155 ForeColor = &H00000000& Icon = "Hangman.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 4680 ScaleWidth = 4155 ShowInTaskbar = 0 'False StartUpPosition = 2 'CenterScreen Begin VB.TextBox GamesLost BackColor = &H80000004& Height = 285 Left = 2280 TabIndex = 32 Top = 4305 Width = 1695 End Begin VB.TextBox GamesWon BackColor = &H80000004& Height = 270 Left = 480 TabIndex = 31 Top = 4320 Width = 1695 End Begin VB.PictureBox picLogo AutoRedraw = -1 'True BorderStyle = 0 'None BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H8000000E& Height = 9375 Left = 0 ScaleHeight = 9375 ScaleWidth = 255 TabIndex = 30 Top = -15 Width = 255 End Begin VB.Frame Frame1 Height = 615 Left = 480 TabIndex = 0 Top = 2940 Width = 3495 Begin VB.Label txtWord Alignment = 2 'Center BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00000000& Height = 285 Left = 135 TabIndex = 2 Top = 225 Width = 3225 End End Begin VB.Frame Frame3 ClipControls = 0 'False Height = 2910 Left = 480 TabIndex = 1 Top = 15 Width = 3495 Begin VB.Shape Head BorderColor = &H00C00000& BorderWidth = 2 FillColor = &H0080C0FF& FillStyle = 0 'Solid Height = 600 Left = 1620 Shape = 2 'Oval Top = 525 Visible = 0 'False Width = 555 End Begin VB.Line RArm BorderColor = &H00C00000& BorderWidth = 6 Visible = 0 'False X1 = 1365 X2 = 1650 Y1 = 1335 Y2 = 1335 End Begin VB.Line LArm BorderColor = &H00C00000& BorderWidth = 6 Visible = 0 'False X1 = 2145 X2 = 2475 Y1 = 1335 Y2 = 1335 End Begin VB.Line HangVer BorderColor = &H00000080& BorderWidth = 6 Visible = 0 'False X1 = 675 X2 = 675 Y1 = 2595 Y2 = 390 End Begin VB.Line HangHor BorderColor = &H00000080& BorderWidth = 6 Visible = 0 'False X1 = 690 X2 = 1905 Y1 = 330 Y2 = 330 End Begin VB.Line Rope BorderColor = &H00800000& BorderWidth = 3 Visible = 0 'False X1 = 1890 X2 = 1890 Y1 = 300 Y2 = 480 End Begin VB.Line HangAng BorderColor = &H00000080& BorderWidth = 8 Visible = 0 'False X1 = 1050 X2 = 690 Y1 = 360 Y2 = 720 End Begin VB.Line HangBase BorderColor = &H00000080& BorderWidth = 6 Visible = 0 'False X1 = 330 X2 = 1050 Y1 = 2625 Y2 = 2625 End Begin VB.Line RLeg BorderColor = &H00C00000& BorderWidth = 8 Visible = 0 'False X1 = 1785 X2 = 1605 Y1 = 2025 Y2 = 2400 End Begin VB.Line LLeg BorderColor = &H00C00000& BorderWidth = 8 Visible = 0 'False X1 = 2025 X2 = 2220 Y1 = 2025 Y2 = 2415 End Begin VB.Line Body BorderColor = &H00C00000& BorderStyle = 6 'Inside Solid BorderWidth = 26 Visible = 0 'False X1 = 1905 X2 = 1905 Y1 = 1335 Y2 = 1785 End End Begin VB.Frame Frame2 Height = 735 Left = 480 TabIndex = 3 Top = 3540 Width = 3495 Begin VB.Label lblLetter Alignment = 2 'Center Caption = "Z" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Index = 25 Left = 2880 TabIndex = 29 Top = 450 Width = 195 End Begin VB.Label lblLetter Alignment = 2 'Center Caption = "Y" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Index = 24 Left = 2655 TabIndex = 28 Top = 450 Width = 195 End Begin VB.Label lblLetter Alignment = 2 'Center Caption = "X" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Index = 23 Left = 2430 TabIndex = 27 Top = 450 Width = 195 End Begin VB.Label lblLetter Alignment = 2 'Center Caption = "W" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Index = 22 Left = 2205 TabIndex = 26 Top = 450 Width = 195 End Begin VB.Label lblLetter Alignment = 2 'Center Caption = "V" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Index = 21 Left = 1980 TabIndex = 25 Top = 450 Width = 195 End Begin VB.Label lblLetter Alignment = 2 'Center Caption = "U" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Index = 20 Left = 1800 TabIndex = 24 Top = 450 Width = 195 End Begin VB.Label lblLetter Alignment = 2 'Center Caption = "T" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Index = 19 Left = 1575 TabIndex = 23 Top = 450 Width = 195 End Begin VB.Label lblLetter Alignment = 2 'Center Caption = "S" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Index = 18 Left = 1350 TabIndex = 22 Top = 450 Width = 195 End Begin VB.Label lblLetter Alignment = 2 'Center Caption = "R" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Index = 17 Left = 1125 TabIndex = 21 Top = 450 Width = 195 End Begin VB.Label lblLetter Alignment = 2 'Center Caption = "Q" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Index = 16 Left = 900 TabIndex = 20 Top = 450 Width = 195 End Begin VB.Label lblLetter Alignment = 2 'Center Caption = "P" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Index = 15 Left = 675 TabIndex = 19 Top = 450 Width = 195 End Begin VB.Label lblLetter Alignment = 2 'Center Caption = "O" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Index = 14 Left = 450 TabIndex = 18 Top = 450 Width = 195 End Begin VB.Label lblLetter Alignment = 2 'Center Caption = "N" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Index = 13 Left = 225 TabIndex = 17 Top = 450 Width = 195 End Begin VB.Label lblLetter Alignment = 2 'Center Caption = "M" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Index = 12 Left = 2880 TabIndex = 16 Top = 165 Width = 195 End Begin VB.Label lblLetter Alignment = 2 'Center Caption = "L" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Index = 11 Left = 2655 TabIndex = 15 Top = 180 Width = 195 End Begin VB.Label lblLetter Alignment = 2 'Center Caption = "K" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Index = 10 Left = 2430 TabIndex = 14 Top = 180 Width = 195 End Begin VB.Label lblLetter Alignment = 2 'Center Caption = "J" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Index = 9 Left = 2205 TabIndex = 13 Top = 180 Width = 195 End Begin VB.Label lblLetter Alignment = 2 'Center Caption = "I" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Index = 8 Left = 1980 TabIndex = 12 Top = 180 Width = 195 End Begin VB.Label lblLetter Alignment = 2 'Center Caption = "H" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Index = 7 Left = 1800 TabIndex = 11 Top = 180 Width = 195 End Begin VB.Label lblLetter Alignment = 2 'Center Caption = "G" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Index = 6 Left = 1575 TabIndex = 10 Top = 180 Width = 195 End Begin VB.Label lblLetter Alignment = 2 'Center Caption = "F" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Index = 5 Left = 1350 TabIndex = 9 Top = 180 Width = 195 End Begin VB.Label lblLetter Alignment = 2 'Center Caption = "E" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Index = 4 Left = 1125 TabIndex = 8 Top = 180 Width = 195 End Begin VB.Label lblLetter Alignment = 2 'Center Caption = "D" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Index = 3 Left = 900 TabIndex = 7 Top = 180 Width = 195 End Begin VB.Label lblLetter Alignment = 2 'Center Caption = "C" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Index = 2 Left = 675 TabIndex = 6 Top = 180 Width = 195 End Begin VB.Label lblLetter Alignment = 2 'Center Caption = "B" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Index = 1 Left = 450 TabIndex = 5 Top = 180 Width = 195 End Begin VB.Label lblLetter Alignment = 2 'Center Caption = "A" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Index = 0 Left = 225 TabIndex = 4 Top = 180 Width = 195 End End Begin VB.Menu mnuFile Caption = "&File" Begin VB.Menu mnuNew Caption = "&New Game" Enabled = 0 'False Shortcut = {F2} Visible = 0 'False End Begin VB.Menu mnuLine Caption = "-" Visible = 0 'False End Begin VB.Menu mnuExit Caption = "E&xit" End End Begin VB.Menu mnuHelp Caption = "&Help" Begin VB.Menu mnuSound Caption = "&Sound" Checked = -1 'True End Begin VB.Menu mnuInst Caption = "&Instrustions" End Begin VB.Menu mnuAbout Caption = "&About" End End Attribute VB_Name = "frmHangman" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim iNumOfWords As Integer Dim sWords() As String Dim sWord As String Dim bGameStarted As Boolean Dim iGameStage As Integer Dim iResponse As Integer Dim iGamesWon As Integer Dim iGamesLost As Integer Dim LongGame As Integer Dim cL As New cLogo Private Sub Form_Load() cL.DrawingObject = picLogo cL.Caption = "Dennis Hallman" Call subLoadFile Call subNewGame End Sub Private Sub Form_Resize() On Error Resume Next picLogo.Height = Me.ScaleHeight On Error GoTo 0 cL.Draw End Sub Private Sub Form_Unload(Cancel As Integer) End End Sub Private Sub lblLetter_Click(Index As Integer) Call subChooseLetter(Index) End Sub Private Sub mnuAbout_Click() About.Show vbModal, Me End Sub Private Sub mnuExit_Click() Unload Me End Sub Private Sub mnuSound_Click() mnuSound.Checked = Not mnuSound.Checked End Sub Private Sub mnuInst_Click() HelpPage.Show vbModal End Sub Private Sub mnuNew_Click() If mnuNew.Enabled = True Then Call subNewGame End If End Sub Private Sub subNewGame() Dim i As Integer Dim ctr As Integer On Error GoTo Produce_Error '######################## HangBase.Visible = False HangVer.Visible = False HangHor.Visible = False HangAng.Visible = False '######################## Rope.Visible = False Head.Visible = False Body.Visible = False LLeg.Visible = False RLeg.Visible = False LArm.Visible = False RArm.Visible = False txtWord.ForeColor = &H0& bGameStarted = False iGameStage = 0 mnuNew.Enabled = False '######################## For i = 0 To 25 lblLetter(i).Visible = True Next i Randomize ctr = 0 GetWord: i = Int(((iNumOfWords + 1) * Rnd) + 0) ctr = ctr + 1 If ctr > iNumOfWords Then iResponse = MsgBox("You have completed all the words, sorry!", vbOKOnly + vbExclamation, frmHangman.Caption) Exit Sub End If If sWords(i, 1) = "" Then sWord = sWords(i, 0) sWords(i, 1) = "x" Else GoTo GetWord End If txtWord.Caption = "" i = Len(Trim(sWord)) For ctr = 1 To i txtWord.ForeColor = &H6F& txtWord.Caption = txtWord.Caption & "_ " Next ctr bGameStarted = True Exit Sub Produce_Error: iResponse = MsgBox("Error Number " & Err.Number & " - " & Err.Description & ".", vbOKOnly + vbExclamation, frmHangman.Caption) End Sub Private Sub subChooseLetter(Index) Dim sLetter As String Dim DummyWord As String Dim i As Integer On Error GoTo Produce_Error If lblLetter(Index).Visible = True And bGameStarted Then lblLetter(Index).Visible = False If mnuSound.Checked Then PlaySound App.Path & "\Choose.wav" sLetter = lblLetter(Index).Caption If InStr(1, sWord, sLetter, 1) <> 0 Then DummyWord = txtWord.Caption For i = 1 To Len(sWord) If UCase(Mid(sWord, i, 1)) = sLetter Then txtWord.ForeColor = &H6F& Mid(DummyWord, (i * 2 - 1), 1) = sLetter End If Next i txtWord.Caption = DummyWord If InStr(1, DummyWord, "_") = 0 Then iResponse = MsgBox("You win!!", vbOKOnly + vbInformation, frmHangman.Caption) iGamesWon = iGamesWon + 1 GamesWon.Text = "Games Won: " & iGamesWon GamesLost.Text = "Games Lost: " & iGamesLost bGameStarted = False mnuNew.Enabled = True Call subNewGame End If Else Select Case iGameStage '########################### Case 0 HangBase.Visible = True iGameStage = 1 Case 1 HangVer.Visible = True iGameStage = 2 Case 2 HangHor.Visible = True iGameStage = 3 Case 3 HangAng.Visible = True iGameStage = 4 '########################### Case 4 Rope.Visible = True iGameStage = 5 Case 5 Head.Visible = True iGameStage = 6 Case 6 Body.Visible = True iGameStage = 7 Case 7 LLeg.Visible = True iGameStage = 8 Case 8 RLeg.Visible = True iGameStage = 9 Case 9 LArm.Visible = True iGameStage = 10 Case 10 RArm.Visible = True iGameStage = 11 For i = 1 To Len(sWord) DummyWord = DummyWord & UCase(Mid(sWord, i, 1)) & " " Next i txtWord.Caption = DummyWord txtWord.ForeColor = &HFF& iResponse = MsgBox("You lose!", vbOKOnly + vbInformation, frmHangman.Caption) iGamesLost = iGamesLost + 1 GamesWon.Text = "Games Won: " & iGamesWon GamesLost.Text = "Games Lost: " & iGamesLost bGameStarted = False mnuNew.Enabled = True Call subNewGame End Select End If End If Exit Sub Produce_Error: iResponse = MsgBox("Error Number " & Err.Number & " - " & Err.Description & ".", vbOKOnly + vbExclamation, frmHangman.Caption) End Sub Private Sub subLoadFile() Dim iFileNum As Integer Dim i As Integer Dim sString As String On Error GoTo Produce_Error bGameStarted = False iFileNum = FreeFile() Open App.Path & "\words.txt" For Input As #iFileNum i = 0 While Not EOF(iFileNum) Input #iFileNum, sString i = i + 1 Wend iNumOfWords = i ReDim sWords(iNumOfWords, 2) Close #iFileNum iFileNum = FreeFile() Open App.Path & "\words.txt" For Input As #iFileNum i = 0 While Not EOF(iFileNum) Input #iFileNum, sWords(i, 0) i = i + 1 Wend Close #iFileNum GamesWon.Text = "Games Won: " & iGamesWon GamesLost.Text = "Games Lost: " & iGamesLost Exit Sub Produce_Error: If Err.Number = 53 Then iResponse = MsgBox("Cannot find the file words.hmf, which contains the words for this game. It should be in the same directory as the Hangman.exe.", vbOKOnly + vbExclamation, frmHangman.Caption) Else iResponse = MsgBox("Error Number " & Err.Number & " - " & Err.Description & ".", vbOKOnly + vbExclamation, frmHangman.Caption) End If End Sub Private Sub PlaySound(strSound As String) 'If mnuSound.Checked Then PlaySound App.Path & "\BallLaunch.wav" sndPlaySound strSound, SND_ASYNC Or SND_NODEFAULT End Sub 
(.txt)