sihuapinban.frm

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

                        Back(UBound(Back)) = i - 1
                    End If
                End If
            End If
            If i Mod Scope < Scope - 1 Then
                If pin(i + 1) > -1 Then
                    If LeftNum(pin(i + 1)) <> RightNum(i) Then
                        ReDim Preserve Back(UBound(Back) + 1)
                        Back(UBound(Back)) = i + 1
                    End If
                End If
            End If
            If UBound(Back) = 0 Then
                For j = 0 To Scope * Scope - 1
                    If pin(j) = i Then Back(0) = j: Exit For
                Next
                If j < Scope * Scope Then
                    Image5(i).Left = 20 * Sx + Scope * 49 * Sx
                    If locked(i) Then
                        Picture1.PaintPicture Image5(i), 0, 0
                        Picture1.PaintPicture Image2, 16 * Sx, 16 * Sy, 17 * Sx, 17 * Sy, 65 * Sx, 16 * Sy, 17 * Sx, 17 * Sy
                        Image5(i) = Picture1.Image
                        locked(i) = False
                    End If
                    remain = remain + 1
                    card(remain) = i
                    pin(Back(0)) = -1
                Else
                    Image5(i).Move (i Mod Scope) * 49 * Sx + 10 * Sx, (i \ Scope) * 49 * Sy + 30 * Sy
                    pin(i) = i
                    For j = 0 To remain
                        If card(j) = i Then
                            card(j) = card(remain)
                            Exit For
                        End If
                    Next
                    remain = remain - 1
                    Picture1.PaintPicture Image5(i), 0, 0
                    Picture1.PaintPicture Image2, 16 * Sx, 16 * Sy, 17 * Sx, 17 * Sy, 114 * Sx, 16 * Sy, 17 * Sx, 17 * Sy
                    Image5(i) = Picture1.Image
                    locked(i) = True
                End If
            Else
                j = Int(Rnd * UBound(Back)) + 1
                j = Back(j)
                Image5(pin(j)).Left = 20 * Sx + Scope * 49 * Sx
                If locked(pin(j)) Then
                    Picture1.PaintPicture Image5(pin(j)), 0, 0
                    Picture1.PaintPicture Image2, 16 * Sx, 16 * Sy, 17 * Sx, 17 * Sy, 65 * Sx, 16 * Sy, 17 * Sx, 17 * Sy
                    Image5(pin(j)) = Picture1.Image
                    locked(pin(j)) = False
                End If
                remain = remain + 1
                card(remain) = pin(j)
                pin(j) = -1
            End If
        End If
        Exit Sub
    End If
Loop
End Sub

'返回拼板屏幕
Private Sub Image4_Click()
Image4.Visible = False
Game.Enabled = True
Options.Enabled = True
Help.Enabled = True
Width = Scope * 52 * Sx + 32 * Sx + Scope * 49 * Sx
Height = Scope * 49 * Sy + 39 * Sy + sizableForm * Sy
End Sub

'开始移动拼板
Private Sub Image5_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim dx As Long
Dim dy As Long
Dim cc As RECT
Dim dd As RECT
'如果移动已开始则退出
If moveit = True Then Exit Sub
'移动开始
moveit = True
cx = X
cy = Y - 3 * Sy
'剪切鼠标 (将鼠标指针限定到窗体Form1内拼板移动区域):
GetWindowRect hwnd, cc
dd.Bottom = cc.Bottom + 1 + cy / Sy - 49
dd.Left = cc.Left + 3 + cx / Sx
dd.Right = cc.Right - 2 + cx / Sx - 49
dd.Top = cc.Top - 2 + cy / Sy + sizableForm
ClipCursor dd
If Image5(Index).Left <= 10 * Sx + (Scope - 1) * 49 * Sx Then
    dx = (Image5(Index).Left - 10 * Sx) \ (49 * Sx)
    dy = (Image5(Index).Top - 30 * Sy) \ (49 * Sy)
    pin(dy * Scope + dx) = -1
    remain = remain + 1
    card(remain) = Index
End If
End Sub

'移动拼板
Private Sub Image5_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If moveit And locked(Index) = False Then
    GetCursorPos z
    Image5(Index).Move (z.X - 3) * Sx - cx - Left, (z.Y + 2) * Sy - cy - Top - sizableForm * Sy
    Image5(Index).ZOrder 0
End If
End Sub

