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)