查看單個文章
舊 2005-07-07, 04:48 PM   #4 (permalink)
魔術王子
版區管理員
 
魔術王子 的頭像
榮譽勳章
UID - 115097
在線等級: 級別:42 | 在線時長:1994小時 | 升級還需:27小時級別:42 | 在線時長:1994小時 | 升級還需:27小時
註冊日期: 2004-01-13
住址: 魔術學園
文章: 2991
精華: 0
現金: 14977 金幣
資產: 2678607 金幣
預設

語法:
'********** 當有資料送達時 **********
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim sMsgCheck As String
    Dim sMsgString As String
    Dim loc As Integer
    Winsock1.GetData sMsgString, vbString, bytesTotal
    
    sMsgCheck = Mid(sMsgString, 1, 1)
    sMsgString = Mid(sMsgString, 2, Len(sMsgString) - 1)
    
    Select Case sMsgCheck
        Case "A" '棋子訊息
            loc = CInt(sMsgString)
            subDrawChess loc, Not bIfServer
            lblMsg.Caption = "換你下"
            bYourTurn = True
            If funIfResult Then '判斷輸贏
                subShowScore '秀出戰績
                cmdNewRound.Enabled = True
                bYourTurn = False
            End If
        Case "B" '聊天訊息
            lblOneSay.Caption = sMsgString
        Case "C" '對方的暱名
            If bIfServer = True Then
                lblOnesName.Caption = "XX " & sMsgString
            Else
                lblOnesName.Caption = "OO " & sMsgString
            End If
        Case "D" '新回合
            subNewRound
        Case "E" '離線結束
            lblCState.Caption = "對方已經離線"
            lblOneSay.Caption = ""
            lblOnesName.Caption = ""
            cmdSend.Enabled = False
    End Select
End Sub

'********** 按下 Enter 時 **********
Private Sub txtMsg_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 And cmdSend.Enabled = True Then Call cmdSend_Click
End Sub

'********** 畫棋盤線 **********
Private Sub subCanvas()
    Dim i As Integer
    Dim j As Integer
    picCanvas.Cls
    j = picCanvas.ScaleWidth \ 3
    For i = 1 To 2
        picCanvas.Line (j * i, 0)-(j * i, picCanvas.ScaleHeight), vbBlue
        picCanvas.Line (0, j * i)-(picCanvas.ScaleWidth, j * i), vbBlue
    Next
    picCanvas.Picture = picCanvas.Image
    picCanvas.Refresh
End Sub

'********** 新回合 **********
Private Sub subNewRound()
    Dim i As Integer
    Dim sum As Integer
    picCanvas.Cls
    For i = 0 To 8
        iLocChess(i) = 0
    Next
    
    '計算下回合誰先下
    For i = 0 To 2
        sum = sum + iScore(i)
    Next
    sum = sum Mod 2
    If sum = 0 Then
        If bIfServer = True Then
            bYourTurn = True
            lblMsg.Caption = "你先下"
        Else
            bYourTurn = False
            lblMsg.Caption = "對方先下"
        End If
    Else
        If bIfServer = True Then
            bYourTurn = False
            lblMsg.Caption = "對方先下"
        Else
            bYourTurn = True
            lblMsg.Caption = "你先下"
        End If
    End If
    cmdNewRound.Enabled = False
End Sub


'********** 透出戰績 **********
Private Sub subShowScore()
    Dim i As Integer

    For i = 0 To 2
        lblResult(i).Caption = Str(iScore(i)) & " " & Right(lblResult(i).Caption, 2)
    Next

End Sub

'********** 判斷輸贏 **********
Private Function funIfResult() As Boolean
    Dim i As Integer
    Dim win(0 To 7) As Integer
    Dim bIfDraw As Boolean '是否平手
    ' 0 1 2
    ' 3 4 5
    ' 6 7 8
    win(0) = iLocChess(0) + iLocChess(1) + iLocChess(2)
    win(1) = iLocChess(3) + iLocChess(4) + iLocChess(5)
    win(2) = iLocChess(6) + iLocChess(7) + iLocChess(8)
    win(3) = iLocChess(0) + iLocChess(3) + iLocChess(6)
    win(4) = iLocChess(1) + iLocChess(4) + iLocChess(7)
    win(5) = iLocChess(2) + iLocChess(5) + iLocChess(8)
    win(6) = iLocChess(0) + iLocChess(4) + iLocChess(8)
    win(7) = iLocChess(2) + iLocChess(4) + iLocChess(6)

    For i = 0 To 7
        If win(i) = 3 Then '你輸了
            iScore(1) = iScore(1) + 1
            lblMsg.Caption = "你輸了!"
            funIfResult = True
            Exit Function
        ElseIf win(i) = 30 Then '你贏了
            iScore(0) = iScore(0) + 1
            lblMsg.Caption = "你贏了!"
            funIfResult = True
            Exit Function
        End If
    Next
    
    '判斷是否平手
    bIfDraw = True
    For i = 0 To 8
        If iLocChess(i) = 0 Then bIfDraw = False
    Next
    If bIfDraw = True Then
        iScore(2) = iScore(2) + 1
        lblMsg.Caption = "平手!"
        funIfResult = True
    End If
End Function

'********** 畫棋子 **********
Private Sub subDrawChess(ByVal loc As Integer, ByVal chess As Boolean)
    Dim cellW As Integer
    Dim X As Integer
    Dim Y As Integer
    Dim S As Integer

    cellW = picCanvas.ScaleWidth \ 3
    X = cellW / 2 + (loc Mod 3) * cellW
    Y = cellW / 2 + (loc \ 3) * cellW
    
    S = cellW \ 3
    If chess Then
        picCanvas.Circle (X, Y), S, vbBlue
        If bIfServer Then iLocChess(loc) = 10 Else iLocChess(loc) = 1
    Else
        picCanvas.Line (X - S, Y - S)-(X + S, Y + S), vbRed
        picCanvas.Line (X - S, Y + S)-(X + S, Y - S), vbRed
        If bIfServer Then iLocChess(loc) = 1 Else iLocChess(loc) = 10
    End If
    
End Sub
魔術王子 目前離線  
送花文章: 1530, 收花文章: 1555 篇, 收花: 3894 次
回覆時引用此帖