'放下拼板并作出相应处理
Private Sub Image5_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As Long
Dim j As Long
Dim k As Long
Dim dx As Long
Dim dy As Long
Dim putit As Boolean
Dim temp(2400)
'如果移动已结束则退出
If moveit = False Then flag Index: Exit Sub
'释放鼠标:
ClipCursorBynum 0
'移动结束
moveit = False
If Image5(Index).Left + 24 * Sx > 10 * Sx + Scope * 49 * Sx Then
    If Image5(Index).Left < 10 * Sx + Scope * 49 * Sx Then Image5(Index).Left = 20 * Sx + Scope * 49 * Sx
    Solve.Enabled = True
    Exit Sub
End If
dx = (Image5(Index).Left + 24 * Sx - 10 * Sx) \ (49 * Sx)
dy = (Image5(Index).Top + 24 * Sy - 30 * Sy)
If dy < 0 Then
    Image5(Index).Left = 20 * Sx + Scope * 49 * Sx
    Solve.Enabled = True
Else
    dy = dy \ (49 * Sy)
    putit = True
    If pin(dy * Scope + dx) > -1 Then
        putit = False
    Else
        If dy > 0 Then
            If pin((dy - 1) * Scope + dx) > -1 Then
                If DownNum(pin((dy - 1) * Scope + dx)) <> UpNum(Index) Then putit = False
            End If
        End If
        If dy < Scope - 1 Then
            If pin((dy + 1) * Scope + dx) > -1 Then
                If DownNum(Index) <> UpNum(pin((dy + 1) * Scope + dx)) Then putit = False
            End If
        End If
        If dx > 0 Then
            If pin(dy * Scope + dx - 1) > -1 Then
                If RightNum(pin(dy * Scope + dx - 1)) <> LeftNum(Index) Then putit = False
            End If
        End If
        If dx < Scope - 1 Then
            If pin(dy * Scope + dx + 1) > -1 Then
                If RightNum(Index) <> LeftNum(pin(dy * Scope + dx + 1)) Then putit = False
            End If
        End If
    End If
    If putit = True Then
        Image5(Index).Move dx * 49 * Sx + 10 * Sx, dy * 49 * Sy + 30 * Sy
        pin(dy * Scope + dx) = Index
        For i = 0 To remain
            If card(i) = Index Then
                card(i) = card(remain)
                Exit For
            End If
        Next
        remain = remain - 1
    Else
        Image5(Index).Left = 20 * Sx + Scope * 49 * Sx
        Solve.Enabled = True
    End If
End If
If remain = -1 And Solve.Enabled = True Then
    Picture1.Cls
    Picture1.Move 10 * Sx, 30 * Sy
    Picture1.Width = Scope * 49 * Sx
    Picture1.Height = Scope * 49 * Sy
    For i = 0 To 2400
        temp(i) = i
    Next
    For i = 0 To 2400
        j = Int(Rnd * (48 - i)) + i
        k = temp(i)
        temp(i) = temp(j)
        temp(j) = k
    Next
    For i = 0 To 2400
        DoEvents
        Picture1.PaintPicture Image3, (temp(i) Mod 49) * Scope * Sx, (temp(i) \ 49) * Scope * Sy, Scope * Sx, Scope * Sy, (temp(i) Mod 49) * Sx, (temp(i) \ 49) * Sy, Sx, Sy
    Next
    Help.Enabled = False
End If
End Sub

'锁住拼板
Private Sub flag(Index As Integer)
Dim i As Long
For i = 0 To Scope * Scope - 1
    If pin(i) = Index Then Exit For
Next
If i = Scope * Scope Then Exit Sub
If locked(Index) = False Then
    Picture1.PaintPicture Image5(Index), 0, 0
    Picture1.PaintPicture Image2, 16 * Sx, 16 * Sy, 17 * Sx, 17 * Sy, 114 * Sx, 16 * Sy, 17 * Sx, 17 * Sy
    Image5(Index) = Picture1.Image
    locked(Index) = True
Else
    Picture1.PaintPicture Image5(Index), 0, 0
    Picture1.PaintPicture Image2, 16 * Sx, 16 * Sy, 17 * Sx, 17 * Sy, 65 * Sx, 16 * Sy, 17 * Sx, 17 * Sy
    Image5(Index) = Picture1.Image
    locked(Index) = False
End If
End Sub

'选择花色
Private Sub Maximum_Click(Index As Integer)
Maximum(Max - 5).Checked = False
Maximum(Index).Checked = True
Max = Index + 5
NewGame_Click
End Sub

