net5.bas

一个具有聊天功能的游戏程序

Attribute VB_Name = "Module1"
Declare Sub BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long)
Declare Function sndPlaySound Lib "Winmm.dll" Alias "sndPlaySoundA" (ByVal SoundName As String, ByVal Flags As Long) As Long

Global Const srccopy = &HCC0020
Global Const srcand = &H8800C6
Global Const srcor = &HEE0086

Public map(1 To 15, 1 To 15)      '棋盘
Public Win(1 To 2), Lost(1 To 2)  '储存胜败次数
Public Server                     '存放目前为主机或加入连线
                                  '主机=1 加入连线=2
                                                                    
Sub Main()
Load Form1
Load Form2
Form1.Show
Form2.Show
End Sub

Sub DrawScreen()  '画出棋子
X = 3: Y = 2
For i = 1 To 15
  For j = 1 To 15
     If map(i, j) = 1 Then BitBlt Form1.Pic1.hDC, X, Y, 21, 20, Form1.Pic2.hDC, 0, 0, srccopy
     If map(i, j) = 2 Then BitBlt Form1.Pic1.hDC, X, Y, 21, 20, Form1.Pic2.hDC, 21, 0, srccopy
     If map(i, j) = 3 Then BitBlt Form1.Pic1.hDC, X, Y, 21, 20, Form1.Pic2.hDC, 42, 0, srccopy
     If map(i, j) = 4 Then BitBlt Form1.Pic1.hDC, X, Y, 21, 20, Form1.Pic2.hDC, 63, 0, srccopy
     Y = Y + 20
  Next j
  Y = 2
  X = X + 21
Next i
Form1.Pic1.Refresh
End Sub

Sub Send(mydata As String)  '送出资料
Form1.Winsock1.SendData mydata
End Sub

Sub GetMyData(Size)   '接受资料
Dim mydata As String
Form1.Winsock1.GetData mydata, vbString
Select Case Mid(mydata, 1, 1)
   Case "1"  '棋子的资料
     If Server = 1 Then s = 2 Else s = 1
     Call sndPlaySound("put.wav", 0)
     sx = Asc(Mid(mydata, 2, 1))
     sy = Asc(Mid(mydata, 3, 1))
     map(sx, sy) = s + 2
     DrawScreen
     map(sx, sy) = s
     a = GameOver(s)
     Form1.Pic1.Enabled = True
     If a = s Then
        Form1.Image1(1).Visible = True
        Form1.Pic1.Enabled = False
        Lost(Server) = Lost(Server) + 1
        Win(s) = Win(s) + 1
        Form1.Label1(2).Caption = "战绩：" + Str(Win(1)) + "胜" + Str(Lost(1)) + "败"
        Form1.Label1(4).Caption = "战绩：" + Str(Win(2)) + "胜" + Str(Lost(2)) + "败"
     End If
   Case "2"  '名字资料
     If Server = 1 Then
        Form1.Label1(3).Caption = Mid(mydata, 2, Size - 1)
        Send "2" + Form1.Label1(1).Caption
     Else
        Form1.Label1(1).Caption = Mid(mydata, 2, Size - 1)
     End If
   Case "3"  '开新棋局送的资料
     ResetGame
   Case "4"  '对方断线送的资料
     Form1.Label2.Caption = "尚未连线"
     Form1.Pic1.Enabled = False
     CloseCom
     Form1.Winsock1.Close
   Case "5"  '聊天视窗的资料
     Form1.Label1(0).Caption = Mid(mydata, 2, Size - 1)
   Case Else
End Select
End Sub

Function GameOver(a)   '判断是否连成五颗
For i = 1 To 11
  For j = 1 To 11
  If map(i, j) = a And map(i + 1, j + 1) = a And map(i + 2, j + 2) = a And map(i + 3, j + 3) = a And map(i + 4, j + 4) = a Then GameOver = a: Exit Function
  Next j
Next i
For i = 5 To 15
  For j = 5 To 15
  If map(i, j) = a And map(i - 1, j - 1) = a And map(i - 2, j - 2) = a And map(i - 3, j - 3) = a And map(i - 4, j - 4) = a Then GameOver = a: Exit Function
  Next j
Next i
For i = 5 To 15
  For j = 1 To 11
  If map(i, j) = a And map(i - 1, j + 1) = a And map(i - 2, j + 2) = a And map(i - 3, j + 3) = a And map(i - 4, j + 4) = a Then GameOver = a: Exit Function
  Next j
Next i
For i = 1 To 11
  For j = 5 To 15
  If map(i, j) = a And map(i + 1, j - 1) = a And map(i + 2, j - 2) = a And map(i + 3, j - 3) = a And map(i + 4, j - 4) = a Then GameOver = a: Exit Function
  Next j
Next i
For i = 1 To 15
  For j = 5 To 11
  If map(i, j) = a And map(i, j - 1) = a And map(i, j - 2) = a And map(i, j - 3) = a And map(i, j - 4) = a Then GameOver = a: Exit Function
  If map(i, j) = a And map(i, j + 1) = a And map(i, j + 2) = a And map(i, j + 3) = a And map(i, j + 4) = a Then GameOver = a: Exit Function
  Next j
Next i
For i = 5 To 11
  For j = 1 To 15
  If map(i, j) = a And map(i + 1, j) = a And map(i + 2, j) = a And map(i + 3, j) = a And map(i + 4, j) = a Then GameOver = a: Exit Function
  If map(i, j) = a And map(i - 1, j) = a And map(i - 2, j) = a And map(i - 3, j) = a And map(i - 4, j) = a Then GameOver = a: Exit Function
  Next j
Next i

GameOver = 0
End Function

Sub ResetGame()   '开新棋局
Form1.Pic1.Cls
For i = 1 To 15
  For j = 1 To 15
    map(i, j) = 0
  Next j
Next i
Form1.Image1(0).Visible = False
Form1.Image1(1).Visible = False
End Sub

Sub CloseCom()  '将能送出资料的控制项除能
Form1.Com1(0).Enabled = False
Form1.Com1(2).Enabled = False
End Sub

Sub OpenCom()   '将能送出资料的控制项致能
Form1.Com1(0).Enabled = True
Form1.Com1(2).Enabled = True
End Sub