module1.bas

双合棋,这个游戏是本人用一周多的时间编写的。已基本成形

Attribute VB_Name = "Module1"
Option Explicit
Global Const PORT = 5211
Public DragW As Boolean '是否拖动
Public Server As Integer  '角色1_ 服务器，角色2_客户端。
Public Board(1 To 6, 1 To 6) As Integer '棋盘
Public BoardLocal(1 To 6, 1 To 6) As Integer '备自己悔棋用
Public BoardRemote(1 To 6, 1 To 6) As Integer '备对方悔棋用
Public win(1 To 2), lost(1 To 2) As Integer
Public GState '游戏状态，1：下子，2：提子，3：落子。4：杀子 5:初始杀子
Public LGState As Integer '悔棋后己方状态
Public RGState As Integer '悔棋后对方状态
'本机棋况
Public LocalAddL(2 To 12) As Integer '存左倾线棋数
Public LocalSubR(2 To 12) As Integer '存右倾线棋数
Public LocalTotal As Integer        '已下棋数
Public LocalAddNum As Integer       '对方尚可下棋数

' 对家棋况
Public RemoteAddL(2 To 12) As Integer '存左倾线棋数
Public RemoteSubR(2 To 12) As Integer '存右倾线棋数
Public RemoteTotal As Integer        '已下棋数
Public RemoteAddNum As Integer        '已方尚可下棋数

Public MaxNum(2 To 12) As Integer

'注册表
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006

Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long








Sub Send(Data As String) '送出信息
Form1.Winsock1.SendData Data
End Sub
Sub Main()
'程序入口

Load Form2
Form2.Show
Load Form1
End Sub

