10-4.frm

来自「vb6.0编程实例详解,很详细的介绍,对学习VB有帮助」· FRM 代码 · 共 513 行

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form1 
   Caption         =   "网络井字棋"
   ClientHeight    =   5535
   ClientLeft      =   165
   ClientTop       =   855
   ClientWidth     =   5310
   DrawStyle       =   6  'Inside Solid
   LinkTopic       =   "Form1"
   ScaleHeight     =   5535
   ScaleWidth      =   5310
   StartUpPosition =   3  '窗口缺省
   Begin MSWinsockLib.Winsock Winsock2 
      Left            =   480
      Top             =   0
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      RemotePort      =   2048
   End
   Begin MSWinsockLib.Winsock Winsock1 
      Left            =   0
      Top             =   0
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      RemotePort      =   2048
      LocalPort       =   2048
   End
   Begin VB.PictureBox Draw 
      BackColor       =   &H80000005&
      DrawStyle       =   6  'Inside Solid
      Height          =   3375
      Left            =   120
      ScaleHeight     =   3315
      ScaleWidth      =   4395
      TabIndex        =   1
      Top             =   0
      Width           =   4455
   End
   Begin MSComctlLib.StatusBar StatusBar1 
      Align           =   2  'Align Bottom
      Height          =   255
      Left            =   0
      TabIndex        =   0
      Top             =   5280
      Width           =   5310
      _ExtentX        =   9366
      _ExtentY        =   450
      Style           =   1
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   1
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
         EndProperty
      EndProperty
   End
   Begin VB.Menu Game 
      Caption         =   "游戏"
      Begin VB.Menu Listen 
         Caption         =   "监听"
      End
      Begin VB.Menu Connect 
         Caption         =   "申请连接"
      End
      Begin VB.Menu Disconnect 
         Caption         =   "断开连接"
      End
      Begin VB.Menu Separate1 
         Caption         =   "-"
      End
      Begin VB.Menu ReStart 
         Caption         =   "重新开始"
         Enabled         =   0   'False
      End
      Begin VB.Menu Separate 
         Caption         =   "-"
      End
      Begin VB.Menu Exit 
         Caption         =   "结束"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim OneWidth As Long
Dim OneHeight As Long
Dim ChessMan(4, 4) As Integer
Dim Gaming As Boolean
Dim Drawable As Boolean
Dim First As Boolean
Const RedChess As Integer = 1
Const BlueChess As Integer = 2

Private Sub Draw_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim i As Long
    
    If Button = 1 And Drawable Then
        X = X \ OneWidth '计算输入位置
        Y = Y \ OneHeight
        If X > 0 And X < 4 And Y > 0 And Y < 4 Then
            If IsNot(Int(X), Int(Y)) Then
            '当前输入位置合法
                DrawRed Int(X), Int(Y)
                Drawable = False
                i = X * 10 + Y
                Winsock2.SendData i
                If IsWin(RedChess) Then
                '红棋胜
                    Message ("你赢了")
                    Gaming = False
                    Exit Sub
                Else
                '兰棋走
                    Message ("对方走，请稍等")
                End If
                If NoWin Then
                '和棋
                    Message ("和棋")
                    Gaming = False
                    Exit Sub
                End If
            End If
        End If
    End If
End Sub

Private Sub Draw_Paint()
'当Picture控件需要重画时，产生Paint事件
'当该控件的AutoRedraw属性设置为False时，才能产生该事件
    ReDraw
End Sub

Private Sub Exit_Click()
    Unload Me
End Sub

Private Sub Form_Resize()
    Draw.Left = ScaleLeft
    Draw.Top = ScaleTop
    Draw.Width = ScaleWidth
    If (ScaleHeight > StatusBar1.Height) Then
        Draw.Height = ScaleHeight - StatusBar1.Height
    End If
    
    '计算每棋格大小
    OneWidth = Draw.Width / 5
    OneHeight = Draw.Height / 5
    ReDraw '重绘棋盘
End Sub

Private Sub ReStart_Click()
    Dim i As Long
    
    i = 1
    Winsock2.SendData i
End Sub

Private Sub RestartGame()
'重新开始游戏
    Dim i As Integer
    Dim j As Integer
    
    For i = 0 To 4
    For j = 0 To 4
        ChessMan(i, j) = 0 '清空棋盘数据
    Next j, i
    NewGame
End Sub

Private Sub ReDraw()
    Dim i As Long
    Dim j As Long
    
    Draw.Cls '清屏
    
    '绘制棋盘格
    For i = 1 To 4
        Draw.Line (OneWidth, i * OneHeight)-(4 * OneWidth, i * OneHeight)
        Draw.Line (i * OneWidth, OneHeight)-(i * OneWidth, 4 * OneHeight)
    Next i
    
    '绘制棋子
    '遍历棋盘
    For i = 1 To 3
        For j = 1 To 3
            Select Case ChessMan(i, j)
                Case RedChess
                    Call DrawRed(i, j) '绘红棋
                Case BlueChess
                    Call DrawBlue(i, j) '绘兰棋
            End Select
        Next j
    Next i
End Sub

Private Function WinAt(Player As Integer, X As Integer, Y As Integer) As Boolean
'判断指定棋子在指定位置是否胜利
    Dim i As Integer
    Dim j As Integer
    
    '遍历棋子周围
    For i = -1 To 1
        For j = -1 To 1
            If (i Or j) And ChessMan(X - i, Y - j) = Player _
                        And ChessMan(X, Y) = Player _
                        And ChessMan(X + i, Y + j) = Player Then
            '指定棋子已经联成一线
                WinAt = True
                Exit Function
            End If
        Next j
    Next i
    WinAt = False
End Function

Private Function IsWin(Player As Integer) As Boolean
'判断指定棋子是否胜利
    Dim i As Integer
    Dim j As Integer
    
    '遍历棋盘
    For i = 1 To 3
        For j = 1 To 3
            If WinAt(Player, i, j) Then
            '已经胜利
                Gaming = False
                Drawable = False
                IsWin = True
                Exit Function
            End If
        Next j
    Next i
    IsWin = False
End Function

Private Function NoWin() As Boolean
'判断是否为和棋
    Dim i As Integer
    Dim j As Integer
    
    '遍历棋盘
    For i = 1 To 3
        For j = 1 To 3
            If ChessMan(i, j) = 0 Then
            '还有棋格可走
                NoWin = False
                Exit Function
            End If
        Next j
    Next i
    NoWin = True '和棋
End Function

Private Sub DrawRed(X As Long, Y As Long)
'绘制红棋子
    Dim tX As Integer
    Dim tY As Integer
    Dim dX As Integer
    Dim dY As Integer
    Dim RawColor As Long
    Dim RawWidth As Long
    
    ChessMan(X, Y) = RedChess
    
    '判断输赢
    If IsWin(RedChess) Then
        StatusBar1.SimpleText = "你赢了 ！"
        Gaming = False
    End If
    
    '计算红棋大小
    tX = (X + 0.5) * OneWidth
    tY = (Y + 0.5) * OneHeight
    dX = OneWidth / 3
    dY = OneHeight / 3
    
    '实现轰棋绘制
    RawColor = Draw.ForeColor
    RawWidth = Draw.DrawWidth
    Draw.ForeColor = vbRed
    Draw.DrawWidth = 5
    If dX > dY Then '圆半径不同
        Draw.Circle (tX, tY), dX, , , , dY / dX
    Else
        Draw.Circle (tX, tY), dY, , , , dY / dX
    End If
    Draw.ForeColor = RawColor
    Draw.DrawWidth = RawWidth
End Sub

Private Sub DrawBlue(X As Long, Y As Long)
'绘制蓝棋子
    Dim tX As Integer
    Dim tY As Integer
    Dim dX As Integer
    Dim dY As Integer
    Dim RawColor As Long
    Dim RawWidth As Long
    
    ChessMan(X, Y) = BlueChess
    
    If IsWin(BlueChess) Then
    '判断输赢,结束游戏
        StatusBar1.SimpleText = "计算机赢了 ！"
        Gaming = False
    End If
    
    '计算棋子大小
    tX = (X + 0.5) * OneWidth
    tY = (Y + 0.5) * OneHeight
    dX = OneWidth / 3
    dY = OneHeight / 3
    
    '实现兰棋绘制
    RawColor = Draw.ForeColor
    RawWidth = Draw.DrawWidth
    Draw.ForeColor = vbBlue
    Draw.DrawWidth = 5
    Draw.Line (tX - dX, tY - dY)-(tX + dX, tY + dY)
    Draw.Line (tX - dX, tY + dY)-(tX + dX, tY - dY)
    Draw.ForeColor = RawColor
    Draw.DrawWidth = RawWidth
End Sub

Private Function IsBlue(X As Integer, Y As Integer) As Boolean
'判断当前位置是否有兰棋
    If X > 3 Or X < 1 Or Y > 3 Or Y < 1 Then
    '输入数据越界
        IsBlue = False
    ElseIf ChessMan(X, Y) = BlueChess Then
    '当前位置有兰棋
        IsBlue = True
    Else
        IsBlue = False
    End If
End Function

Private Function IsRed(X As Integer, Y As Integer) As Boolean
'判断当前位置是否有红棋
    If X > 3 Or X < 1 Or Y > 3 Or Y < 1 Then
    '输入数据越界
        IsRed = False
    ElseIf ChessMan(X, Y) = RedChess Then
    '当前位置有红棋
        IsRed = True
    Else
        IsRed = False
    End If
End Function

Private Function IsNot(X As Long, Y As Long) As Boolean
'判断当前位置是否有棋子
    If X > 3 Or X < 1 Or Y > 3 Or Y < 1 Then
    '输入数据越界
        IsNot = False
    ElseIf ChessMan(X, Y) <> 0 Then
    '当前位置有棋子
        IsNot = False
    Else
    '当前位置无棋子
        IsNot = True
    End If
End Function

Private Sub NewGame()
    ReDraw
    Gaming = True
    Drawable = True
    'Message ("请走棋")
End Sub

Private Sub Message(s As String)
'显示信息
    Me.StatusBar1.SimpleText = s
End Sub

Private Sub Connect_Click()
    Disconnect_Click '结束连接（监听）
    Winsock2.RemoteHost = InputBox("请输入服务器主机名（IP 地址）", "输入", "127.0.0.1")
    Winsock2.Connect '申请连接
    Connect.Enabled = False
End Sub

Private Sub Disconnect_Click()
    If Disconnect.Caption = "结束监听" Then
        Winsock1.Close
        Listen.Enabled = True
        Disconnect.Caption = "断开"
    Else
        RestartGame
        Winsock2.Close
        Connect.Enabled = True
        First = False
        Drawable = First
        Gaming = False
        ReStart.Enabled = False
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Winsock1.Close
    Winsock2.Close
End Sub

Private Sub Listen_Click()
    Disconnect_Click
    Winsock1.Listen
    Listen.Enabled = False
    Disconnect.Caption = "结束监听"
End Sub

Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
'控件监听到网络连接申请时，触发该事件
    Winsock1.Close '停止监听
    Listen.Enabled = True
    Connect.Enabled = False
    Disconnect.Caption = "断开"
    Winsock2.Accept requestID
    RestartGame
    Message "对方走，请稍等"
    First = False
    Drawable = First
    ReStart.Enabled = True
End Sub

Private Sub Winsock2_Close()
'对方关闭连接时，控件触发该事件通知程序
    Winsock2.Close
    Connect.Enabled = True
    RestartGame
    First = False
    Drawable = False
    Gaming = False
    ReStart.Enabled = False
    
    Message "对方断开连接"
End Sub

Private Sub Winsock2_Connect()
'当控件申请并成功实现连接时，触发该事件
    Message "连接成功，请走棋"
    ReStart.Enabled = True
    RestartGame
    First = True
End Sub

Private Sub Winsock2_DataArrival(ByVal bytesTotal As Long)
'控件收到数据时，触发该事件
    Dim i As Long
    Dim j As Long
    
    Winsock2.GetData i '接收数据
    
    If i > 10 Then
        j = i / 10
        i = i Mod 10
        Call DrawBlue(4 - j, 4 - i)
        If IsWin(BlueChess) Then
        '兰棋胜
            Message ("你输了")
            Gaming = False
        ElseIf NoWin Then
            '和棋
            Message ("和棋")
            Gaming = False
        Else
            Message ("你走")
            Drawable = True
        End If
    ElseIf i = 1 Then
        If MsgBox("对方申请重玩，是否同意 ？", vbYesNo, "申请重玩") = vbYes Then
        '同意重玩
            Winsock2.SendData i + 1
            RestartGame
            Drawable = First
            If First Then
                Message ("你走")
            Else
                Message ("对方走，请稍等")
            End If
        Else
            Winsock2.SendData i + 3
        End If
    ElseIf i = 2 Then
        RestartGame
        Drawable = First
        If First Then
            Message ("你走")
        Else
            Message ("对方走，请稍等")
        End If
    ElseIf i = 3 Then
        Message ("对方不同意重玩 ！")
    End If
End Sub

Private Sub Winsock2_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
'控件产生网络错误
    Select Case Number
        Case 10061
            Winsock2.Close
            Connect.Enabled = True
    End Select
End Sub