?? form1.frm
字號:
End
Begin VB.Menu mnudash
Caption = "-"
End
Begin VB.Menu mnuexittag
Caption = "E&xit TAG"
End
End
Begin VB.Menu mnutophelp
Caption = "Help"
Visible = 0 'False
Begin VB.Menu mnuAbout
Caption = "&About..."
End
Begin VB.Menu mnuhelp
Caption = "&Help..."
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'#########################################################
'### NOTE TO VIEWERS... ###
'### If your looking for the WINSOCK part ###
'### of this code, it in the WS object ###
'### with the Connect, DataArival, and ConnectionRequest ###
'### Declarations. ###
'### ###
'### KNOWN BUGS... ###
'### First of all, the game gets thrown out of sync ###
'### really easily because the speed of calculations ###
'### wich the computer does. Other bugs with incomming ###
'### data HAVE been noted adn hopefully fixed. ###
'### SEE THE README FILE for information on how it works ###
'### please also note that it will not let you move ###
'### unless you are connected to an opponent
'### http://www.yarinteractive.com ###
'#########################################################
Public Flag1 As Boolean
Public lastkey As Integer
Public Sub CmdSend_Click()
Dim b
If ConnectedtoRemote = False Then
TypeMatrix "Message not sent, not connected to remote computer..."
ElseIf ConnectedtoRemote = True And Len(txtTransmit.Text) > 0 Then
ws.SendData "%YTT%" & txtTransmit.Text 'send a transmission... (chat)
TypeMatrix MyTagName & ": " & txtTransmit.Text
txtTransmit.Text = ""
End If
End Sub
Private Sub Form_Load()
'Some more stuff that could be improved upon..
mmStop
mmClose
mmOpen (App.Path + "\sounds\mission.mid")
'MsgBox "It should be playing music!!!"
mmPlay
Paused = False
Timer1.Enabled = True
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
resmenus 'reset the menus
End Sub
Private Sub Form_Terminate()
mmStop
mmClose
End Sub
Private Sub Form_Unload(Cancel As Integer)
mmStop 'stop all of the multimedia stuff
mmClose
End Sub
Private Sub lblX_Click()
WEndGame
End Sub
Private Sub lblX_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
shpdd.Visible = False 'get rid of the box thing
lblX.BackStyle = 1 'show the background
lblX.ForeColor = 0
End Sub
Private Sub MatrixTextTimer_Timer()
If mlength = Len(MatrixText) Then MatrixTextTimer.Enabled = False
mlength = mlength + 1
lblTr.Caption = Mid(MatrixText, 1, mlength)
End Sub
Private Sub mnupause_Click()
If Paused = False Then
Paused = True
Call WPauseGame 'if we're not paused, pause it...
ElseIf Paused = True Then
Paused = False
Call WUnPauseGame 'if we're paused, unpause it...
End If
End Sub
Private Sub PArena_KeyDown(KeyCode As Integer, Shift As Integer)
'CircDirection
'1 = left Chr(37)
'2 = up Chr(38)
'3 = right Chr(39)
'4 = down Chr(40)
If ConnectedtoRemote = True Then
Select Case KeyCode
Case 37 'if they press left
If lastkey = 37 Then Exit Sub
' ws.Close
ws.SendData "YTDIR1"
CircDirection = 1
Case 38 'if they pressed up
If lastkey = 38 Then Exit Sub
ws.SendData "YTDIR2"
CircDirection = 2
'lblTr.Caption = "poop!!!"
Case 39 'if they pressed right
If lastkey = 39 Then Exit Sub
ws.SendData "YTDIR3"
CircDirection = 3
Case 40 'if they pressed down
If lastkey = 40 Then Exit Sub
ws.SendData "YTDIR4"
CircDirection = 4
Case 80
If Paused = False Then
WPauseGame
ElseIf Paused = True Then
WUnPauseGame
End If
End Select
lastkey = KeyCode
End If
End Sub
Private Sub picMoveF_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim MX
m = X
resmenus 'reset the menus
If Button = 1 Then
Form1.Left = (Form1.Left + (X))
Form1.Top = (Form1.Top + (Y))
End If
End Sub
Private Sub PArena_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
resmenus 'reset the menus...
End Sub
Private Sub pmnugame_Click()
PopupMenu mnugame 'show the popup menu
End Sub
Private Sub pmnugame_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
pMnuHelp.BackStyle = 0 'set the other menu object's background to transparent
pMnuHelp.ForeColor = &HFFFFFF 'set the other menu's forecolor to white again
pmnugame.BackStyle = 1
pmnugame.ForeColor = 0
End Sub
Private Sub pMnuHelp_Click()
PopupMenu mnutophelp 'show the HELP popup...
End Sub
Private Sub pMnuHelp_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
pmnugame.BackStyle = 0 'set the other menu object's background to transparent
pmnugame.ForeColor = &HFFFFFF 'set the other menu's forecolor to white again
pMnuHelp.BackStyle = 1
pMnuHelp.ForeColor = 0
End Sub
Public Sub resmenus() 'procedure to reset the menus...
pmnugame.BackStyle = 0 'set the other menu object's background to transparent
pmnugame.ForeColor = &HFFFFFF 'set the other menu's forecolor to white again
pMnuHelp.BackStyle = 0 'set the other menu object's background to transparent
pMnuHelp.ForeColor = &HFFFFFF 'set the other menu's forecolor to white again
lblX.BackStyle = 0
shpdd.Visible = True
lblX.ForeColor = &HFFFFFF
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 13 'if they pressed enter then...
Call CmdSend_Click
End Select
End Sub
Private Sub Timer1_Timer()
'if anyone could figure out a quicker way of calculating this
'let me know, cuz right now the slow calculations run the game
'out of sync, on any computer from a 100Mhz to a PIII 800Mhz!!!
On Error Resume Next
If Paused = True Then Exit Sub
If CircDirection = 1 And CircX > LeftBound Then
CircX = CircX - CircSpeed
Circle1.Left = CircX
ElseIf CircDirection = 3 And CircX < (RightBound - CircSize) Then
CircX = CircX + CircSpeed
Circle1.Left = CircX
ElseIf CircDirection = 4 And CircY < (BottomBound - CircSize) Then
CircY = CircY + CircSpeed
Circle1.Top = CircY
ElseIf CircDirection = 2 And CircY > TopBound Then
CircY = CircY - CircSpeed
Circle1.Top = CircY
Else
CircDirection = RevDir(CircDirection)
ws.SendData "YTDIR" & CircDirection
End If
If OpCircDir = 1 And OpCircX > LeftBound Then
OpCircX = OpCircX - OpCircSpeed
Circle2.Left = OpCircX
ElseIf OpCircDir = 3 And OpCircX < (RightBound - CircSize) Then
OpCircX = OpCircX + OpCircSpeed
Circle2.Left = OpCircX
ElseIf OpCircDir = 4 And OpCircY < (BottomBound - CircSize) Then
OpCircY = OpCircY + OpCircSpeed
Circle2.Top = OpCircY
ElseIf OpCircDir = 2 And OpCircY > TopBound Then
OpCircY = OpCircY - OpCircSpeed
Circle2.Top = OpCircY
End If
If YourIt = True Then DoCalcs
End Sub
Private Sub txtTransmit_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then Call CmdSend_Click
End Sub
Private Sub ws_Connect()
TypeMatrix "Conneting... Vairifying connection..."
ws.SendData "%YTCON?%" 'send varification request string...
TypeMatrix "Varification Request sent, waiting for reply..."
'send the name...
lblTr.Caption = "Sending Name..."
ws.SendData "YTPNAM" & MyTagName & "%"
'send our color
lblTr.Caption = "Sending Color..."
ws.SendData "%YTPCO" & MyColorNum & "%"
lblTr.Caption = "Sending Player Color..."
'varify once more..
lblTr.Caption = "Game Started..."
'Enable Chat...
txtTransmit.Enabled = True
Paused = False
Timer1.Enabled = True
ConnectedtoRemote = True
'Set up stuff for being the host...
CircX = 525
CircY = 1806
Circle1.Left = CircX
Circle1.Top = CircY
OpCircX = 4155
OpCircY = 1620
Circle2.Left = OpCircX
Circle2.Top = OpCircY
MsgBox "Set up default shit!"
End Sub
Private Sub ws_ConnectionRequest(ByVal requestID As Long)
Dim m
m = MsgBox("Player found... Do you wish to accept the connection?", vbYesNo, "Accept Connection?")
If m = vbYes Then
'MsgBox "Connection Accepted"
'Label1.Caption = Label1.Caption + Chr(13) + "Connection Accepted..."
Form1.Show
Form2.Hide
ws.Close
lblTr.Caption = "Closing Socket... Connecting to client."
'Label1.Caption = Label1.Caption + Chr(13) + "Closing Socket... Connecting to client."
ws.Accept requestID 'Accept the conection
'you've accepted the connection, let them know.
lblTr.Caption = "Establishing connection to remote players" & Chr(13) & "Varifying connection..."
ws.SendData ("YTAGSGAMEXOSC")
TypeMatrix "Extablishing connection..."
lblTr.Caption = "Sending Name..."
'send the name...
ws.SendData "YTPNAM" & MyTagName & "%"
lblTr.Caption = "Sending Player Color..."
'send our color
ws.SendData "%YTPCO" & MyColorNum & "%"
'varify once more..
ws.SendData "%YTCON?%"
TypeMatrix "Game Started..."
'Enable Chat and the rest of the game...
txtTransmit.Enabled = True
Paused = False
Timer1.Enabled = True
'We ARE connected now...
ConnectedtoRemote = True
Unload Form2
CircX = 4155
CircY = 1620
Form1.Circle1.Left = CircX
Form1.Circle1.Top = CircY
OpCircX = 525
OpCircY = 1806
Form1.Circle2.Left = OpCircX
Form1.Circle2.Top = OpCircY
Else
'we dont connect...
'if this next line makes any sort of error, comment it out
ws.SendData ("YTAGSGAMEXONC")
End If
End Sub
Private Sub ws_DataArrival(ByVal bytesTotal As Long)
Dim IData As String
Dim transi
Dim a, b, c, d, e, f, g, h, i
ws.GetData IData
'This part needs more improvement so they dont keep running out of sync...
If IData = "YTDIR1" Then 'the opponent is goin left
OpCircDir = 1
ElseIf IData = "YTDIR2" Then 'the opponent is goin up
OpCircDir = 2
ElseIf IData = "YTDIR3" Then 'the opponent is goin right
OpCircDir = 3
ElseIf IData = "YTDIR4" Then 'the opponent is goin down
OpCircDir = 4
ElseIf Left(IData, 5) = "%YTT%" Then
lblTr.Caption = "Incomming Transmission..."
transi = Right(IData, Len(IData) - 5)
TypeMatrix OpTagName & ": " & transi
If InStr(1, IData, "YTAGSGAMEXONC") > 0 Then MsgBox "The Host has declined your connection request... :("
If InStr(1, IData, "YTAGSGAMEXOSC") > 0 Then Call HAccC 'They've Accepted our connection request
If InStr(1, IData, "YTCONN") > 0 Then Call VarConD
If InStr(1, IData, "%YTCON?%") > 0 Then Call VarCon
If InStr(1, IData, "YTPASG") > 0 Then Call OPauseGame 'they paused the game
If InStr(1, IData, "YTUNPS") > 0 Then Call OUnPausedGame 'they unpaused the game
If InStr(1, IData, "YTSPNT") > 0 Then Call OpScoreP 'they scored a point
If InStr(1, IData, "YTENDG") > 1 Then Call OEndGame 'they ended the game...
If InStr(1, IData, "YTPNAM") > 0 Then 'we recieveed their name...
' On Error Resume Next
a = InStr(1, IData, "YTPNAM")
b = InStr(a, IData, "%")
c = b - a 'calculate the length of their name...
OpTagName = Mid(IData, (a + 6), c)
MsgBox "Name Recieved - testinfo... name:" & OpTagName
'they sent their color...
End If
If InStr(1, IData, "%YTPCO1%") > 0 Then 'they're red
OpColor = TAGColor1
Circle2.BackColor = OpColor
End If
If InStr(1, IData, "%YTPCO2%") > 0 Then 'they're orange
OpColor = TAGColor2
Circle2.BackColor = OpColor
End If
If InStr(1, IData, "%YTPCO3%") > 0 Then 'they're yellow
OpColor = TAGColor3
Circle2.BackColor = OpColor
End If
If InStr(1, IData, "%YTPCO4%") > 0 Then 'they're green
OpColor = TAGColor4
Circle2.BackColor = OpColor
End If
If InStr(1, IData, "%YTPCO5%") > 0 Then 'they're red
OpColor = TAGColor5
Circle2.BackColor = OpColor
End If
If InStr(1, IData, "%YTPCO6%") > 0 Then 'they're blue
OpColor = TAGColor6
Circle2.BackColor = OpColor
End If
'shows unknown data (errors)
' lblTr.Caption = "unrecognized command: " & IData
End If
'lblTr.Caption = IData
End Sub
Public Function RevDir(Direction As Byte) As Byte
If Direction = 1 Then RevDir = 3 'a sub to reverse the direction (when they hit a wall)
If Direction = 2 Then RevDir = 4
If Direction = 3 Then RevDir = 1
If Direction = 4 Then RevDir = 2
End Function
Public Sub TypeMatrix(Expression As String)
MatrixTextTimer.Enabled = False 'this just makes that typing effect for chat etc.
MatrixText = Expression
mlength = 0
MatrixTextTimer.Enabled = True
End Sub
Public Sub VarCon() 'connection being varified
lblTr.Caption = ""
TypeMatrix "Connection Varification Requested... Checking Connection..."
ws.SendData "YTCONN"
ConnectedtoRemote = True
Paused = False
Timer1.Enabled = True
End Sub
Public Sub VarConD() 'connection varified
lblTr.Caption = "Connection Varified..."
ConnectedtoRemote = True
End Sub
Public Sub HAccC()
Form1.MatrixTextTimer.Enabled = False
lblTr.Caption = ""
lblTr.Caption = "The host has ACCEPTED your connection =)"
ws.SendData "%YTPCO" & MyColorNum & "%"
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -