module1.bas

用于远程视频监控的源码

Attribute VB_Name = "Module1"
'Color Constants...
Public Const TAGColor1 = &HFF& 'red
Public Const TAGColor2 = &H80FF&     'orange...
Public Const TAGColor3 = &HFFFF& 'yellow
Public Const TAGColor4 = &HFF00&     'Lime Green
Public Const TAGColor5 = &HFF0000  'blue
Public Const TAGColor6 = &HFF00FF 'purple

'set the constants for the grid color
Public Const NItGrid = &H80& 'red grid (your not it, they're oput to get you!)
Public Const ItGrid = &H4000& 'green grid (your it)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public TAGHost As Boolean 'keeps track of wheather your the host or not...
Public Const LeftBound = 0
Public Const RightBound = 5220
Public Const TopBound = 0
Public Const BottomBound = 4065
Public LastSentD As String
Public ConnectedtoRemote As Boolean

Public MatrixText As String 'for type effect...
Public mlength As Integer

'###Your Variables###
Public CircX As Integer
Public CircY As Integer
Public CircDirection As Byte
Public Paused As Boolean
Public Const CircSize = 195
Public Const CircSpeed = 45 'speed max is 255
Public MyScore As Long

Public MyColorNum As Byte 'which NUMBER is it in our constants?
Public MyColor 'whats the ACTUAL Color?
Public MyTagName As String
Public YourIt As Boolean

'############################################################
'####BORDER BETWEEN YOUR VARIABLES AND OPPONENT VARIABLES####
'############################################################

'###Opponent Variables###
Public OpCircX As Integer
Public OpCircY As Integer
Public OpCircDir As Byte
Public Oppaused As Boolean
Public Const OpCircSpeed = 60

Public OpColor
Public OpTagName As String
Public OPScore As Integer

'BEGINGING OF MM STUFF...

'------------------------------'
'         CaptiveX TM.         '
'   Writen by nofx (op-ivy)    '
'http://www.sharpnet.net/~nofx/'
'or visit us on EFNET #captivex'
'             P.S.             '
'           Have Fun           '
'------------------------------'

#If Win32 Then
Public Const HWND_TOPMOST& = -1
#Else
Public Const HWND_TOPMOST& = -1
#End If 'WIN32

#If Win32 Then
 Const SWP_NOMOVE& = &H2
 Const SWP_NOSIZE& = &H1
#Else
 Const SWP_NOMOVE& = &H2
 Const SWP_NOSIZE& = &H1
#End If 'WIN32

 Declare Function SetWindowPos& Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)


'   Multimedia Class
'   ~~~~~~~~~~~~~~~~
'
'   Declare As follows:
'
'       Dim MMPlayer As New clsMultimedia
'
'
'   Properties:
'
'       Filename            (String       The media file currently open)
'       Wait                (True/False   If the code should pause until until the file has finished playing)
'       Length              (Integer      The length (in seconds?) of the media file)
'       Position            (Integer      The position of the 'playback head')
'       Status              (String       What's happening to the media file...playing, stopped etc.)
'
'
'
'
'
'   Methods:
'
'       mmOpen(Filename)    (Open a media file specified by "Filename")
'       mmClose()           (Close the currently open media file)
'       mmPlay              (Plays the currently open media file)
'       mmPause()           (Pause the currently playing media file)
'       mmStop              (Stop the currently playing media file)
'       mmSeek(Time)        (Move the playback head to a position specified by "Time")

Option Explicit

Private sAlias As String

Private sFilename As String
Private nLength As Single

Private nPosition As Single
Private sStatus As Single
Private bWait As Boolean

Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

Public Sub mmOpen(ByVal sTheFile As String)

    Dim nReturn As Long
    
    Dim sType As String
    
    If sAlias <> "" Then
        mmClose
    End If
    
    Select Case UCase$(Right$(sTheFile, 3))
        Case "WAV"
            sType = "Waveaudio"
        Case "AVI"
            sType = "AviVideo"
        Case "MID"
            sType = "Sequencer"
        Case "MP3"
            sType = "MPegVideo"
        Case Else
            Exit Sub
    End Select
    Randomize
    sAlias = Right$(sTheFile, 3) & Minute(Now) & Second(Now) & Int(1000 * Rnd + 1)
    
    If InStr(sTheFile, " ") Then sTheFile = Chr(34) & sTheFile & Chr(34)
    nReturn = mciSendString("Open " & sTheFile & " ALIAS " & sAlias & " TYPE " & sType & " wait", "", 0, 0)
    
End Sub

Public Sub mmClose()

    Dim nReturn As Long
    
    If sAlias = "" Then Exit Sub
    
    nReturn = mciSendString("Close " & sAlias, "", 0, 0)
    sAlias = ""
    sFilename = ""
    
End Sub

Public Sub mmPause()

    Dim nReturn As Long
    
    If sAlias = "" Then Exit Sub
    
    nReturn = mciSendString("Pause " & sAlias, "", 0, 0)
    
End Sub

Public Sub mmPlay()

    Dim nReturn As Long
    
    If sAlias = "" Then Exit Sub
    
    If bWait Then
        nReturn = mciSendString("Play " & sAlias & " wait", "", 0, 0)
    Else
        nReturn = mciSendString("Play " & sAlias, "", 0, 0)
    End If
    
End Sub

Public Sub mmStop()

    Dim nReturn As Long
    
    If sAlias = "" Then Exit Sub
    
    nReturn = mciSendString("Stop " & sAlias, "", 0, 0)
    
End Sub

Public Sub mmSeek(ByVal nPosition As Single)

    Dim nReturn As Long
    
    nReturn = mciSendString("seek " & sAlias & " to " & nPosition, "", 0, 0)
    
