語法:
Begin VB.Label lblMsg
Alignment = 2 '置中對齊
BackColor = &H0000FFFF&
Caption = "lblMsg遊戲狀態"
BeginProperty Font
Name = "新細明體"
Size = 12
Charset = 136
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 5160
TabIndex = 8
Top = 3360
Width = 1815
End
Begin VB.Label lblYouSay
BackColor = &H00C00000&
Caption = "lblYouSay 自己的訊息欄"
BeginProperty Font
Name = "新細明體"
Size = 12
Charset = 136
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FFFF&
Height = 255
Left = 960
TabIndex = 3
Top = 4440
Width = 5130
End
Begin VB.Label lblOneSay
BackColor = &H00000000&
Caption = "lblOneSay 對方訊息欄"
BeginProperty Font
Name = "新細明體"
Size = 12
Charset = 136
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Left = 960
TabIndex = 1
Top = 120
Width = 5175
End
End
Attribute VB_Name = "frmOX"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public sServerIP As String '對方主機的IP
Public sName As String '使用者暱稱
Dim bYourTurn As Boolean '是不是換你
Dim iScore(0 To 2) As Integer '勝,敗,平手的次數
Dim iLocChess(0 To 8) As Integer '棋盤上的棋子種類
Const OnesChess = 1
Const YourChess = 10
'********** 按下清除鍵 **********
Private Sub cmdClear_Click()
Winsock1.SendData "B"
lblYouSay.Caption = ""
End Sub
'********** 按下離線結束 **********
Private Sub cmdQuit_Click()
If Winsock1.State = sckConnected Then
Winsock1.SendData "E"
DoEvents
End If
End
End Sub
'********** 按下新回合 **********
Private Sub cmdNewRound_Click()
If Winsock1.State = sckConnected Then
Winsock1.SendData "D"
End If
subNewRound '執行新回合
End Sub
'********** 送出訊息 **********
Private Sub cmdSend_Click()
Dim sSend As String
lblYouSay.Caption = txtMsg.Text
sSend = "B" & txtMsg.Text
Winsock1.SendData sSend
txtMsg.Text = ""
End Sub
'********** 連結 **********
Public Sub subConnect()
If bIfServer = True Then
lblYourName.Caption = "OO " & sName
Else
lblYourName.Caption = "XX " & sName
End If
lblMsg.Caption = ""
lblCState.Caption = ""
lblYouSay.Caption = ""
txtMsg.Text = ""
lblOnesName.Caption = ""
lblOneSay.Caption = ""
cmdNewRound.Enabled = False
If Not bIfServer Then cmdNewRound.Visible = False
subShowScore '秀出戰績
cmdSend.Enabled = False '設定送出鍵為無效
cmdClear.Enabled = False
If bIfServer = True Then '當做伺服端
With Winsock1
.LocalPort = 2467 '自訂值,但值要在1024以上
.Bind
.Listen
End With
lblCState.Caption = "等待連結"
frmOX.Caption = frmOX.Caption & "---伺服端"
Else '當做用戶端
With Winsock1
.RemoteHost = sServerIP
.RemotePort = 2467
.Connect
End With
lblCState.Caption = "正在連結"
frmOX.Caption = frmOX.Caption & "---用戶端"
End If
subCanvas '畫格子
End Sub
'********** 斷線離開 **********
Private Sub Form_Unload(Cancel As Integer)
cmdQuit_Click
End Sub
'********** 按下滑鼠時 **********
Private Sub picCanvas_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim loc As Integer
Dim cellW As Integer
Dim xx As Integer
Dim yy As Integer
If bYourTurn And Winsock1.State = sckConnected Then
cellW = picCanvas.ScaleWidth \ 3
xx = X \ cellW
yy = Y \ cellW
loc = xx + yy * 3
If iLocChess(loc) = 0 Then
iLocChess(loc) = 10 '表示這個位置是你下的
subDrawChess loc, bIfServer '畫棋子
Winsock1.SendData "A" & CStr(loc)
lblMsg.Caption = "換對方下"
bYourTurn = False
If funIfResult Then '判斷輸贏
subShowScore '秀出戰績
cmdNewRound.Enabled = True
bYourTurn = False
End If
Else
Beep
End If
End If
End Sub
'********** 完成連結動作 **********
Private Sub Winsock1_Connect()
cmdSend.Enabled = True
cmdClear.Enabled = True
Winsock1.SendData "C" & sName
lblCState.Caption = "連線中"
lblMsg.Caption = "對方先下"
End Sub
'********** 發生要求連結 **********
Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
Winsock1.Close
Winsock1.Accept requestID
Winsock1.SendData "C" & sName
cmdClear.Enabled = True
cmdSend.Enabled = True
lblCState.Caption = "連線中"
lblMsg.Caption = "你先下"
bYourTurn = True
End Sub