frmmain.frm

品图游戏

VERSION 5.00
Object = "{27395F88-0C0C-101B-A3C9-08002B2F49FB}#1.1#0"; "Picclp32.ocx"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form frmMain 
   BackColor       =   &H00FFFFFF&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "拼图"
   ClientHeight    =   4440
   ClientLeft      =   150
   ClientTop       =   435
   ClientWidth     =   5130
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Picture         =   "frmMain.frx":030A
   ScaleHeight     =   296
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   342
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdShowRef 
      Caption         =   "显示参考图"
      Enabled         =   0   'False
      Height          =   375
      Left            =   3600
      TabIndex        =   2
      Top             =   3960
      Width           =   1335
   End
   Begin VB.TextBox txtStep 
      Height          =   375
      Left            =   600
      Locked          =   -1  'True
      TabIndex        =   0
      Top             =   3960
      Width           =   975
   End
   Begin PicClip.PictureClip PC 
      Left            =   2640
      Top             =   0
      _ExtentX        =   1058
      _ExtentY        =   979
      _Version        =   393216
   End
   Begin MSComDlg.CommonDialog CD 
      Left            =   2040
      Top             =   0
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Line Line1 
      X1              =   0
      X2              =   336
      Y1              =   256
      Y2              =   256
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "步数"
      Height          =   255
      Left            =   120
      TabIndex        =   1
      Top             =   4080
      Width           =   615
   End
   Begin VB.Image imgPT 
      Height          =   615
      Index           =   0
      Left            =   1320
      Stretch         =   -1  'True
      Top             =   0
      Width           =   615
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件"
      Begin VB.Menu mnuOpen 
         Caption         =   "打开图片"
      End
      Begin VB.Menu mnuBackColor 
         Caption         =   "背景颜色"
      End
      Begin VB.Menu mnuS 
         Caption         =   "-"
      End
      Begin VB.Menu mnuExit 
         Caption         =   "退出"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public Rows As Integer, Cols As Integer '图块的行列数
Const GAP As Integer = 2                '行列图块的间距
Private Arrange() As Integer            '图象控件与数组的对应关系
Private space As Integer                '空档的位置
Private started As Boolean              '是否已开始
Private steps As Integer                '步数
Public showref As Boolean               '是否显示参考图


Private Sub cmdShowRef_Click()
    showref = Not showref
    If showref Then
        Load frmRef
        frmRef.Image1.Picture = PC.Picture
        frmRef.Top = Me.Top
        frmRef.Left = Me.Left + Me.Width
        frmRef.Show
        cmdShowRef.Caption = "关闭参考图"
    Else
        Unload frmRef
        cmdShowRef.Caption = "显示参考图"
    End If
End Sub
'
'Private Sub Form_Click()
'    Dim i As Integer
'    For i = 0 To Rows * Cols - 3
'        Arrange(i) = i
'    Next
'    Arrange(Rows * Cols - 1) = Rows * Cols - 2
'    Arrange(Rows * Cols - 2) = Rows * Cols - 1
'    For i = 0 To Rows * Cols - 1
'        imgPT(i) = PC.GraphicCell(Arrange(i))
'    Next
'    imgPT(Rows * Cols - 2) = LoadPicture
'    space = Rows * Cols - 2
'
'End Sub

Private Sub Form_Unload(Cancel As Integer)
    Unload frmRef
End Sub

Private Sub imgPT_Click(Index As Integer)
    Dim r1 As Integer, c1 As Integer
    Dim r2 As Integer, c2 As Integer
    Dim n As Integer
    Dim i As Integer
    
    If Not started Then Exit Sub
    
    c1 = space Mod Cols         '计算空档的行列
    r1 = space \ Cols
    
    c2 = Index Mod Cols         '计算点击的行列
    r2 = Index \ Cols
    
    If Abs(c1 - c2) = 1 And Abs(r1 - r2) = 0 Or Abs(c1 - c2) = 0 And Abs(r1 - r2) = 1 Then      '判断是否相邻
        n = Arrange(Index)
        Arrange(Index) = Arrange(space)
        Arrange(space) = n
        imgPT(space) = PC.GraphicCell(Arrange(space))
        imgPT(Index) = LoadPicture()
        space = Index
        steps = steps + 1
        txtStep.Text = steps
        If isOK() Then
            MsgBox "恭喜，完成拼图！共用了" & steps & "步。", vbInformation          '判断是否拼完，如果已完成
            For i = 1 To Rows * Cols - 1
                imgPT(i).Enabled = False                                            '拼图完成时，使鼠标点击失效
            Next
        End If
    End If
End Sub

Private Sub mnuBackColor_Click()
    CD.Color = Me.BackColor
    CD.ShowColor
    Me.BackColor = CD.Color
    
End Sub

Private Sub mnuExit_Click()
    Unload Me
End Sub

Private Sub mnuOpen_Click()
    Dim i As Integer
    Dim n As Integer
    
    CD.Filter = "图片文件(*.JPG,*.BMP)|*.jpg;*.bmp"
    CD.DialogTitle = "打开图片"
    CD.InitDir = App.Path & "\pics"
    CD.ShowOpen                                 '显示指定图片对话框
    If CD.FileName = "" Then Exit Sub
    
    
    If started Then
        For i = 1 To Rows * Cols - 1    '清除已有的控件数组元素
            Unload imgPT(i)
        Next
        imgPT(0).Picture = LoadPicture()
        If showref Then frmRef.Image1.Picture = LoadPicture()
    Else
        Me.Picture = LoadPicture()
        
    End If
    
    frmDivide.Show 1, Me                ' 显示指定行列对话框
    PC.Picture = LoadPicture(CD.FileName)
    PC.Rows = Rows
    PC.Cols = Cols
    
    n = Rows * Cols
    imgPT(0).Width = 320 / Cols         '窗体以像素为单位
    imgPT(0).Height = 240 / Rows
    
    Call Rnd_Arrange                     '随机排列

    For i = 0 To n - 1          '排列图象控件
        imgPT(i).Top = (i \ Cols) * (240 / Rows + GAP)
        imgPT(i).Left = (i Mod Cols) * (320 / Cols + GAP)
        imgPT(i).Visible = True
    Next
    
    If showref Then frmRef.Image1.Picture = PC.Picture
    
    started = True
    cmdShowRef.Enabled = True
    steps = 0
    txtStep.Text = "0"
End Sub


Private Sub Rnd_Arrange()           '随机排列图块
    Dim i As Integer, j As Integer
    Dim n As Integer
    n = Rows * Cols
    
    ReDim Arrange(0 To n - 1)
    For i = 0 To n - 1
        Arrange(i) = -1             '用-1标记未赋值的元素
    Next
    
    i = 0
    Do                              '给数组Arrange随机赋值
        j = Int(Rnd * n)             '产生0～n-1的随机数
        If Arrange(j) = -1 Then
            Arrange(j) = i
            i = i + 1
            If i = n Then Exit Do
        End If
    Loop
    
    For i = 1 To n - 1              '加载控件数组元素
        Load imgPT(i)
    Next
    
    For i = 0 To n - 1
        If Arrange(i) <> n - 1 Then
            imgPT(i).Picture = PC.GraphicCell(Arrange(i))  '将图块赋给控件数组元素
        Else
            imgPT(i).Picture = LoadPicture()            '将“打乱”前图片右下角的图块设为空
            space = i
        End If
    Next
End Sub

Private Function isOK() As Boolean          '判断是否拼完
    Dim i As Integer
    For i = 0 To Cols * Rows - 1
        If Arrange(i) <> i Then Exit For
    Next
    If i = Cols * Rows Then isOK = True
End Function