End Sub

Property Get FileName() As String
    
    FileName = sFilename
    
End Property

Property Let FileName(ByVal sTheFile As String)
    
    mmOpen sTheFile
    
End Property

Property Get Wait() As Boolean
    
    Wait = bWait
    
End Property

Property Let Wait(bWaitValue As Boolean)
    
    bWait = bWaitValue
    
End Property

Property Get Length() As Single

    Dim nReturn As Long, nLength As Integer
    
    Dim sLength As String * 255
    
    If sAlias = "" Then
        Length = 0
        Exit Property
    End If
    
    nReturn = mciSendString("Status " & sAlias & " length", sLength, 255, 0)
    nLength = InStr(sLength, Chr$(0))
    Length = Val(Left$(sLength, nLength - 1))
    
End Property

Property Let Position(ByVal nPosition As Single)

    mmSeek nPosition

End Property

Property Get Position() As Single

    Dim nReturn As Integer, nLength As Integer
    
    Dim sPosition As String * 255
    
    If sAlias = "" Then Exit Property
    
    nReturn = mciSendString("Status " & sAlias & " position", sPosition, 255, 0)
    nLength = InStr(sPosition, Chr$(0))
    Position = Val(Left$(sPosition, nLength - 1))
    
End Property

Property Get Status() As String

    Dim nReturn As Integer, nLength As Integer
    
    Dim sStatus As String * 255
    
    If sAlias = "" Then Exit Property
    
    nReturn = mciSendString("Status " & sAlias & " mode", sStatus, 255, 0)
    
    nLength = InStr(sStatus, Chr$(0))
    Status = Left$(sStatus, nLength - 1)
    
End Property
Function StayOnTop(Form As Form) 'EX: Call StayOnTop(Me)
Dim lFlags As Long
Dim lStay As Long

lFlags = SWP_NOSIZE Or SWP_NOMOVE
lStay = SetWindowPos(Form.hWnd, HWND_TOPMOST, 0, 0, 0, 0, lFlags)
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Sub WPauseGame()
On Error Resume Next
'procedure to pause the game on boath the client and host's computers...
Form1.ws.SendData "YTPASG" 'send paused flag...
Paused = True 'let the program know its paused (on local computer)
Form1.Timer1.Enabled = False 'stop movement
Form1.TypeMatrix "YOU PAUSED THE GAME..."
End Sub

Public Sub OPauseGame()
'for when the other person pauses the game...
Form1.Timer1.Enabled = False 'stop movement
Paused = True 'let the program know its paused (on local computer)
Form1.TypeMatrix "GAME PUASED BY OPPONENT..."
End Sub

Public Sub WUnPauseGame()
On Error Resume Next
Form1.ws.SendData "YTUNPS"
Paused = False 'let the program know its unpaused (on local computer)
Form1.Timer1.Enabled = True 'start movement
Form1.TypeMatrix "GAME RESUMED..."
End Sub

Public Sub OUnPausedGame()
Form1.Timer1.Enabled = True 'start movement
Paused = False 'let the program know its unpaused (on local computer)
Form1.TypeMatrix "THE GAME HAS BEEN RESUMED..."
End Sub

Public Sub WEndGame()
Dim m
On Error GoTo HELL:
Form1.ws.SendData "YTENDG"
Form1.Timer1.Enabled = False
Form1.TypeMatrix "Game Stopped... Disconnecting..."
Form1.ws.Close 'close the socket...
mmStop
mmClose
 Unload Form1
 End
HELL:
 m = MsgBox("An Unexpected Error Occured. It appears that you are no longer connected to any remote players, would you like to exit anyways?", vbYesNo + vbExclamation, "Error")
 If m = vbYes Then
  Form1.Timer1.Enabled = False
   Form1.TypeMatrix "Game Stopped... Disconnecting..."
    Form1.ws.Close 'close the socket...
    mmStop
   mmClose
   Unload Form1
   End
 End If
   Exit Sub
End Sub

Public Sub OEndGame() 'opponenets ended the game...
 Form1.Timer1.Enabled = False
  Form1.TypeMatrix "Game Stopped By other player... Disconnecting..."
   Form1.ws.Close 'close the socket...
   Form1.TypeMatrix "Disconnected from player..."
  mmStop
 mmClose
 'Show the TAG connection form...
  Load Form2
  Form1.Hide
  Form2.Show
  Unload Form1
End Sub

Public Sub URnotIT()
'this procedure handels when you become "it"
'shptease
'lbltease
'shpgrid
YourIt = True
Form1.ShpGrid.FillColor = ItGrid
Form1.lbltease.Caption = "Go get 'em!!!"
Form1.ShpTease.BorderColor = ItGrid
End Sub

Public Sub URIT()
'this procedure handels when you become "it"
'shptease
'lbltease
'shpgrid
YourIt = False
Form1.ShpGrid.FillColor = NItGrid
Form1.lbltease.Caption = "The boogy-man is commin for ya!!!"
Form1.ShpTease.BorderColor = NItGrid
End Sub

Public Sub OpScoreP()
Form1.lblScoreNum1(2).Caption = Form1.lblScoreNum1(2).Caption + 350
Form1.lblScoreNum1(3).Caption = Form1.lblScoreNum1(2).Caption
URIT
'make code to reset game time limits...
End Sub

Public Sub WeScoreP()
Form1.lblScoreNum1(0).Caption = Form1.lblScoreNum1(0).Caption + 350
Form1.lblScoreNum1(1).Caption = Form1.lblScoreNum1(0).Caption
'tell the opponent we scored
Form1.ws.SendData "YTSPNT"
Call URnotIT
'make code to reset game time limits...
End Sub