史萊姆論壇

返回   史萊姆論壇 > 專業主討論區 > 程式語言討論區
刷新本頁 篡改-井字遊戲+猜數字遊戲(可網路對戰)
忘記密碼?
論壇說明

歡迎您來到『史萊姆論壇』 ^___^

您目前正以訪客的身份瀏覽本論壇，訪客所擁有的權限將受到限制，您可以瀏覽本論壇大部份的版區與文章，但您將無法參與任何討論或是使用私人訊息與其他會員交流。若您希望擁有完整的使用權限，請註冊成為我們的一份子，註冊的程序十分簡單、快速，而且最重要的是－－註冊是完全免費的！

請點擊這裡：『註冊成為我們的一份子！』

Google 提供的廣告


發文 回覆
 
主題工具 顯示模式
舊 2005-07-07, 04:42 PM   #1
魔術王子
版區管理員
 
魔術王子 的頭像
榮譽勳章
UID - 115097
在線等級: 級別:42 | 在線時長:1985小時 | 升級還需:36小時級別:42 | 在線時長:1985小時 | 升級還需:36小時
註冊日期: 2004-01-13
住址: 魔術學園
文章: 2946
精華: 0
現金: 14770 金幣
資產: 2678400 金幣
預設 篡改-井字遊戲+猜數字遊戲(可網路對戰)
可能最近忙得腦筋有點秀逗了
竟然將猜數字遊戲加入之前轉貼的[井字遊戲]
同樣是在網路上對戰
不過有點陽春,有興趣的人可以修改看看
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
魔術王子 目前離線  
送花文章: 1523, 收花文章: 1553 篇, 收花: 3892 次
回覆時引用此帖
舊 2005-07-07, 04:46 PM   #2 (permalink)
版區管理員
 
魔術王子 的頭像
榮譽勳章
UID - 115097
在線等級: 級別:42 | 在線時長:1985小時 | 升級還需:36小時級別:42 | 在線時長:1985小時 | 升級還需:36小時
註冊日期: 2004-01-13
住址: 魔術學園
文章: 2946
精華: 0
現金: 14770 金幣
資產: 2678400 金幣
預設
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
魔術王子 目前離線  
送花文章: 1523, 收花文章: 1553 篇, 收花: 3892 次
回覆時引用此帖
舊 2005-07-07, 04:47 PM   #3 (permalink)
版區管理員
 
魔術王子 的頭像
榮譽勳章
UID - 115097
在線等級: 級別:42 | 在線時長:1985小時 | 升級還需:36小時級別:42 | 在線時長:1985小時 | 升級還需:36小時
註冊日期: 2004-01-13
住址: 魔術學園
文章: 2946
精華: 0
現金: 14770 金幣
資產: 2678400 金幣
預設
語法:
   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
魔術王子 目前離線  
送花文章: 1523, 收花文章: 1553 篇, 收花: 3892 次
回覆時引用此帖
舊 2005-07-07, 04:48 PM   #4 (permalink)
版區管理員
 
魔術王子 的頭像
榮譽勳章
UID - 115097
在線等級: 級別:42 | 在線時長:1985小時 | 升級還需:36小時級別:42 | 在線時長:1985小時 | 升級還需:36小時
註冊日期: 2004-01-13
住址: 魔術學園
文章: 2946
精華: 0
現金: 14770 金幣
資產: 2678400 金幣
預設
語法:
'********** 當有資料送達時 **********
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
魔術王子 目前離線  
送花文章: 1523, 收花文章: 1553 篇, 收花: 3892 次
回覆時引用此帖
舊 2005-07-07, 04:51 PM   #5 (permalink)
版區管理員
 
魔術王子 的頭像
榮譽勳章
UID - 115097
在線等級: 級別:42 | 在線時長:1985小時 | 升級還需:36小時級別:42 | 在線時長:1985小時 | 升級還需:36小時
註冊日期: 2004-01-13
住址: 魔術學園
文章: 2946
精華: 0
現金: 14770 金幣
資產: 2678400 金幣
預設
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
最後還有OnLine3.bas
語法:
Attribute VB_Name = "Module1"
Option Explicit

Public bIfServer As Boolean

Sub Main()
    Load frmLinkType
    frmLinkType.Show
End Sub
魔術王子 目前離線  
送花文章: 1523, 收花文章: 1553 篇, 收花: 3892 次
回覆時引用此帖
發文 回覆

« 上一主題 | 下一主題 »


發表規則
您不可以發文
您不可以回覆主題
您不可以上傳附加檔案
您不可以編輯您的文章
論壇啟用 BB 語法
論壇啟用 表情符號
論壇啟用 [IMG] 語法
論壇禁用 HTML 語法
Trackbacks are 禁用
Pingbacks are 禁用
Refbacks are 禁用


所有時間均為台北時間。現在的時間是 05:53 PM。

《 史萊姆的第一個家 》 - 論壇存檔 - 返回頂端

Powered by vBulletin® 版本 3.6.8
版權所有 ©2000 - 2024, Jelsoft Enterprises Ltd.

『服務條款』

* 有問題不知道該怎麼解決嗎？請聯絡本站的系統管理員 *


SEO by vBSEO 3.6.1