图形处理.bas

用VB写的连连看游戏

Attribute VB_Name = "Module2"
'声音控制API
Public Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Const SND_SYNC = &H0         '声音同步播放
Const SND_ASYNC = &H1        '声音非同步播放
Const SND_NODEFAULT = &H2    '如果声音文件不存在也不产生错误
Const SND_FILENAME = &H20000 '声音是文件类型
'''''''''''''''''''''''''''''''''''''''''
'图形初始化处理模块
'''''''''''''''''''''''''''''''''''''''''
Sub initgraph() '该模块完成对图形界面的初始化
    Dim i, j, m As Integer
    Call initstar
    For i = 2 To 11
        For j = 2 To 15
            Form1.Picture1.PaintPicture Form2.Picture1(jl(i, j).lx - 1).Picture, 40 * (j - 1), 40 * (i - 1), 40, 40, , , , , vbSrcCopy
        Next j
    Next i
    '画线完成对图形的分割
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    For i = 1 To 12
        Form1.Picture1.Line (40, 40 * i)-(600, 40 * i)
    Next i
    For i = 1 To 16
        Form1.Picture1.Line (40 * i, 40)-(40 * i, 440)
    Next i
    Form1.Label4.Enabled = False
    Form1.Label4.Visible = False
End Sub
'''''''''''''''''''''
'鼠标的点击效果处理
'''''''''''''''''''''
Sub mousehit()
    Dim i, j As Integer
    mousedo.flag = 1
    If mousedo.x1 <> mousedo.x2 Or mousedo.y1 <> mousedo.y2 Then
        i = mousedo.x2: j = mousedo.y2
        If jl(i, j).flag = 1 Then Form1.Picture1.PaintPicture Form2.Picture1(jl(i, j).lx - 1).Picture, 40 * (j - 1), 40 * (i - 1), 40, 40, , , , , vbSrcCopy    '还原原来效果
        i = mousedo.x1: j = mousedo.y1
        If jl(i, j).flag = 1 Then Form1.Picture1.PaintPicture Form2.Picture1(jl(i, j).lx + 25 - 1).Picture, 40 * (j - 1), 40 * (i - 1), 40, 40, , , , , vbSrcCopy    '产生点击效果
        Call hitsound
        Call ceshi(mousedo.x1, mousedo.y1, 1, 0)
    End If
    '画线完成对图形的分割
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    For i = 1 To 12
        Form1.Picture1.Line (40, 40 * i)-(600, 40 * i)
    Next i
    For i = 1 To 16
        Form1.Picture1.Line (40 * i, 40)-(40 * i, 440)
    Next i
End Sub
'''''''''''''''''''''''''''''''''''''''''
'图形处理模块
'''''''''''''''''''''''''''''''''''''''''
Sub graph() '该模块完成对图形界面的初始化
    Dim i, j, m As Integer
    Form1.Picture1.Cls
    For i = 2 To 11
        For j = 2 To 15
            If jl(i, j).flag = 1 Then Form1.Picture1.PaintPicture Form2.Picture1(jl(i, j).lx - 1).Picture, 40 * (j - 1), 40 * (i - 1), 40, 40, , , , , vbSrcCopy
        Next j
    Next i
    '画线完成对图形的分割
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    For i = 1 To 12
        Form1.Picture1.Line (40, 40 * i)-(600, 40 * i)
    Next i
    For i = 1 To 16
        Form1.Picture1.Line (40 * i, 40)-(40 * i, 440)
    Next i
End Sub
Sub theway()
    Dim i As Integer
    For i = 1 To stack_n - 1
        If i >= 2 Then
            If stack(i).flag = stack(i - 1).flag Then
                Select Case stack(i).flag
                    Case 1
                        Form1.Picture1.PaintPicture Form2.Picture2(3).Picture, 40 * (stack(i).Y - 1), 40 * (stack(i).X - 1) + 15, 40, 10, , , , , vbSrcCopy
                    Case 2
                        Form1.Picture1.PaintPicture Form2.Picture2(2).Picture, 40 * (stack(i).Y - 1) + 15, 40 * (stack(i).X - 1), 10, 40, , , , , vbSrcCopy
                    Case 3
                        Form1.Picture1.PaintPicture Form2.Picture2(3).Picture, 40 * (stack(i).Y - 1), 40 * (stack(i).X - 1) + 15, 40, 10, , , , , vbSrcCopy
                    Case 4
                        Form1.Picture1.PaintPicture Form2.Picture2(2).Picture, 40 * (stack(i).Y - 1) + 15, 40 * (stack(i).X - 1), 10, 40, , , , , vbSrcCopy
                End Select
            End If
            ''''''''''''''''''''''''''
            If stack(i).flag <> stack(i - 1).flag Then    'Or stack(i).flag = stack(i - 1).flag
                Select Case stack(i - 1).flag
                    Case 1
                        Form1.Picture1.PaintPicture Form2.Picture2(1).Picture, 40 * (stack(i).Y - 1), 40 * (stack(i).X - 1) + 15, 25, 10, , , , , vbSrcCopy
                    Case 2
                        Form1.Picture1.PaintPicture Form2.Picture2(0).Picture, 40 * (stack(i).Y - 1) + 15, 40 * (stack(i).X - 1), 10, 25, , , , , vbSrcCopy
                    Case 3
                        Form1.Picture1.PaintPicture Form2.Picture2(1).Picture, 40 * (stack(i).Y - 1) + 20, 40 * (stack(i).X - 1) + 15, 25, 10, , , , , vbSrcCopy
                    Case 4
                        Form1.Picture1.PaintPicture Form2.Picture2(0).Picture, 40 * (stack(i).Y - 1) + 15, 40 * (stack(i).X - 1) + 20, 10, 25, , , , , vbSrcCopy
                End Select
            End If
        End If
        ''''''''''''''''''''''
        Select Case stack(i).flag
            Case 1
                Form1.Picture1.PaintPicture Form2.Picture2(0).Picture, 40 * (stack(i).Y - 1) + 15, 40 * (stack(i).X - 1) + 15, 25, 10, , , , , vbSrcCopy
            Case 2
                Form1.Picture1.PaintPicture Form2.Picture2(1).Picture, 40 * (stack(i).Y - 1) + 15, 40 * (stack(i).X - 1) + 15, 10, 25, , , , , vbSrcCopy
            Case 3
                Form1.Picture1.PaintPicture Form2.Picture2(0).Picture, 40 * (stack(i).Y - 1), 40 * (stack(i).X - 1) + 15, 25, 10, , , , , vbSrcCopy
            Case 4
                Form1.Picture1.PaintPicture Form2.Picture2(1).Picture, 40 * (stack(i).Y - 1) + 15, 40 * (stack(i).X - 1), 10, 25, , , , , vbSrcCopy
        End Select
    Next i
    '''''''''''''''''''''''''''
    Select Case stack(1).flag
        Case 1
            Form1.Picture1.PaintPicture Form2.Picture2(0).Picture, 40 * (stack(1).Y - 1) + 20, 40 * (stack(1).X - 1) + 15, 25, 10, , , , , vbSrcCopy
        Case 2
            Form1.Picture1.PaintPicture Form2.Picture2(1).Picture, 40 * (stack(1).Y - 1) + 15, 40 * (stack(1).X - 1) + 20, 10, 25, , , , , vbSrcCopy
        Case 3
            Form1.Picture1.PaintPicture Form2.Picture2(0).Picture, 40 * (stack(1).Y - 1), 40 * (stack(1).X - 1) + 15, 25, 10, , , , , vbSrcCopy
        Case 4
            Form1.Picture1.PaintPicture Form2.Picture2(1).Picture, 40 * (stack(1).Y - 1) + 15, 40 * (stack(1).X - 1), 10, 25, , , , , vbSrcCopy
    End Select
    '''''''''''''''''''''''''''''''
    If stack_n >= 2 Then
        Select Case stack(stack_n - 1).flag
            Case 1
                Form1.Picture1.PaintPicture Form2.Picture2(0).Picture, 40 * (stack(stack_n - 1).Y - 1) + 20, 40 * (stack(stack_n - 1).X - 1) + 15, 25, 10, , , , , vbSrcCopy
            Case 2
                Form1.Picture1.PaintPicture Form2.Picture2(1).Picture, 40 * (stack(stack_n - 1).Y - 1) + 15, 40 * (stack(stack_n - 1).X - 1) + 20, 10, 25, , , , , vbSrcCopy
            Case 3
                Form1.Picture1.PaintPicture Form2.Picture2(0).Picture, 40 * (stack(stack_n - 1).Y - 1), 40 * (stack(stack_n - 1).X - 1) + 15, 25, 10, , , , , vbSrcCopy
            Case 4
                Form1.Picture1.PaintPicture Form2.Picture2(1).Picture, 40 * (stack(stack_n - 1).Y - 1) + 15, 40 * (stack(stack_n - 1).X - 1), 10, 25, , , , , vbSrcCopy
        End Select
    End If
    '''''''''''''''''''''''''''''''''''
    If stack_n >= 2 Then
        Select Case stack(stack_n - 1).flag
            Case 1
                Form1.Picture1.PaintPicture Form2.Picture2(1).Picture, 40 * (mousedo.y2 - 1), 40 * (mousedo.x2 - 1) + 15, 25, 10, , , , , vbSrcCopy
            Case 2
                Form1.Picture1.PaintPicture Form2.Picture2(0).Picture, 40 * (mousedo.y2 - 1) + 15, 40 * (mousedo.x2 - 1), 10, 25, , , , , vbSrcCopy
            Case 3
                Form1.Picture1.PaintPicture Form2.Picture2(1).Picture, 40 * (mousedo.y2 - 1) + 20, 40 * (mousedo.x2 - 1) + 15, 25, 10, , , , , vbSrcCopy
            Case 4
                Form1.Picture1.PaintPicture Form2.Picture2(0).Picture, 40 * (mousedo.y2 - 1) + 15, 40 * (mousedo.x2 - 1) + 20, 10, 25, , , , , vbSrcCopy
        End Select
    End If
End Sub
''''''''''''''''''
'暂停游戏
'''''''''''''''''''
Sub space()
    If playflag = True Then  '只有在开始了游戏暂停才有意义
        If stopflag = False Then
            Form1.Timer2.Enabled = False    '关闭记时功能
            Form1.Picture1.Cls
            stopflag = True
            Form1.Picture1.PaintPicture Form2.Picture3.Picture, 224, 168, 192, 144, , , , , vbSrcCopy
        Else
            Form1.Timer2.Enabled = True    '打开记时功能
            stopflag = False
            Call graph
        End If
    End If
End Sub
Sub hitsound()
    Dim r As Long
    r = PlaySound(App.Path + "\hit.wav", 0&, SND_ASYNC Or AND_FILENAME Or AND_NODEFAULT)
End Sub
Sub andsound()
    Dim r As Long
    r = PlaySound(App.Path + "\and.wav", 0&, SND_ASYNC Or AND_FILENAME Or AND_NODEFAULT)
End Sub