home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / ctlpuz_1 / ctlpuzzl.ctl < prev    next >
Encoding:
Text File  |  1998-05-29  |  8.9 KB  |  331 lines
  1. VERSION 5.00
  2. Begin VB.UserControl ctlPuzzle 
  3.    BackColor       =   &H00C0FFFF&
  4.    ClientHeight    =   5130
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   4125
  8.    ScaleHeight     =   342
  9.    ScaleMode       =   3  'Pixel
  10.    ScaleWidth      =   275
  11.    Begin VB.Timer Timer1 
  12.       Interval        =   1000
  13.       Left            =   1800
  14.       Top             =   3240
  15.    End
  16.    Begin VB.CommandButton cmdShuffle 
  17.       Caption         =   "cmdShuffle"
  18.       Height          =   495
  19.       Left            =   2400
  20.       TabIndex        =   0
  21.       Top             =   4320
  22.       Width           =   1215
  23.    End
  24.    Begin VB.ComboBox cmbSize 
  25.       Height          =   315
  26.       Left            =   600
  27.       TabIndex        =   1
  28.       Text            =   "cmbSize"
  29.       Top             =   4440
  30.       Width           =   1215
  31.    End
  32.    Begin VB.CommandButton cmdButton 
  33.       Caption         =   "cmdButton"
  34.       Height          =   495
  35.       Index           =   0
  36.       Left            =   1440
  37.       TabIndex        =   2
  38.       Top             =   1920
  39.       Width           =   1215
  40.    End
  41.    Begin VB.Label lblTime 
  42.       BackStyle       =   0  'Transparent
  43.       Caption         =   "lblTime"
  44.       Height          =   255
  45.       Left            =   1800
  46.       TabIndex        =   3
  47.       Top             =   120
  48.       Width           =   1095
  49.    End
  50. End
  51. Attribute VB_Name = "ctlPuzzle"
  52. Attribute VB_GlobalNameSpace = False
  53. Attribute VB_Creatable = True
  54. Attribute VB_PredeclaredId = False
  55. Attribute VB_Exposed = True
  56. '-------------------------------------------------------------------------
  57. 'Author:    Anders Fransson
  58. 'Email:     anders.fransson@home.se
  59. 'Internet:  http://hem1.passagen.se/fylke
  60. 'Date:      97-12-09
  61. '-------------------------------------------------------------------------
  62.  
  63. Option Explicit
  64.  
  65. Private m_bPuzzleSolved As Boolean
  66. Private m_iEmptyIndex As Integer
  67. Private m_iSize As Integer
  68. Private m_lTime As Long
  69.  
  70. Private Const MIN_SIZE As Byte = 3
  71. Private Const MAX_SIZE As Byte = 7
  72.  
  73. 'Text constants
  74. Private Const TEXT_SHUFFLE As String = "Shuffle"
  75. Private Const TEXT_NEW_GAME As String = "New Game"
  76. Private Const TEXT_TIME As String = "Time:"
  77. Private Const TEXT_PUZZLE As String = "Puzzle"
  78. Private Const TEXT_HIGH_SCORE As String = "High score"
  79. Private Const TEXT_SIZE As String = "Size"
  80. Private Const TEXT_TIME_S As String = "Time"
  81. Private Const TEXT_PLAYER As String = "Player"
  82. Private Const TEXT_INPUT_PLAYER As String = "Write your name!"
  83. Private Const TEXT_ANDERS_GAMES As String = "Anders Franssons Made In Home Games"
  84.  
  85. Private Static Sub cmdButton_MouseDown(Index As Integer, Button As Integer, _
  86.     Shift As Integer, X As Single, Y As Single)
  87.     
  88.     Dim i%, xEmpty%, yEmpty%, xClicked%, yClicked%
  89.     
  90.     'Calculate coordinates for buttons
  91.     xEmpty = (m_iEmptyIndex) Mod m_iSize
  92.     yEmpty = (m_iEmptyIndex) \ m_iSize
  93.     xClicked = (Index) Mod m_iSize
  94.     yClicked = (Index) \ m_iSize
  95.     
  96.     'Change buttons if empty is near
  97.     If (xClicked = xEmpty + 1 And yClicked = yEmpty) Or _
  98.         (xClicked = xEmpty - 1 And yClicked = yEmpty) Or _
  99.         (yClicked = yEmpty + 1 And xClicked = xEmpty) Or _
  100.         (yClicked = yEmpty - 1 And xClicked = xEmpty) Then
  101.         ChangeButtons (Index)
  102.         PlaySound App.Path & "\Move.wav"
  103.     End If
  104.  
  105.     'Check if puzzle's solved
  106.     For i = 0 To m_iSize ^ 2 - 2
  107.         If Val(cmdButton(i).Caption) = i + 1 Then
  108.             m_bPuzzleSolved = True
  109.         Else
  110.             m_bPuzzleSolved = False
  111.             Exit For
  112.         End If
  113.     Next i
  114.     
  115.     If m_bPuzzleSolved Then
  116.         If Timer1.Enabled Then PlaySound App.Path & "\Applause.wav"
  117.         Timer1.Enabled = False
  118.         WriteHighScore
  119.         m_lTime = 0
  120.         cmdShuffle.Caption = TEXT_SHUFFLE
  121.         cmdShuffle.SetFocus
  122.     Else
  123.         cmdShuffle.Caption = TEXT_NEW_GAME
  124.     End If
  125.  
  126. End Sub
  127.  
  128. Private Sub cmdShuffle_Click()
  129.  
  130.     If m_bPuzzleSolved Then
  131.         Shuffle
  132.     Else
  133.         NewGame
  134.     End If
  135.     PlaySound App.Path & "\Shuffle.wav"
  136.  
  137. End Sub
  138.  
  139. Private Sub cmbSize_Click()
  140.     
  141.     If cmbSize.Text = "High Score" Then
  142.         CheckHighScore
  143.         Exit Sub
  144.     End If
  145.     
  146.     If Not (m_iSize = cmbSize.Text) Then
  147.         m_iSize = cmbSize.Text
  148.         NewGame
  149.     End If
  150.     
  151. End Sub
  152.  
  153. Private Sub Timer1_Timer()
  154.  
  155.     m_lTime = m_lTime + 1
  156.     lblTime.Caption = TEXT_TIME & " " & m_lTime & " s"
  157.  
  158. End Sub
  159.  
  160. Private Static Sub NewGame()
  161.     
  162.     Dim i%, j%, iSide%
  163.     
  164.     lblTime = ""
  165.     m_lTime = 0
  166.     Timer1.Enabled = False
  167.     m_bPuzzleSolved = True
  168.     iSide = Int((90 / m_iSize)) * 2 + 10
  169.     
  170.     'Hide butons and set caption
  171.     For i = 0 To MAX_SIZE ^ 2 - 1
  172.         cmdButton(i).Visible = False
  173.         cmdButton(i).Caption = i + 1
  174.     Next i
  175.     
  176.     'Place buttons
  177.     For i = 0 To m_iSize - 1
  178.         For j = 0 To m_iSize - 1
  179.             cmdButton(i * m_iSize + j).Height = iSide
  180.             cmdButton(i * m_iSize + j).Width = iSide
  181.             cmdButton(i * m_iSize + j).Left = iSide / 2 + iSide * j
  182.             cmdButton(i * m_iSize + j).Top = 10 + iSide / 2 + iSide * i
  183.             cmdButton(i * m_iSize + j).Visible = True
  184.         Next j
  185.     Next i
  186.     
  187.     m_iEmptyIndex = m_iSize ^ 2 - 1
  188.     cmdButton(m_iEmptyIndex).Visible = False
  189.     cmdShuffle.Caption = TEXT_SHUFFLE
  190.  
  191. End Sub
  192.  
  193. Private Static Sub Shuffle()
  194.  
  195.     Dim bMove As Boolean
  196.     Dim i%, xCoord%, yCoord%, iRand%
  197.     
  198.     'Hide buttons before shuffle
  199.     For i = 0 To m_iSize ^ 2 - 1
  200.         cmdButton(i).Visible = False
  201.     Next i
  202.     
  203.     'Coordinates for empty button
  204.     xCoord = (m_iEmptyIndex) Mod m_iSize
  205.     yCoord = (m_iEmptyIndex) \ m_iSize
  206.     
  207.     'Move buttons in random directions
  208.     i = 0
  209.     While i < m_iSize ^ 4
  210.         bMove = False
  211.         iRand = Int(4 * Rnd)
  212.         If (iRand = 0) And (xCoord > 0) Then
  213.             xCoord = xCoord - 1
  214.             bMove = True
  215.         ElseIf (iRand = 1) And (xCoord < m_iSize - 1) Then
  216.             xCoord = xCoord + 1
  217.             bMove = True
  218.         ElseIf (iRand = 2) And (yCoord > 0) Then
  219.             yCoord = yCoord - 1
  220.             bMove = True
  221.         ElseIf (iRand = 3) And (yCoord < m_iSize - 1) Then
  222.             yCoord = yCoord + 1
  223.             bMove = True
  224.         End If
  225.         If bMove Then
  226.             cmdButton(m_iEmptyIndex).Caption = _
  227.             cmdButton(m_iSize * yCoord + xCoord).Caption
  228.             m_iEmptyIndex = m_iSize * yCoord + xCoord
  229.             i = i + 1
  230.         End If
  231.     Wend
  232.        
  233.     For i = 0 To m_iSize ^ 2 - 1
  234.         cmdButton(i).Visible = True
  235.     Next i
  236.     
  237.     cmdShuffle.Caption = TEXT_NEW_GAME
  238.     cmdButton(m_iEmptyIndex).Visible = False
  239.     m_bPuzzleSolved = False
  240.     Timer1.Enabled = True
  241.     
  242. End Sub
  243.  
  244. Private Sub ChangeButtons(Index As Integer)
  245.     
  246.     'Change caption and visibility of clicked and empty button
  247.     cmdButton(m_iEmptyIndex).Caption = cmdButton(Index).Caption
  248.     cmdButton(m_iEmptyIndex).Visible = True
  249.     cmdButton(m_iEmptyIndex).SetFocus
  250.     m_iEmptyIndex = Index
  251.     cmdButton(Index).Visible = False
  252.     cmdButton(Index).Caption = ""
  253.  
  254. End Sub
  255.  
  256. Private Sub UserControl_Initialize()
  257.  
  258.     Dim i%
  259.     
  260.     'Initialize random number generator
  261.     Randomize
  262.    
  263.     'Load buttons
  264.     For i = 1 To MAX_SIZE ^ 2 - 1
  265.         Load cmdButton(i)
  266.     Next i
  267.     
  268.     'Add combo box items
  269.     For i = MIN_SIZE To MAX_SIZE
  270.         cmbSize.AddItem i
  271.     Next i
  272.     cmbSize.AddItem "High Score"
  273.     
  274.     'Auto click in combo
  275.     cmbSize.ListIndex = 1
  276.     m_iSize = cmbSize.Text
  277.  
  278. End Sub
  279.  
  280. Private Static Sub CheckHighScore()
  281.  
  282.     Dim strHighScore As String
  283.     Dim i%
  284.     
  285.     strHighScore = TEXT_SIZE & Chr(9) & TEXT_TIME_S & Chr(9) & TEXT_PLAYER & _
  286.         Chr(10) & Chr(13) & Chr(13)
  287.     
  288.     'Get high score from registry
  289.     For i = MIN_SIZE To MAX_SIZE
  290.         strHighScore = strHighScore & i & Chr(9) & _
  291.             GetSetting(TEXT_ANDERS_GAMES, TEXT_PUZZLE, i, "-") & Chr(9) & _
  292.             GetSetting(TEXT_ANDERS_GAMES, TEXT_PUZZLE, TEXT_PLAYER & i, "-") & _
  293.             Chr(10) & Chr(13)
  294.     Next
  295.  
  296.     'Show high score in msgbox
  297.     MsgBox strHighScore, vbOKOnly, TEXT_HIGH_SCORE
  298.  
  299. End Sub
  300.  
  301. Private Sub WriteHighScore()
  302.      
  303.     'If input fault
  304.     On Error GoTo Errorhandler
  305.        
  306.     'Write high score to registry
  307.     If m_lTime > 0 And m_lTime < GetSetting(TEXT_ANDERS_GAMES, TEXT_PUZZLE, m_iSize, 9999) Then
  308.         SaveSetting TEXT_ANDERS_GAMES, TEXT_PUZZLE, m_iSize, m_lTime
  309.         SaveSetting TEXT_ANDERS_GAMES, TEXT_PUZZLE, TEXT_PLAYER & m_iSize, _
  310.             Left(Trim(InputBox(TEXT_INPUT_PLAYER, TEXT_HIGH_SCORE)), 20)
  311.     End If
  312.  
  313.     Exit Sub
  314.     
  315. 'If input fault
  316. Errorhandler:
  317.     Resume
  318.  
  319. End Sub
  320.  
  321. Private Sub PlaySound(strSound As String)
  322.  
  323.     Dim wFlags%
  324.     
  325.     wFlags% = SND_ASYNC Or SND_NODEFAULT
  326.     sndPlaySound strSound, wFlags%
  327.  
  328. End Sub
  329.  
  330.  
  331.