formmain.frm

移动方块,类似于华容道

VERSION 5.00
Begin VB.Form Formmain 
   BackColor       =   &H00E0E0E0&
   Caption         =   "精彩100之VB__移动方块"
   ClientHeight    =   4995
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8580
   Icon            =   "Formmain.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   333
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   572
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdButton 
      BackColor       =   &H00E0E0E0&
      Caption         =   "cmdButton"
      Height          =   855
      Index           =   0
      Left            =   3915
      TabIndex        =   2
      Top             =   705
      Visible         =   0   'False
      Width           =   975
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   2970
      Top             =   1710
   End
   Begin VB.PictureBox PictureFrame 
      Align           =   4  'Align Right
      BackColor       =   &H8000000C&
      Height          =   4995
      Left            =   7080
      ScaleHeight     =   4935
      ScaleWidth      =   1440
      TabIndex        =   0
      Top             =   0
      Width           =   1500
      Begin VB.CommandButton cmdShuffle 
         Caption         =   "重新开始"
         Height          =   435
         Left            =   60
         TabIndex        =   3
         Top             =   3975
         Width           =   1335
      End
      Begin VB.CommandButton CommandExit 
         Caption         =   "退出"
         Height          =   435
         Left            =   60
         TabIndex        =   1
         Top             =   4440
         Width           =   1335
      End
      Begin VB.Label Label1 
         BackStyle       =   0  'Transparent
         Caption         =   "移动方块"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   24
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H0000FFFF&
         Height          =   2280
         Left            =   420
         TabIndex        =   4
         Top             =   540
         Width           =   660
      End
   End
End
Attribute VB_Name = "Formmain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'精彩100之VB源程序：
Private mbPuzzleSolved As Boolean
Private miEmptyIndex As Integer
Private mlTime As Long
Private Static Sub Form_Load()
  Dim i%
  Randomize
  For i = 1 To 15
    Load cmdButton(i)
  Next
  NewGame
  Shuffle
End Sub
Private Static Sub cmdButton_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  Dim i%, xEmpty%, yEmpty%, xClicked%, yClicked%
  xEmpty = (miEmptyIndex) Mod 4
  yEmpty = (miEmptyIndex) \ 4
  xClicked = (Index) Mod 4
  yClicked = (Index) \ 4
  '如果四周有空方块，就移动它
  If (xClicked = xEmpty + 1 And yClicked = yEmpty) Or _
    (xClicked = xEmpty - 1 And yClicked = yEmpty) Or _
    (yClicked = yEmpty + 1 And xClicked = xEmpty) Or _
    (yClicked = yEmpty - 1 And xClicked = xEmpty) Then
    ChangeButtons (Index)
  End If
  '判断是否成功完成
  For i = 0 To 14
    If Val(cmdButton(i).Caption) = i + 1 Then
      mbPuzzleSolved = True
    Else
      mbPuzzleSolved = False
      Exit For
    End If
  Next i
  If mbPuzzleSolved Then
    Timer1.Enabled = False
    mlTime = 0
    cmdShuffle.SetFocus
  End If
End Sub

Private Sub cmdShuffle_Click()
  NewGame
  Shuffle
End Sub

Private Sub Timer1_Timer()
  mlTime = mlTime + 1
End Sub

Private Static Sub NewGame()
  Dim i%, j%, iSide%
  mlTime = 0
  Timer1.Enabled = False
  mbPuzzleSolved = True
  iSide = Int((90 / 4)) * 2 + 10
  '隐藏按钮并设置按钮标号：
  For i = 0 To 15
    cmdButton(i).Visible = False
    cmdButton(i).Caption = i + 1
  Next i
  '放置按钮：
  For i = 0 To 3
    For j = 0 To 3
      cmdButton(i * 4 + j).Height = iSide
      cmdButton(i * 4 + j).Width = iSide
      cmdButton(i * 4 + j).Left = 120 + iSide * j
      cmdButton(i * 4 + j).Top = 50 + iSide * i
      cmdButton(i * 4 + j).Visible = True
    Next j
  Next i
  miEmptyIndex = 15
  cmdButton(miEmptyIndex).Visible = False
End Sub

Private Static Sub Shuffle()
  Dim bMove As Boolean
  Dim i%, xCoord%, yCoord%, iRand%
  xCoord = (miEmptyIndex) Mod 4
  yCoord = (miEmptyIndex) \ 4
  '随机放置按钮：
  i = 0
  While i < 16
    bMove = False
    iRand = Int(4 * Rnd)
    If (iRand = 0) And (xCoord > 0) Then
      xCoord = xCoord - 1
      bMove = True
    ElseIf (iRand = 1) And (xCoord < 3) Then
      xCoord = xCoord + 1
      bMove = True
    ElseIf (iRand = 2) And (yCoord > 0) Then
      yCoord = yCoord - 1
      bMove = True
    ElseIf (iRand = 3) And (yCoord < 3) Then
      yCoord = yCoord + 1
      bMove = True
    End If
    If bMove Then
      cmdButton(miEmptyIndex).Caption = cmdButton(4 * yCoord + xCoord).Caption
      miEmptyIndex = 4 * yCoord + xCoord
      i = i + 1
    End If
  Wend
  For i = 0 To 15
    cmdButton(i).Visible = True
  Next i
  cmdButton(miEmptyIndex).Visible = False
  mbPuzzleSolved = False
  Timer1.Enabled = True
End Sub
Private Sub ChangeButtons(Index As Integer)
  cmdButton(miEmptyIndex).Caption = cmdButton(Index).Caption
  cmdButton(miEmptyIndex).Visible = True
  cmdButton(miEmptyIndex).SetFocus
  miEmptyIndex = Index
  cmdButton(Index).Visible = False
  cmdButton(Index).Caption = ""
End Sub

Private Sub CommandExit_Click()
  End
End Sub