sihuapinban.frm

用VB写的四花拼板游戏源代码!它是一款仿微软小游戏

VERSION 5.00
Begin VB.Form SihuaPinban 
   AutoRedraw      =   -1  'True
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "四花拼板"
   ClientHeight    =   4440
   ClientLeft      =   4170
   ClientTop       =   2940
   ClientWidth     =   4410
   Icon            =   "SIHUAP~1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   4440
   ScaleWidth      =   4410
   Begin VB.PictureBox Picture1 
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      BackColor       =   &H00A2C3C3&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   735
      Left            =   10320
      ScaleHeight     =   735
      ScaleWidth      =   735
      TabIndex        =   0
      Top             =   5640
      Width           =   735
   End
   Begin VB.Image Image4 
      Height          =   4410
      Left            =   0
      Picture         =   "SIHUAP~1.frx":030A
      Stretch         =   -1  'True
      Top             =   0
      Visible         =   0   'False
      Width           =   4410
   End
   Begin VB.Image Image1 
      Height          =   135
      Index           =   1
      Left            =   10320
      Picture         =   "SIHUAP~1.frx":22BF
      Top             =   240
      Width           =   1350
   End
   Begin VB.Image Image5 
      Height          =   735
      Index           =   0
      Left            =   11160
      Top             =   1080
      Width           =   735
   End
   Begin VB.Image Image3 
      Height          =   735
      Left            =   10320
      Picture         =   "SIHUAP~1.frx":248E
      Top             =   1320
      Width           =   735
   End
   Begin VB.Image Image2 
      Height          =   735
      Left            =   10320
      Picture         =   "SIHUAP~1.frx":262A
      Top             =   480
      Width           =   2205
   End
   Begin VB.Image Image1 
      Height          =   135
      Index           =   0
      Left            =   10320
      Picture         =   "SIHUAP~1.frx":2958
      Top             =   0
      Width           =   1350
   End
   Begin VB.Menu Game 
      Caption         =   "游戏(&G)"
      Begin VB.Menu NewGame 
         Caption         =   "新游戏(&N)"
         Shortcut        =   ^N
      End
      Begin VB.Menu Separation1 
         Caption         =   "-"
      End
      Begin VB.Menu Arrange 
         Caption         =   "排列(&A)"
         Shortcut        =   ^A
      End
      Begin VB.Menu Hint 
         Caption         =   "提示(&H)"
         Shortcut        =   ^H
      End
      Begin VB.Menu Solve 
         Caption         =   "解答(&S)"
         Shortcut        =   ^S
      End
      Begin VB.Menu Separation2 
         Caption         =   "-"
      End
      Begin VB.Menu Exit 
         Caption         =   "退出(&E)"
         Shortcut        =   ^E
      End
   End
   Begin VB.Menu Options 
      Caption         =   "选项(&O)"
      Begin VB.Menu Size 
         Caption         =   "拼盘大小(&S)"
         Begin VB.Menu Extent 
            Caption         =   "&2×2"
            Index           =   0
         End
         Begin VB.Menu Extent 
            Caption         =   "&3×3"
            Index           =   1
         End
         Begin VB.Menu Extent 
            Caption         =   "&4×4"
            Checked         =   -1  'True
            Index           =   2
         End
         Begin VB.Menu Extent 
            Caption         =   "&5×5"
            Index           =   3
         End
         Begin VB.Menu Extent 
            Caption         =   "&6×6"
            Index           =   4
         End
      End
      Begin VB.Menu Digits 
         Caption         =   "拼板花色(&D)"
         Begin VB.Menu Maximum 
            Caption         =   "&6"
            Index           =   0
         End
         Begin VB.Menu Maximum 
            Caption         =   "&7"
            Index           =   1
         End
         Begin VB.Menu Maximum 
            Caption         =   "&8"
            Checked         =   -1  'True
            Index           =   2
         End
         Begin VB.Menu Maximum 
            Caption         =   "&9"
            Index           =   3
         End
         Begin VB.Menu Maximum 
            Caption         =   "&10"
            Index           =   4
         End
      End
      Begin VB.Menu Separation3 
         Caption         =   "-"
      End
      Begin VB.Menu Pattern 
         Caption         =   "水晶珠宝(&B)"
         Checked         =   -1  'True
         Index           =   0
      End
      Begin VB.Menu Pattern 
         Caption         =   "数字图案(&N)"
         Index           =   1
      End
   End
   Begin VB.Menu Help 
      Caption         =   "帮助(&H)"
   End
End
Attribute VB_Name = "SihuaPinban"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim sizableForm As Long  '窗口标题栏和菜单栏高度
Dim Scope As Long        '拼盘大小
Dim Max As Long          '拼板花色多少
Dim Design As Long       '拼板图案类型
Dim card() As Long       '拼板排列序号
Dim pin() As Long        '拼盘拼板记录
Dim remain As Long       '等待拼板数
Dim UpNum() As Long      '拼板上部数字
Dim DownNum() As Long    '拼板下部数字
Dim LeftNum() As Long    '拼板左部数字
Dim RightNum() As Long   '拼板右部数字
Dim locked() As Boolean  '拼板是否锁住
'获取鼠标位置函数(以窗体ScaleMode属性值为单位)
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'声明类型
Private Type POINTAPI
    X As Long
    Y As Long