'新游戏
Private Sub NewGame_Click()
Dim i As Long
Dim j As Long
Dim radius As Long
Help.Enabled = True
Picture1.Cls
Picture1.Move 688 * Sx, 376 * Sy
Picture1.Width = 49 * Sx
Picture1.Height = 49 * Sy
Cls
For i = 0 To 35
    Image5(i).Visible = False
Next
Width = Scope * 52 * Sx + 32 * Sx + Scope * 49 * Sx
Height = Scope * 49 * Sy + 39 * Sy + sizableForm * Sy
radius = Int(Rnd * 11 + 5) * Sx
For i = 0 To Width Step 10 * Sx
    For j = 0 To Height Step 10 * Sy
        Circle (i, j), radius, RGB(180, 140, 100)
    Next
Next
For i = 0 To Scope - 1
    For j = 0 To Scope - 1
        PaintPicture Image2, j * 49 * Sx + 10 * Sx, i * 49 * Sy + 30 * Sy, 49 * Sx, 49 * Sy, 0, 0, 49 * Sx, 49 * Sy
    Next
Next
ReDim UpNum(Scope * Scope - 1)
ReDim DownNum(Scope * Scope - 1)
ReDim LeftNum(Scope * Scope - 1)
ReDim RightNum(Scope * Scope - 1)
ReDim card(Scope * Scope - 1)
ReDim pin(Scope * Scope - 1)
ReDim locked(Scope * Scope - 1)
remain = Scope * Scope - 1
For i = 0 To Scope * Scope - 1
    pin(i) = -1
    If i < Scope Then UpNum(i) = Int(Rnd * (Max + 1)) Else UpNum(i) = DownNum(i - Scope)
    DownNum(i) = Int(Rnd * (Max + 1))
    If i Mod Scope = 0 Then LeftNum(i) = Int(Rnd * (Max + 1)) Else LeftNum(i) = RightNum(i - 1)
    RightNum(i) = Int(Rnd * (Max + 1))
    Picture1.PaintPicture Image2, 0, 0, 49 * Sx, 49 * Sy, 49 * Sx, 0, 49 * Sx, 49 * Sy
    Picture1.PaintPicture Image1(Design), 20 * Sx, 4 * Sy, 9 * Sx, 9 * Sy, UpNum(i) * 9 * Sx, 0, 9 * Sx, 9 * Sy
    Picture1.PaintPicture Image1(Design), 20 * Sx, 34 * Sy, 9 * Sx, 9 * Sy, DownNum(i) * 9 * Sx, 0, 9 * Sx, 9 * Sy
    Picture1.PaintPicture Image1(Design), 7 * Sx, 19 * Sy, 9 * Sx, 9 * Sy, LeftNum(i) * 9 * Sx, 0, 9 * Sx, 9 * Sy
    Picture1.PaintPicture Image1(Design), 33 * Sx, 19 * Sy, 9 * Sx, 9 * Sy, RightNum(i) * 9 * Sx, 0, 9 * Sx, 9 * Sy
    Image5(i) = Picture1.Image
    Image5(i).Visible = True
Next
For i = 0 To Scope * Scope - 1
    card(i) = i
Next
Solve.Enabled = True
Arrange_Click
End Sub

'选择图案
Private Sub Pattern_Click(Index As Integer)
Pattern(Design).Checked = False
Design = Index
Pattern(Design).Checked = True
NewGame_Click
End Sub

'新游戏
Private Sub Picture1_Click()
NewGame_Click
End Sub

'解答
Private Sub Solve_Click()
Dim i As Long
Dim j As Long
For i = 0 To Scope * Scope - 1
    If pin(i) <> i Then
        Image5(i).Move (i Mod Scope) * 49 * Sx + 10 * Sx, (i \ Scope) * 49 * Sy + 30 * Sy
        pin(i) = i
        Picture1.PaintPicture Image5(i), 0, 0
        Picture1.PaintPicture Image2, 16 * Sx, 16 * Sy, 17 * Sx, 17 * Sy, 114 * Sx, 16 * Sy, 17 * Sx, 17 * Sy
        Image5(i) = Picture1.Image
        locked(i) = True
    End If
Next
remain = -1
Solve.Enabled = False
End Sub

'调整窗体以及控件的尺寸与位置
Private Sub SetControls()
Dim myControl As Control
Dim k As Single
k = Screen.TwipsPerPixelX / 15
On Error Resume Next
For Each myControl In SihuaPinban
With myControl
.Height = .Height * k
.Width = .Width * k
.Move .Left * k, .Top * k
.FontSize = .FontSize * k
End With
Next
Height = Height * k
Width = Width * k
End Sub