![]() |
|
|||||||
| 論壇說明 |
|
歡迎您來到『史萊姆論壇』 ^___^ 您目前正以訪客的身份瀏覽本論壇,訪客所擁有的權限將受到限制,您可以瀏覽本論壇大部份的版區與文章,但您將無法參與任何討論或是使用私人訊息與其他會員交流。若您希望擁有完整的使用權限,請註冊成為我們的一份子,註冊的程序十分簡單、快速,而且最重要的是--註冊是完全免費的! 請點擊這裡:『註冊成為我們的一份子!』 |
![]() |
|
|
主題工具 | 顯示模式 |
|
|
#1 |
|
版區管理員
![]() |
本程式轉貼自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
|
|
|
送花文章: 1542,
|
|
|
#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
|
|
|
送花文章: 1542,
|
|
|
#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
|
|
|
送花文章: 1542,
|
|
|
#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
|
|
|
送花文章: 1542,
|