End Type
Dim z As POINTAPI
Dim cx As Integer
Dim cy As Integer
Dim moveit As Boolean
Dim Sx As Long
Dim Sy As Long
'所谓剪切鼠标就是将鼠标指针限定到指定区域，在该区域内，鼠标能进行如单击、双击的动作。方法如下：
'声明API函数及类型:
Private Declare Function ClipCursorBynum& Lib "user32" Alias "ClipCursor" (ByVal lpRect As Long)
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function ClipCursor Lib "user32" (lpRect As RECT) As Long
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

'排列整齐拼板
Private Sub Arrange_Click()
Dim i As Long
Dim j As Long
Dim k As Long
Do
For i = 0 To remain
    j = Int(Rnd * (remain - i)) + i
    k = card(i)
    card(i) = card(j)
    card(j) = k
Next
'初始化或拼盘无拼板排列时不出现解题序列
If remain < Scope * Scope - 1 Then Exit Do
For i = 0 To Scope - 1
    For j = 0 To Scope - 2
        If RightNum(card(i * Scope + j)) <> LeftNum(card(i * Scope + j + 1)) Then Exit Do
    Next
Next
For i = 0 To Scope - 2
    For j = 0 To Scope - 1
        If DownNum(card(i * Scope + j)) <> UpNum(card(i * Scope + j + Scope)) Then Exit Do
    Next
Next
Loop
For i = 0 To remain
    Image5(card(i)).Move (i Mod Scope) * 52 * Sx + 20 * Sx + Scope * 49 * Sx, (i \ Scope) * 52 * Sy + 33 * Sy - Scope * 3 * Sy
Next
End Sub

'退出
Private Sub Exit_Click()
End
End Sub

'选择拼板大小
Private Sub Extent_Click(Index As Integer)
Extent(Scope - 2).Checked = False
Extent(Index).Checked = True
Scope = Index + 2
NewGame_Click
End Sub

'启动初始化
Private Sub Form_Load()
Dim i As Long
Show
SetControls
Randomize
Sx = Screen.TwipsPerPixelY
Sy = Screen.TwipsPerPixelY
'获取窗口标题栏和菜单栏高度
sizableForm = Height / Sy - Image4.Height / Sy
'让窗口宽度和image4宽度同步大小
Width = Image4.Width + 6 * Sx
Image4.Width = Width - 6 * Sx
For i = 1 To 35
    Load Image5(i)
Next
Scope = 4
Max = 7
NewGame_Click
End Sub

'显示帮助屏幕
Private Sub Help_Click()
Image4.Visible = True
Image4.ZOrder 0
Width = Image4.Width + 6 * Sx
Height = Image4.Height + sizableForm * Sy
Game.Enabled = False
Options.Enabled = False
Help.Enabled = False
End Sub

'提示
Private Sub Hint_Click()
Dim i As Long
Dim j As Long
Dim Back() As Long
If remain = -1 Then Solve.Enabled = False: Exit Sub
Do
    i = Int(Rnd * Scope * Scope)
    If pin(i) <> i Then
        If pin(i) > -1 Then
            Image5(pin(i)).Left = 20 * Sx + Scope * 49 * Sx
            If locked(pin(i)) Then
                Picture1.PaintPicture Image5(pin(i)), 0, 0
                Picture1.PaintPicture Image2, 16 * Sx, 16 * Sy, 17 * Sx, 17 * Sy, 65 * Sx, 16 * Sy, 17 * Sx, 17 * Sy
                Image5(pin(i)) = Picture1.Image
                locked(pin(i)) = False
            End If
            remain = remain + 1
            card(remain) = pin(i)
            pin(i) = -1
        Else
            ReDim Back(0)
            If i > Scope - 1 Then
                If pin(i - Scope) > -1 Then
                    If DownNum(pin(i - Scope)) <> UpNum(i) Then
                        ReDim Preserve Back(UBound(Back) + 1)
                        Back(UBound(Back)) = i - Scope
                    End If
                End If
            End If
            If i < Scope * Scope - Scope Then
                If pin(i + Scope) > -1 Then
                    If UpNum(pin(i + Scope)) <> DownNum(i) Then
                        ReDim Preserve Back(UBound(Back) + 1)
                        Back(UBound(Back)) = i + Scope
                    End If
                End If
            End If
            If i Mod Scope > 0 Then
                If pin(i - 1) > -1 Then
                    If RightNum(pin(i - 1)) <> LeftNum(i) Then
                        ReDim Preserve Back(UBound(Back) + 1)