Sub ProcessData(size)
Dim temp As Integer
Dim i As Integer, j As Integer
Dim Data As String
Dim S As Integer
Dim sx As Integer, sy As Integer
Form1.Winsock1.GetData Data, vbString
'根据接到的不同类型的信息进行处理
If Server = 1 Then S = 2 Else S = 1
Select Case Mid(Data, 1, 1)
    Case "1" '无成棋子信息
        
    '存储对方上一棋局
    For i = 1 To 6
        For j = 1 To 6
        BoardRemote(i, j) = Board(i, j)
        Next j
    Next i
    RGState = 1
        sx = Asc(Mid(Data, 2, 1)) '分离棋子位置。
        sy = Asc(Mid(Data, 3, 1))
        Board(sx, sy) = S '储存信息
        DrawBoard '刷新
        Form1.Picture1.Enabled = True
        Form1.Picture1.MousePointer = 2
        RemoteTotal = RemoteTotal + 1
        RemoteAddL(sx + sy) = RemoteAddL(sx + sy) + 1  '增加到左倾
        RemoteSubR(sy - sx + 7) = RemoteSubR(sy - sx + 7) + 1 '增加到左倾
        '判断是否该转棋。
        If RemoteTotal + LocalTotal = 36 Then
            GameTurn
        End If
        
        Exit Sub
    Case "2" '名字资料
        If Server = 1 Then
            Form1.lblWhiteName.Caption = "对方：" + Mid(Data, 2, size - 1)
            Send "2" + Mid(Form1.lblBlackName.Caption, 4, Len(Form1.lblBlackName.Caption) - 1)
        Else
            Form1.lblBlackName.Caption = "对方：" + Mid(Data, 2, size - 1)
        End If
        Exit Sub
    Case "3" '开新棋局送的资料
        '重开一局
        Reset
    
        If (win(1) + lost(1)) Mod 2 + 1 = Server Then
        Form1.Picture1.Enabled = True '根据局数交换双方先手。
        Form1.Picture1.MousePointer = 2
        GState = 1
        Else: Form1.Picture1.Enabled = False
            Form1.Picture1.MousePointer = 12
        End If
        Form1.Command1.Enabled = False
        Exit Sub
    Case "4" '对方断线送的资料
        Form1.lblInfo.Caption = "尚未连接"
        Form1.Picture1.Enabled = False
        Form1.Winsock1.Close
        Exit Sub
    Case "5" '对方成子的资料
        sx = Asc(Mid(Data, 2, 1)) '分离棋子位置。
        sy = Asc(Mid(Data, 3, 1))
        Board(sx, sy) = S '储存信息
        DrawBoard '刷新
        RemoteTotal = RemoteTotal + 1
        RemoteAddL(sx + sy) = RemoteAddL(sx + sy) + 1  '增加到左倾
        RemoteSubR(sy - sx + 7) = RemoteSubR(sy - sx + 7) + 1 '增加到左倾
        '判断是否该转棋。
        If RemoteTotal + LocalTotal = 36 Then
            GameTurn
        End If
        Exit Sub
    Case "6" '对方移子信息
    
        '存储对方上一棋局
        For i = 1 To 6
            For j = 1 To 6
                BoardRemote(i, j) = Board(i, j)
            Next j
        Next i
        RGState = 2
        sx = Asc(Mid(Data, 2, 1)) '分离移棋子始位置。
        sy = Asc(Mid(Data, 3, 1))
        Board(sx, sy) = 0 '储存信息
        DrawBoard '刷新
        RemoteAddL(sx + sy) = RemoteAddL(sx + sy) - 1  '左倾减
        RemoteSubR(sy - sx + 7) = RemoteSubR(sy - sx + 7) - 1 '右倾减
        sx = Asc(Mid(Data, 4, 1)) '分离移棋子 终位置。
        sy = Asc(Mid(Data, 5, 1))
        Board(sx, sy) = S '储存信息
        
        RemoteAddL(sx + sy) = RemoteAddL(sx + sy) + 1 '增加到左倾
        RemoteSubR(sy - sx + 7) = RemoteSubR(sy - sx + 7) + 1 '增加到右倾
        RemoteAddNum = Asc(Mid(Data, 6, 1))
        If RemoteAddNum = 0 Then
            Form1.Picture1.Enabled = True '对方不成，己方走子。
            Form1.Picture1.MousePointer = 5
        End If
        DrawBoard '刷新
        Exit Sub
    Case "7" '对方杀子信息
        sx = Asc(Mid(Data, 2, 1)) '分离移棋子始位置。
        sy = Asc(Mid(Data, 3, 1))
        Board(sx, sy) = 0 '储存信息
        DrawBoard '刷新
        LocalAddL(sx + sy) = LocalAddL(sx + sy) - 1  '左倾减
        LocalSubR(sy - sx + 7) = LocalSubR(sy - sx + 7) - 1 '右倾减
        
        '判断是否结束
         
            LocalTotal = LocalTotal - 1
           If GameUnResult() = 1 Then
        
                RemoteAddNum = RemoteAddNum - 1
                If RemoteAddNum <= 0 Then
                                 
                    Form1.Picture1.Enabled = True '对方杀毕，己方走子。
                    Form1.Picture1.MousePointer = 5
                End If
            End If
        Exit Sub
        
    Case "8" '  对方初杀信息
        
            '存储对方上一棋局
        For i = 1 To 6
            For j = 1 To 6
                BoardRemote(i, j) = Board(i, j)
            Next j
        Next i
        RGState = 2
        
        RemoteAddNum = 0
        LocalAddNum = 1
        
        sx = Asc(Mid(Data, 2, 1)) '分离移棋子始位置。
        sy = Asc(Mid(Data, 3, 1))
        
        Board(sx, sy) = 0 '储存信息
        LocalTotal = LocalTotal - 1
        LocalAddL(sx + sy) = LocalAddL(sx + sy) - 1  '左倾减
        LocalSubR(sy - sx + 7) = LocalSubR(sy - sx + 7) - 1 '右倾减
        
        DrawBoard '刷新
        GState = 4
        Form1.Picture1.Enabled = True
        Form1.Picture1.MousePointer = 10
        Exit Sub
    Case "9"
        Form1.Text1 = Form1.Text1 + Chr(13) + Chr(10) + Mid(Data, 2, size - 1)
        Exit Sub
    Case "r"
        MsgBox "对方认输？"
        
        Reset
        lost(S) = lost(S) + 1
        win(Server) = win(Server) + 1
        Form1.lblBlackScore.Caption = "战绩: " + Str(win(1)) + "胜 " + Str(win(2)) + "败"
        Form1.lblWhiteScore.Caption = "战绩: " + Str(win(2)) + "胜 " + Str(win(1)) + "败"
        Form1.Command1.Enabled = True '允许重开
        Form1.Picture1.Enabled = False
        Exit Sub
    Case "q" '对方求和
        temp = MsgBox("你是否同意对方求和？", vbYesNo)
        If temp = 6 Then
            Reset
            Form1.Command1.Enabled = True '允许重开
            Send "yq" '同意和
        Else: Send "nq"
        End If
        Exit Sub
    Case "h" '对方悔棋
        
        temp = MsgBox("你是否同意对方悔棋？", vbYesNo)
        If temp = 6 Then '同意
            Send "yh"
            '重置状态
            LocalTotal = 0
            RemoteTotal = 0
            LocalAddNum = 0
            RemoteAddNum = 0
            For i = 2 To 10
                LocalAddL(i) = 0
                LocalSubR(i) = 0
                RemoteAddL(i) = 0
                RemoteSubR(i) = 0
            Next i
            For i = 1 To 6
                For j = 1 To 6
                    Board(i, j) = BoardRemote(i, j)
                    If Board(i, j) = Server Then
                        LocalTotal = LocalTotal + 1
                        LocalAddL(i + j) = LocalAddL(i + j) + 1
                        LocalSubR(j - i + 7) = LocalSubR(j - i + 7) + 1
                    ElseIf Board(i, j) = S Then
                        RemoteTotal = RemoteTotal + 1
                        RemoteAddL(i + j) = RemoteAddL(i + j) + 1
                        RemoteSubR(j - i + 7) = RemoteSubR(j - i + 7) + 1
                    End If
                Next j
            Next i
            GState = RGState
            
            DrawBoard
        Else: Send "nh"
        End If
        
        Exit Sub
    Case "y" '同意
        If Mid(Data, 2, 1) = "q" Then
            Reset
            Form1.Command1.Enabled = True '允许重开
        ElseIf Mid(Data, 2, 1) = "h" Then
            '对方同意悔棋。。。
            LocalTotal = 0
            RemoteTotal = 0
            LocalAddNum = 0
            RemoteAddNum = 0
            For i = 2 To 10
                LocalAddL(i) = 0
                LocalSubR(i) = 0
                RemoteAddL(i) = 0
                RemoteSubR(i) = 0
            Next i
            For i = 1 To 6
                For j = 1 To 6
                    Board(i, j) = BoardLocal(i, j)
                    If Board(i, j) = Server Then
                        LocalTotal = LocalTotal + 1
                        LocalAddL(i + j) = LocalAddL(i + j) + 1
                        LocalSubR(j - i + 7) = LocalSubR(j - i + 7) + 1
                    ElseIf Board(i, j) = S Then
                        RemoteTotal = RemoteTotal + 1
                        RemoteAddL(i + j) = RemoteAddL(i + j) + 1
                        RemoteSubR(j - i + 7) = RemoteSubR(j - i + 7) + 1
                    End If
                Next j
            Next i
            GState = LGState
            
            Form1.huiqi.Enabled = False
            Form1.Picture1.Enabled = True
            DrawBoard
        End If
        Exit Sub
    Case "n" '同意
        MsgBox "对方拒绝!"
        Form1.Picture1.Enabled = True
        Exit Sub
        
    Case Else
End Select