![]() |
|
|||||||
| 論壇說明 | 標記討論區已讀 |
|
歡迎您來到『史萊姆論壇』 ^___^ 您目前正以訪客的身份瀏覽本論壇,訪客所擁有的權限將受到限制,您可以瀏覽本論壇大部份的版區與文章,但您將無法參與任何討論或是使用私人訊息與其他會員交流。若您希望擁有完整的使用權限,請註冊成為我們的一份子,註冊的程序十分簡單、快速,而且最重要的是--註冊是完全免費的! 請點擊這裡:『註冊成為我們的一份子!』 |
![]() |
|
|
主題工具 | 顯示模式 |
|
|
#1 |
|
版區管理員
![]() |
可能最近忙得腦筋有點秀逗了
竟然將猜數字遊戲加入之前轉貼的[井字遊戲] 同樣是在網路上對戰 不過有點陽春,有興趣的人可以修改看看 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 Text1
Height = 270
Left = 1320
TabIndex = 10
Top = 1200
Visible = 0 'False
Width = 975
End
Begin VB.ComboBox Combo1
Height = 300
ItemData = "OnLine3_LT.frx":0000
Left = 240
List = "OnLine3_LT.frx":000A
Style = 2 '單純下拉式
TabIndex = 9
Top = 720
Width = 2055
End
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 = 120
Width = 1335
End
Begin VB.Label Label2
Caption = "您的數字:"
Height = 255
Left = 240
TabIndex = 11
Top = 1200
Visible = 0 'False
Width = 975
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 = 240
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()
If (Combo1.ListIndex = 0) Then
Load frmOX
frmOX.Show
frmOX.sName = txtName.Text
If bIfServer = False Then frmOX.sServerIP = txtIP.Text
frmOX.subConnect
Me.Hide
Else
Load frmAB
frmAB.Show
frmAB.sNum = Text1.Text
frmAB.sName = txtName.Text
If bIfServer = False Then frmAB.sServerIP = txtIP.Text
frmAB.subConnect
Me.Hide
End If
End Sub
Private Sub cmdExit_Click()
End
End Sub
Private Sub Combo1_Click()
If (Combo1.ListIndex = 1) Then
Label2.Visible = True
Text1.Visible = True
Else
Label2.Visible = False
Text1.Visible = False
End If
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
Combo1.ListIndex = 0
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,
|
|
|
#2 (permalink) |
|
版區管理員
![]() |
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
|
|
|
送花文章: 1542,
|
|
|
#3 (permalink) |
|
版區管理員
![]() |
語法:
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
|
|
|
送花文章: 1542,
|
|
|
#4 (permalink) |
|
版區管理員
![]() |
語法:
'********** 當有資料送達時 **********
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,
|
|
|
#5 (permalink) |
|
版區管理員
![]() |
OnLine3_ab.frm內容(負責猜數字遊戲)
語法:
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmAB
Caption = "猜數字遊戲"
ClientHeight = 2445
ClientLeft = 60
ClientTop = 345
ClientWidth = 3510
LinkTopic = "Form1"
ScaleHeight = 2445
ScaleWidth = 3510
StartUpPosition = 3 '系統預設值
Begin VB.CommandButton Command2
Caption = "離開"
Height = 375
Left = 120
TabIndex = 3
Top = 1920
Width = 1095
End
Begin MSWinsockLib.Winsock Winsock1
Left = 2880
Top = 1200
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.TextBox Text2
Height = 2175
Left = 1320
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 '垂直捲軸
TabIndex = 2
Top = 120
Width = 2055
End
Begin VB.CommandButton Command1
Caption = "我猜"
Height = 375
Left = 120
TabIndex = 1
Top = 840
Width = 1095
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "Fixedsys"
Size = 24
Charset = 136
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 600
Left = 120
MaxLength = 4
TabIndex = 0
Top = 120
Width = 1095
End
End
Attribute VB_Name = "frmAB"
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 '使用者暱稱
Public sNum As String
Dim bYourTurn As Boolean '是不是換你
Private Sub Command1_Click()
Winsock1.SendData "A" & Text1.Text
End Sub
Private Sub Command2_Click()
If Winsock1.State = sckConnected Then
Winsock1.SendData "E"
DoEvents
End If
End
End Sub
Private Sub Form_Activate()
Text2.Text = Text2.Text + sNum + vbCrLf
End Sub
'********** 連結 **********
Public Sub subConnect()
If bIfServer = True Then '當做伺服端
With Winsock1
.LocalPort = 2467 '自訂值,但值要在1024以上
.Bind
.Listen
End With
Text2.Text = Text2.Text + "等待連結..." + vbCrLf
frmAB.Caption = frmAB.Caption & "---伺服端"
Else '當做用戶端
With Winsock1
.RemoteHost = sServerIP
.RemotePort = 2467
.Connect
End With
Text2.Text = Text2.Text + "正在連結..." + vbCrLf
frmAB.Caption = frmAB.Caption & "---用戶端"
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Command2_Click
End Sub
Private Sub Text2_Change()
Text2.SelStart = Len(Text2.Text)
End Sub
Private Sub Winsock1_Connect()
Winsock1.SendData "C" & sName
Text2.Text = Text2.Text + "連線中..." + vbCrLf
Text2.Text = Text2.Text + "對方先下..." + vbCrLf
Command1.Enabled = False
End Sub
Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
Winsock1.Close
Winsock1.Accept requestID
Winsock1.SendData "C" & sName
Text2.Text = Text2.Text + "連線中..." + vbCrLf
Text2.Text = Text2.Text + "你先下..." + vbCrLf
bYourTurn = True
Command1.Enabled = True
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim sMsgCheck As String
Dim sMsgString As String
Dim loc As Integer
Dim an As Integer
Dim bn As Integer
Dim i As Integer
Dim j As Integer
Winsock1.GetData sMsgString, vbString, bytesTotal
sMsgCheck = Mid(sMsgString, 1, 1)
sMsgString = Mid(sMsgString, 2, Len(sMsgString) - 1)
Select Case sMsgCheck
Case "A"
Text2.Text = Text2.Text + "對方猜: " + sMsgString + vbCrLf
For i = 1 To 4
If Mid(sMsgString, i, 1) = Mid(sNum, i, 1) Then an = an + 1
For j = 1 To 4
If Mid(sMsgString, i, 1) = Mid(sNum, j, 1) Then
If (i <> j) Then bn = bn + 1
End If
Next j
Next i
If (an = 4) Then
Winsock1.SendData "L"
Text2.Text = Text2.Text + "您輸了..." + vbCrLf
Command1.Enabled = False
Else
Winsock1.SendData "B" & sMsgString & " => " & an & "A" & bn & "B"
Text2.Text = Text2.Text + "換你下..." + vbCrLf
Text1.Text = ""
Text1.SetFocus
bYourTurn = True
Command1.Enabled = True
End If
Case "B"
Text2.Text = Text2.Text + sMsgString + vbCrLf
bYourTurn = False
Command1.Enabled = False
Case "C"
If bIfServer = True Then
Text2.Text = Text2.Text + sMsgString + " 上來了" + vbCrLf
Else
Text2.Text = Text2.Text + "已連到 " + sMsgString + vbCrLf
End If
Case "L"
Text2.Text = Text2.Text + Text1.Text + "正確答案^_^" + vbCrLf
Text2.Text = Text2.Text + "您贏了..." + vbCrLf
Command1.Enabled = False
Case "E"
Text2.Text = Text2.Text + "對方已經離線" + vbCrLf
End Select
End Sub
語法:
Attribute VB_Name = "Module1"
Option Explicit
Public bIfServer As Boolean
Sub Main()
Load frmLinkType
frmLinkType.Show
End Sub
|
|
|
送花文章: 1542,
|