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

語法:
   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
魔術王子 目前離線  
送花文章: 1530, 收花文章: 1555 篇, 收花: 3894 次
回覆時引用此帖