|
論壇說明 |
歡迎您來到『史萊姆論壇』 ^___^ 您目前正以訪客的身份瀏覽本論壇,訪客所擁有的權限將受到限制,您可以瀏覽本論壇大部份的版區與文章,但您將無法參與任何討論或是使用私人訊息與其他會員交流。若您希望擁有完整的使用權限,請註冊成為我們的一份子,註冊的程序十分簡單、快速,而且最重要的是--註冊是完全免費的! 請點擊這裡:『註冊成為我們的一份子!』 |
|
主題工具 | 顯示模式 |
2005-06-28, 12:25 PM | #1 |
版區管理員
|
[VB]井字遊戲(網路對戰ㄛ)
本程式轉貼自Visual Basic遊戲設計實務 位元文化 編著
若單機作業可將IP設成127.0.0.1 OnLine3_ox.frm 語法:
VERSION 5.00 Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX" Begin VB.Form frmOX BackColor = &H0080C0FF& BorderStyle = 1 '單線固定 Caption = "網路井字棋" ClientHeight = 5505 ClientLeft = 45 ClientTop = 330 ClientWidth = 7185 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 5505 ScaleWidth = 7185 StartUpPosition = 3 '系統預設值 Begin VB.CommandButton cmdQuit Caption = "離線結束" Height = 495 Left = 600 TabIndex = 7 Top = 2640 Width = 1095 End Begin VB.CommandButton cmdNewRound Caption = "新回合" Height = 495 Left = 600 TabIndex = 6 Top = 2040 Width = 1095 End Begin VB.CommandButton cmdClear Caption = "清除" Height = 375 Left = 6240 TabIndex = 5 Top = 4320 Width = 735 End Begin VB.TextBox txtMsg BeginProperty Font Name = "新細明體" Size = 12 Charset = 136 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 960 TabIndex = 4 Text = "txtMsg 訊息輸入欄" Top = 4920 Width = 5175 End Begin VB.CommandButton cmdSend Caption = "送出" Height = 375 Left = 6240 TabIndex = 2 Top = 4920 Width = 735 End Begin VB.PictureBox picCanvas Appearance = 0 '平面 AutoRedraw = -1 'True BackColor = &H80000005& ForeColor = &H80000008& Height = 2655 Left = 2280 ScaleHeight = 175 ScaleMode = 3 '像素 ScaleWidth = 175 TabIndex = 0 Top = 1080 Width = 2655 End Begin MSWinsockLib.Winsock Winsock1 Left = 240 Top = 120 _ExtentX = 741 _ExtentY = 741 _Version = 393216 End Begin VB.Label lblResult BackColor = &H0080C0FF& Caption = "平手" BeginProperty Font Name = "新細明體" Size = 12 Charset = 136 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 375 Index = 2 Left = 5640 TabIndex = 15 Top = 2640 Width = 975 End Begin VB.Label lblResult BackColor = &H0080C0FF& Caption = "敗 " BeginProperty Font Name = "新細明體" Size = 12 Charset = 136 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 375 Index = 1 Left = 5640 TabIndex = 14 Top = 2160 Width = 975 End Begin VB.Label lblResult BackColor = &H0080C0FF& Caption = "勝 " BeginProperty Font Name = "新細明體" Size = 12 Charset = 136 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 375 Index = 0 Left = 5640 TabIndex = 13 Top = 1680 Width = 975 End Begin VB.Label lblCState Alignment = 2 '置中對齊 BackColor = &H00C0FFC0& Caption = "lblCState連結狀態" BeginProperty Font Name = "新細明體" Size = 12 Charset = 136 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 300 Left = 240 TabIndex = 12 Top = 3360 Width = 1815 End Begin VB.Label Label4 AutoSize = -1 'True BackColor = &H0080C0FF& Caption = "你的戰績" BeginProperty Font Name = "新細明體" Size = 14.25 Charset = 136 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 285 Left = 5520 TabIndex = 11 Top = 1200 Width = 1140 End Begin VB.Label lblYourName BackColor = &H00C00000& Caption = "lblYourName暱稱" BeginProperty Font Name = "新細明體" Size = 12 Charset = 136 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FFFF& Height = 255 Left = 2640 TabIndex = 10 Top = 3960 Width = 1935 End Begin VB.Label lblOnesName BackColor = &H00000000& Caption = "lblOnesName暱稱" BeginProperty Font Name = "新細明體" Size = 12 Charset = 136 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00FFFFFF& Height = 255 Left = 2640 TabIndex = 9 Top = 600 Width = 1935 End 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 |
送花文章: 1530,
|
2005-06-28, 12:26 PM | #2 (permalink) |
版區管理員
|
OnLine3_ox.frm(續)
語法:
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 |
送花文章: 1530,
|
2005-06-28, 12:27 PM | #3 (permalink) |
版區管理員
|
OnLine3_ox.frm(續)
語法:
'********** 完成連結動作 ********** 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 '********** 當有資料送達時 ********** 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,
|
2005-06-28, 12:28 PM | #4 (permalink) |
版區管理員
|
OnLine3_LT.frm
語法:
VERSION 5.00 Begin VB.Form frmLinkType BorderStyle = 1 '單線固定 Caption = "網路井字棋連線設定" ClientHeight = 3075 ClientLeft = 45 ClientTop = 330 ClientWidth = 5400 LinkTopic = "Form2" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 3075 ScaleWidth = 5400 StartUpPosition = 3 '系統預設值 Begin VB.TextBox txtIP BeginProperty Font Name = "新細明體" Size = 12 Charset = 136 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 3000 TabIndex = 7 Text = "0.0.0.0" Top = 1560 Width = 1935 End Begin VB.CommandButton cmdExit Caption = "結束" BeginProperty Font Name = "新細明體" Size = 12 Charset = 136 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 3120 TabIndex = 6 Top = 2280 Width = 1215 End Begin VB.CommandButton cmdConnect Caption = "確定" BeginProperty Font Name = "新細明體" Size = 12 Charset = 136 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 1080 TabIndex = 5 Top = 2280 Width = 1215 End Begin VB.OptionButton optConnect Caption = "加入連結。" BeginProperty Font Name = "新細明體" Size = 12 Charset = 136 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 1 Left = 3120 TabIndex = 4 Top = 840 Width = 1575 End Begin VB.OptionButton optConnect Caption = "等待連結。" BeginProperty Font Name = "新細明體" Size = 12 Charset = 136 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 0 Left = 3120 TabIndex = 3 Top = 480 Width = 1575 End Begin VB.Frame Frame1 Caption = "選擇連結方式" ForeColor = &H00FF0000& Height = 1095 Left = 2760 TabIndex = 2 Top = 240 Width = 2175 End Begin VB.TextBox txtName BeginProperty Font Name = "新細明體" Size = 12 Charset = 136 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 960 TabIndex = 1 Top = 600 Width = 1335 End Begin VB.Label lblIPreport AutoSize = -1 'True Caption = "你的主機 IP為:" BeginProperty Font Name = "新細明體" Size = 12 Charset = 136 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 240 Left = 240 TabIndex = 8 Top = 1680 Width = 1695 End Begin VB.Label Label1 AutoSize = -1 'True Caption = "暱稱:" BeginProperty Font Name = "新細明體" Size = 12 Charset = 136 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Left = 240 TabIndex = 0 Top = 720 Width = 720 End End Attribute VB_Name = "frmLinkType" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Private Sub cmdConnect_Click() Load frmOX frmOX.Show frmOX.sName = txtName.Text If bIfServer = False Then frmOX.sServerIP = txtIP.Text frmOX.subConnect Me.Hide End Sub Private Sub cmdExit_Click() End End Sub Private Sub Form_Load() Me.Show bIfServer = True optConnect(0).Value = True optConnect(1).Value = False lblIPreport = "你的主機 IP 為:" & frmOX.Winsock1.LocalIP txtIP.Visible = False End Sub Private Sub Form_Unload(Cancel As Integer) End End Sub Private Sub optConnect_Click(Index As Integer) If Index = 0 Then bIfServer = True '要當伺服端 lblIPreport = "你的主機 IP 為:" & frmOX.Winsock1.LocalIP txtIP.Visible = False Else bIfServer = False '要當用戶端 lblIPreport = "請輸入欲連結的主機 IP :" txtIP.Visible = True End If End Sub |
送花文章: 1530,
|