Initial commit: ROW Client source code
Game client codebase including: - CharacterActionControl: Character and creature management - GlobalScript: Network, items, skills, quests, utilities - RYLClient: Main client application with GUI and event handlers - Engine: 3D rendering engine (RYLGL) - MemoryManager: Custom memory allocation - Library: Third-party dependencies (DirectX, boost, etc.) - Tools: Development utilities 🤖 Generated with [Claude Code](https://claude.com/claude-code) Co-Authored-By: Claude <noreply@anthropic.com>
This commit is contained in:
@@ -0,0 +1,32 @@
|
||||
Attribute VB_Name = "Globals"
|
||||
'*******************************************************************************
|
||||
'* This is a part of the Microsoft Platform SDK Code Samples.
|
||||
'* Copyright (C) 1999-2001 Microsoft Corporation.
|
||||
'* All rights reserved.
|
||||
'* This source code is only intended as a supplement to
|
||||
'* Microsoft Development Tools and/or SDK documentation.
|
||||
'*******************************************************************************
|
||||
|
||||
'Microsoft Video Control - Sample Visual Basic Application
|
||||
Option Explicit
|
||||
|
||||
Public Const NTSC_GUID As String = "{8A674B4D-1F63-11D3-B64C-00C04F79498E}"
|
||||
Public Const ATSC_GUID As String = "{A2E30750-6C3D-11D3-B653-00C04F79498E}"
|
||||
Public Const DVBS_GUID As String = "{B64016F3-C9A2-4066-96F0-BD9563314726}"
|
||||
Public Const CC_GUID As String = "{7F9CB14D-48E4-43B6-9346-1AEBC39C64D3}"
|
||||
Public Const DATASVC_GUID As String = "{334125C0-77E5-11D3-B653-00C04F79498E}"
|
||||
|
||||
Sub Main()
|
||||
frmMain.Show
|
||||
End Sub
|
||||
|
||||
'Use this for error reporting
|
||||
Public Function CheckError(ErrorMsg As String)
|
||||
Dim Msg As Variant
|
||||
If Err.Number <> 0 Then
|
||||
Msg = ErrorMsg & vbCrLf & vbCrLf & "The error returned was:" & vbCrLf & Hex(Err.Number) & ": " & Err.Description
|
||||
MsgBox Msg, , "Error"
|
||||
End If
|
||||
'Reset the error so we don't get the same message over and over
|
||||
Err.Number = 0
|
||||
End Function
|
||||
@@ -0,0 +1,46 @@
|
||||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\..\WINNT\System32\stdole2.tlb#OLE Automation
|
||||
Reference=*\G{9B085638-018E-11D3-9D8E-00C04F72D980}#1.0#0#..\..\..\..\..\..\..\WINNT\System32\msvidctl.dll\2#Microsoft Tuner 1.0 Type Library
|
||||
Reference=*\G{B0EDF154-910A-11D2-B632-00C04F79498E}#1.0#0#..\..\..\..\..\..\..\WINNT\System32\msvidctl.dll#MS Video Control 1.0 Type Library
|
||||
Reference=*\G{00025E01-0000-0000-C000-000000000046}#5.0#0#..\..\..\..\..\..\..\Program Files\Common Files\Microsoft Shared\DAO\dao360.dll#Microsoft DAO 3.6 Object Library
|
||||
Form=main.frm
|
||||
Module=Globals; Globals.bas
|
||||
Object={B0EDF154-910A-11D2-B632-00C04F79498E}#1.0#0; msvidctl.dll
|
||||
IconForm="frmMain"
|
||||
Startup="frmMain"
|
||||
HelpFile=""
|
||||
Title="VBVideoControl"
|
||||
ExeName32="VBVideoControl.exe"
|
||||
Path32="..\..\..\..\..\..\.."
|
||||
Command32=""
|
||||
Name="VBVideoControl"
|
||||
HelpContextID="0"
|
||||
CompatibleMode="0"
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
RevisionVer=0
|
||||
AutoIncrementVer=0
|
||||
ServerSupportFiles=0
|
||||
VersionComments="SDK Visual Basic Sample"
|
||||
VersionCompanyName="Microsoft Corporation"
|
||||
VersionFileDescription="Microsoft Video Control VB Sample"
|
||||
VersionLegalCopyright="Copyright 2001 Microsoft Corporation"
|
||||
CompilationType=0
|
||||
OptimizationType=0
|
||||
FavorPentiumPro(tm)=-1
|
||||
CodeViewDebugInfo=0
|
||||
NoAliasing=0
|
||||
BoundsCheck=0
|
||||
OverflowCheck=0
|
||||
FlPointCheck=0
|
||||
FDIVCheck=0
|
||||
UnroundedFP=0
|
||||
StartMode=0
|
||||
Unattended=0
|
||||
Retained=0
|
||||
ThreadPerObject=0
|
||||
MaxNumberOfThreads=1
|
||||
DebugStartupOption=0
|
||||
|
||||
[MS Transaction Server]
|
||||
AutoRefresh=1
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 2.2 KiB |
@@ -0,0 +1,931 @@
|
||||
VERSION 5.00
|
||||
Object = "{B0EDF154-910A-11D2-B632-00C04F79498E}#1.0#0"; "msvidctl.dll"
|
||||
Begin VB.Form frmMain
|
||||
BorderStyle = 3 'Fixed Dialog
|
||||
Caption = "Microsoft Video Control - VB Sample Application"
|
||||
ClientHeight = 4875
|
||||
ClientLeft = 2130
|
||||
ClientTop = 2730
|
||||
ClientWidth = 9135
|
||||
Icon = "main.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
LockControls = -1 'True
|
||||
MaxButton = 0 'False
|
||||
MinButton = 0 'False
|
||||
ScaleHeight = 325
|
||||
ScaleMode = 3 'Pixel
|
||||
ScaleWidth = 609
|
||||
ShowInTaskbar = 0 'False
|
||||
Begin VB.TextBox txtChannel
|
||||
Height = 375
|
||||
Left = 1200
|
||||
TabIndex = 25
|
||||
Top = 2160
|
||||
Visible = 0 'False
|
||||
Width = 615
|
||||
End
|
||||
Begin VB.TextBox txtSID
|
||||
Height = 375
|
||||
Left = 1200
|
||||
TabIndex = 23
|
||||
Top = 1680
|
||||
Visible = 0 'False
|
||||
Width = 615
|
||||
End
|
||||
Begin VB.CommandButton cmdInfo
|
||||
Caption = "Info"
|
||||
Height = 495
|
||||
Left = 1200
|
||||
TabIndex = 22
|
||||
ToolTipText = "Display tuner information and FPS count"
|
||||
Top = 1080
|
||||
Visible = 0 'False
|
||||
Width = 855
|
||||
End
|
||||
Begin VB.CommandButton cmdEnterDVB
|
||||
Caption = "Enter"
|
||||
Height = 495
|
||||
Left = 120
|
||||
TabIndex = 20
|
||||
ToolTipText = "Enter DVB Channel"
|
||||
Top = 1800
|
||||
Visible = 0 'False
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.CommandButton cmdViewNext
|
||||
Caption = "Next Tuner"
|
||||
Height = 495
|
||||
Left = 120
|
||||
TabIndex = 19
|
||||
ToolTipText = "Select the next tuner in the list"
|
||||
Top = 1080
|
||||
Visible = 0 'False
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.CommandButton cmdCaptureOff
|
||||
Caption = "Hide Capture"
|
||||
Height = 495
|
||||
Left = 7305
|
||||
TabIndex = 18
|
||||
ToolTipText = "Click to hide the captured frame window"
|
||||
Top = 3960
|
||||
Visible = 0 'False
|
||||
Width = 1695
|
||||
End
|
||||
Begin VB.CommandButton cmdSeekUpDigital
|
||||
Caption = "Ch. Up"
|
||||
Height = 495
|
||||
Left = 1200
|
||||
TabIndex = 17
|
||||
ToolTipText = "ATSC Physical Channel Up"
|
||||
Top = 3600
|
||||
Visible = 0 'False
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.CommandButton cmdVolumeDown
|
||||
Caption = "Vol. Down"
|
||||
Height = 495
|
||||
Left = 2280
|
||||
TabIndex = 16
|
||||
ToolTipText = "Click to decrease volume"
|
||||
Top = 4200
|
||||
Visible = 0 'False
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.CommandButton cmdSeekDownDigital
|
||||
Caption = "Ch. Down"
|
||||
Height = 495
|
||||
Left = 1200
|
||||
TabIndex = 15
|
||||
ToolTipText = "ATSC Physical Channel Down"
|
||||
Top = 4200
|
||||
Visible = 0 'False
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.CommandButton cmdCapture
|
||||
Caption = "Capture Video Frame"
|
||||
Height = 495
|
||||
Left = 4200
|
||||
TabIndex = 14
|
||||
ToolTipText = "Click to capture a frame of video"
|
||||
Top = 3960
|
||||
Visible = 0 'False
|
||||
Width = 1815
|
||||
End
|
||||
Begin VB.CommandButton cmdEnterAnalog
|
||||
Caption = "Enter"
|
||||
Height = 495
|
||||
Left = 120
|
||||
TabIndex = 13
|
||||
ToolTipText = "Enter NTSC Channel"
|
||||
Top = 2400
|
||||
Visible = 0 'False
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.CommandButton cmdEnterATSC
|
||||
Caption = "Enter"
|
||||
Height = 495
|
||||
Left = 120
|
||||
TabIndex = 12
|
||||
ToolTipText = "Enter ATSC Channel"
|
||||
Top = 3000
|
||||
Visible = 0 'False
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.CommandButton cmdVolumeUp
|
||||
Caption = "Vol. Up"
|
||||
Height = 495
|
||||
Left = 2280
|
||||
TabIndex = 11
|
||||
ToolTipText = "Click to increase volume"
|
||||
Top = 3600
|
||||
Visible = 0 'False
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.TextBox txtMinorChannel
|
||||
Height = 375
|
||||
Left = 1200
|
||||
TabIndex = 8
|
||||
Top = 3120
|
||||
Visible = 0 'False
|
||||
Width = 615
|
||||
End
|
||||
Begin VB.TextBox txtPhysicalChannel
|
||||
Height = 375
|
||||
Left = 1200
|
||||
TabIndex = 6
|
||||
Top = 2640
|
||||
Visible = 0 'False
|
||||
Width = 615
|
||||
End
|
||||
Begin VB.CommandButton cmdSeekDownAnalog
|
||||
Caption = "Ch. Down"
|
||||
Height = 495
|
||||
Left = 120
|
||||
TabIndex = 5
|
||||
ToolTipText = "NTSC Channel Down"
|
||||
Top = 4200
|
||||
Visible = 0 'False
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.CommandButton cmdSeekUpAnalog
|
||||
Caption = "Ch. Up"
|
||||
Height = 495
|
||||
Left = 120
|
||||
TabIndex = 4
|
||||
ToolTipText = "NTSC Channel Up"
|
||||
Top = 3600
|
||||
Visible = 0 'False
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.CommandButton cmdPowerOff
|
||||
Caption = "Power Off"
|
||||
Height = 495
|
||||
Left = 2760
|
||||
TabIndex = 3
|
||||
ToolTipText = "Done with playback of selected source"
|
||||
Top = 1680
|
||||
Visible = 0 'False
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.CommandButton cmdPowerOn
|
||||
Caption = "Power On"
|
||||
Height = 495
|
||||
Left = 2760
|
||||
TabIndex = 2
|
||||
ToolTipText = "Start playing selected source (please be patient)"
|
||||
Top = 1080
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.ComboBox cbSource
|
||||
Height = 315
|
||||
Left = 120
|
||||
TabIndex = 0
|
||||
Text = "Combo1"
|
||||
ToolTipText = "Choose one of the tuners from the combo box and press Power On. Note that building the graph may take up to 10 seconds."
|
||||
Top = 480
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.Label lblChannel
|
||||
Caption = "Channel"
|
||||
Height = 255
|
||||
Left = 1920
|
||||
TabIndex = 26
|
||||
Top = 2220
|
||||
Visible = 0 'False
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.Label lblSID
|
||||
Caption = "SID"
|
||||
Height = 255
|
||||
Left = 1920
|
||||
TabIndex = 24
|
||||
Top = 1740
|
||||
Visible = 0 'False
|
||||
Width = 495
|
||||
End
|
||||
Begin VB.Label lblInfo
|
||||
Height = 375
|
||||
Left = 4200
|
||||
TabIndex = 21
|
||||
Top = 4440
|
||||
Visible = 0 'False
|
||||
Width = 3735
|
||||
End
|
||||
Begin MSVidCtlLibCtl.MSVidCtl VidControl
|
||||
Height = 3600
|
||||
Left = 4200
|
||||
TabIndex = 10
|
||||
ToolTipText = "Microsoft Video Control window"
|
||||
Top = 240
|
||||
Width = 4800
|
||||
_cx = 42672403
|
||||
_cy = 42670286
|
||||
AutoSize = 0 'False
|
||||
Enabled = -1 'True
|
||||
Object.TabStop = -1 'True
|
||||
BackColor = 0
|
||||
End
|
||||
Begin VB.Label lblMinorChannel
|
||||
Caption = "Minor Channel"
|
||||
Height = 255
|
||||
Left = 1920
|
||||
TabIndex = 9
|
||||
Top = 3180
|
||||
Visible = 0 'False
|
||||
Width = 1455
|
||||
End
|
||||
Begin VB.Label lblPhysicalChannel
|
||||
Caption = "Physical Channel"
|
||||
Height = 255
|
||||
Left = 1920
|
||||
TabIndex = 7
|
||||
Top = 2700
|
||||
Visible = 0 'False
|
||||
Width = 1335
|
||||
End
|
||||
Begin VB.Label lblSourceInUse
|
||||
Caption = "Playback Source"
|
||||
Height = 255
|
||||
Left = 120
|
||||
TabIndex = 1
|
||||
Top = 120
|
||||
Visible = 0 'False
|
||||
Width = 3975
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmMain"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
'*******************************************************************************
|
||||
'* This is a part of the Microsoft Platform SDK Code Samples.
|
||||
'* Copyright (C) 1999-2001 Microsoft Corporation.
|
||||
'* All rights reserved.
|
||||
'* This source code is only intended as a supplement to
|
||||
'* Microsoft Development Tools and/or SDK documentation.
|
||||
'*******************************************************************************
|
||||
|
||||
'Microsoft Video Control - Sample Visual Basic Application
|
||||
Option Explicit
|
||||
Dim TVPlayer As MSVidAnalogTunerDevice
|
||||
Dim ATSCTune As IATSCChannelTuneRequest
|
||||
Dim AnalogTune As IChannelTuneRequest
|
||||
Dim DVBTune As IDVBTuneRequest
|
||||
Dim AnalogTV As AnalogTVTuningSpace
|
||||
Dim ATSCTV As New ATSCTuningSpace
|
||||
Dim DVBSTV As New DVBSTuningSpace
|
||||
Dim ATSCLoc As New ATSCLocator
|
||||
|
||||
|
||||
Sub Form_Load()
|
||||
cbSource.AddItem ("NTSC Analog TV")
|
||||
cbSource.AddItem ("NTSC Analog TV w/CC")
|
||||
cbSource.AddItem ("ATSC Digital Antenna TV")
|
||||
cbSource.AddItem ("ATSC Digital Antenna TV w/CC & Mixing Mode")
|
||||
cbSource.AddItem ("DVB-S Digital TV")
|
||||
cbSource.AddItem ("DVB-S Digital TV w/CC & Mixing Mode")
|
||||
cbSource.Text = "Choose a playback source and click Power On"
|
||||
End Sub
|
||||
|
||||
Sub cmdPowerOn_click()
|
||||
'This function builds the correct graph depending on the user-selected broadcast type
|
||||
On Error GoTo ON_ERROR
|
||||
Dim TuningSpaceContainer As SystemTuningSpaces
|
||||
Set TuningSpaceContainer = CreateObject("BDATuner.SystemTuningSpaces")
|
||||
Dim TuningSpaceCollection As ITuningSpaces
|
||||
Dim TS As ITuningSpace
|
||||
Dim FeaturesColl As New MSVidFeatures
|
||||
Dim FeaturesAvailableColl As MSVidFeatures
|
||||
Dim Feature As IMSVidFeature
|
||||
Dim counter As Integer
|
||||
|
||||
VidControl.MaintainAspectRatio = True
|
||||
VidControl.AutoSize = False
|
||||
|
||||
'NTSC Analog TV playback init
|
||||
If cbSource.Text = "NTSC Analog TV" Then
|
||||
'Find all of the AnalogTV tuning spaces
|
||||
Set TuningSpaceCollection = TuningSpaceContainer.TuningSpacesForCLSID(NTSC_GUID)
|
||||
If TuningSpaceCollection.Count = 0 Then
|
||||
MsgBox ("Couldn't find an NTSC Tuning Space.")
|
||||
Call cmdPowerOff_click
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
'Pick the tuning space named Cable
|
||||
For Each TS In TuningSpaceCollection
|
||||
If TS.UniqueName = "Cable" Then
|
||||
Set AnalogTV = TS
|
||||
End If
|
||||
Next
|
||||
|
||||
If Not (AnalogTV.UniqueName = "Cable") Then
|
||||
MsgBox ("Couldn't find the cable TV tuning space on your system. Re-install this tuning space.")
|
||||
Call cmdPowerOff_click
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
'Create an AnalogTV tune request and view it
|
||||
Set AnalogTune = AnalogTV.CreateTuneRequest
|
||||
AnalogTune.Channel = 5
|
||||
VidControl.View AnalogTune
|
||||
CheckError "There was a problem with passing the analog TV tune request to the MSVidCtl.View() method."
|
||||
|
||||
'Set FeaturesActive to nothing to disable CC (if it is on)
|
||||
Set FeaturesColl = New MSVidFeatures
|
||||
Set FeaturesColl = Nothing
|
||||
VidControl.FeaturesActive = FeaturesColl
|
||||
CheckError "There was a problem with setting the FeaturesActive collection to NULL."
|
||||
|
||||
VidControl.Run
|
||||
CheckError "There was a problem running the graph. Check that your TV tuner card and video card are properly installed."
|
||||
If (VidControl.State = STATE_UNBUILT) Then
|
||||
Call cmdPowerOff_click
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
txtChannel.Text = VidControl.InputActive.Tune.Channel
|
||||
Call MakeAnalogTVToolsVisible
|
||||
|
||||
'NTSC Analog TV playback init w/CC
|
||||
ElseIf cbSource.Text = "NTSC Analog TV w/CC" Then
|
||||
'Find all of the AnalogTV tuning spaces
|
||||
Set TuningSpaceCollection = TuningSpaceContainer.TuningSpacesForCLSID(NTSC_GUID)
|
||||
If TuningSpaceCollection.Count = 0 Then
|
||||
MsgBox ("Couldn't find an NTSC Tuning Space.")
|
||||
Call cmdPowerOff_click
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
'Pick the tuning space named Cable
|
||||
For Each TS In TuningSpaceCollection
|
||||
If TS.UniqueName = "Cable" Then
|
||||
Set AnalogTV = TS
|
||||
End If
|
||||
Next
|
||||
|
||||
If Not (AnalogTV.UniqueName = "Cable") Then
|
||||
MsgBox ("Couldn't find the cable TV tuning space on your system. Please reinstall this tuning space.")
|
||||
Call cmdPowerOff_click
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
'Create an AnalogTV tune request and view it
|
||||
Set AnalogTune = AnalogTV.CreateTuneRequest
|
||||
AnalogTune.Channel = 5
|
||||
VidControl.View AnalogTune
|
||||
CheckError "There was a problem with passing the analog TV tune request to the MSVidCtl.View() method."
|
||||
|
||||
'Enable CC
|
||||
Set FeaturesAvailableColl = VidControl.FeaturesAvailable
|
||||
CheckError "There was a problem getting the FeaturesAvailable collection."
|
||||
|
||||
For Each Feature In FeaturesAvailableColl
|
||||
If Feature.ClassID = CC_GUID Then
|
||||
Dim CCObj As MSVidClosedCaptioning
|
||||
Set CCObj = Feature
|
||||
CCObj.Enable = True
|
||||
FeaturesColl.Add Feature
|
||||
CheckError "There was a problem adding a feature to the collection."
|
||||
ElseIf Feature.ClassID = DATASVC_GUID Then
|
||||
FeaturesColl.Add Feature
|
||||
CheckError "There was a problem adding a feature to the collection."
|
||||
End If
|
||||
Next
|
||||
|
||||
VidControl.FeaturesActive = FeaturesColl
|
||||
CheckError "There was a problem with setting the FeaturesActive collection."
|
||||
|
||||
VidControl.Run
|
||||
CheckError "There was a problem running the graph. Check that your TV tuner card and video card are properly installed."
|
||||
If (VidControl.State = STATE_UNBUILT) Then
|
||||
Call cmdPowerOff_click
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
txtChannel.Text = VidControl.InputActive.Tune.Channel
|
||||
Call MakeAnalogTVToolsVisible
|
||||
|
||||
'Digital TV playback init
|
||||
ElseIf cbSource.Text = "ATSC Digital Antenna TV" Then
|
||||
'Find the all of ATSC tuning spaces
|
||||
Set TuningSpaceCollection = TuningSpaceContainer.TuningSpacesForCLSID(ATSC_GUID)
|
||||
If TuningSpaceCollection.Count = 0 Then
|
||||
MsgBox ("Couldn't find an ATSC Tuning Space.")
|
||||
Call cmdPowerOff_click
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
'Pick the tuning space named ATSC
|
||||
For Each TS In TuningSpaceCollection
|
||||
If TS.UniqueName = "ATSC" Then
|
||||
Set ATSCTV = TS
|
||||
End If
|
||||
Next
|
||||
|
||||
If Not (ATSCTV.UniqueName = "ATSC") Then
|
||||
MsgBox ("Couldn't find the ATSC TV tuning space on your system. Please reinstall this tuning space.")
|
||||
Call cmdPowerOff_click
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
'Create a ATSC tune request and view it
|
||||
Set ATSCTune = ATSCTV.CreateTuneRequest
|
||||
ATSCLoc.PhysicalChannel = 46
|
||||
ATSCTune.Channel = -1
|
||||
ATSCTune.MinorChannel = -1
|
||||
ATSCTune.Locator = ATSCLoc
|
||||
|
||||
'Set FeaturesActive to nothing to disable CC (if it is on)
|
||||
Set FeaturesColl = New MSVidFeatures
|
||||
'Set FeaturesColl = Nothing
|
||||
VidControl.FeaturesActive = FeaturesColl
|
||||
CheckError "There was a problem with setting the FeaturesActive collection to NULL."
|
||||
VidControl.View ATSCTune
|
||||
CheckError "There was a problem with passing the ATSC tune request to the MSVidCtl.View() method."
|
||||
VidControl.Build
|
||||
CheckError "Build"
|
||||
VidControl.Run
|
||||
CheckError "There was a problem running the graph. Check that your TV tuner card and video card are properly installed."
|
||||
If (VidControl.State = STATE_UNBUILT) Then
|
||||
Call cmdPowerOff_click
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
txtPhysicalChannel.Text = VidControl.InputActive.Tune.Locator.PhysicalChannel
|
||||
txtMinorChannel.Text = VidControl.InputActive.Tune.MinorChannel
|
||||
Call MakeDigitalTVToolsVisible
|
||||
'Hide these two buttons, as we can't mix in this mode
|
||||
cmdCapture.Visible = False
|
||||
cmdCaptureOff.Visible = False
|
||||
|
||||
'Digital TV w/CC playback init
|
||||
ElseIf cbSource.Text = "ATSC Digital Antenna TV w/CC & Mixing Mode" Then
|
||||
'Find the all of ATSC tuning spaces
|
||||
Set TuningSpaceCollection = TuningSpaceContainer.TuningSpacesForCLSID(ATSC_GUID)
|
||||
If TuningSpaceCollection.Count = 0 Then
|
||||
MsgBox ("Couldn't find an ATSC Tuning Space.")
|
||||
Call cmdPowerOff_click
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
'Pick the tuning space named ATSC
|
||||
For Each TS In TuningSpaceCollection
|
||||
If TS.UniqueName = "ATSC" Then
|
||||
Set ATSCTV = TS
|
||||
End If
|
||||
Next
|
||||
|
||||
If Not (ATSCTV.UniqueName = "ATSC") Then
|
||||
MsgBox ("Couldn't find the ATSC TV tuning space on your system. Please reinstall this tuning space.")
|
||||
Call cmdPowerOff_click
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
'Create a ATSC tune request and view it
|
||||
Set ATSCTune = ATSCTV.CreateTuneRequest
|
||||
ATSCLoc.PhysicalChannel = 46
|
||||
ATSCTune.Channel = -1
|
||||
ATSCTune.MinorChannel = -1
|
||||
ATSCTune.Locator = ATSCLoc
|
||||
VidControl.View ATSCTune
|
||||
CheckError "There was a problem with passing the ATSC tune request to the MSVidCtl.View() method."
|
||||
|
||||
'Enable CC (and mixing mode)
|
||||
Set FeaturesAvailableColl = VidControl.FeaturesAvailable
|
||||
CheckError "There was a problem getting the FeaturesAvailable collection."
|
||||
|
||||
For Each Feature In FeaturesAvailableColl
|
||||
If Feature.ClassID = CC_GUID Then
|
||||
FeaturesColl.Add Feature
|
||||
CheckError "There was a problem adding a feature to the collection."
|
||||
End If
|
||||
Next
|
||||
|
||||
VidControl.FeaturesActive = FeaturesColl
|
||||
CheckError "There was a problem with putting the FeaturesActive collection."
|
||||
|
||||
VidControl.Run
|
||||
CheckError "There was a problem running the graph. Check that your TV tuner card and video card are properly installed."
|
||||
If (VidControl.State = STATE_UNBUILT) Then
|
||||
Call cmdPowerOff_click
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
txtPhysicalChannel.Text = VidControl.InputActive.Tune.Locator.PhysicalChannel
|
||||
txtMinorChannel.Text = VidControl.InputActive.Tune.MinorChannel
|
||||
Call MakeDigitalTVToolsVisible
|
||||
|
||||
'Digital DVB-S TV playback init
|
||||
ElseIf cbSource.Text = "DVB-S Digital TV" Then
|
||||
'Find all of the DVB-S tuning spaces
|
||||
Set TuningSpaceCollection = TuningSpaceContainer.TuningSpacesForCLSID(DVBS_GUID)
|
||||
If TuningSpaceCollection.Count = 0 Then
|
||||
MsgBox ("Couldn't find a DVB Tuning Space.")
|
||||
Call cmdPowerOff_click
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
'Pick any DVB-S tuning space we find
|
||||
For Each TS In TuningSpaceCollection
|
||||
If TS.UniqueName = "MYDVB" Then
|
||||
Set DVBSTV = TS
|
||||
Exit For
|
||||
End If
|
||||
Next
|
||||
|
||||
If (IsNull(DVBSTV)) Then
|
||||
'If there is no tuning space exit
|
||||
MsgBox ("No MYDVB tuning space found. Please run the ViewDVB.htm file first")
|
||||
Call cmdPowerOff_click
|
||||
End If
|
||||
'Create a DVB tune request and view it
|
||||
Set DVBTune = DVBSTV.CreateTuneRequest
|
||||
CheckError "There was a problem creating a DVB-S tune request."
|
||||
DVBTune.SID = 101
|
||||
|
||||
'Set FeaturesActive to nothing to disable CC (if it is on)
|
||||
Set FeaturesColl = New MSVidFeatures
|
||||
Set FeaturesColl = Nothing
|
||||
VidControl.FeaturesActive = FeaturesColl
|
||||
CheckError "There was a problem with setting the FeaturesActive collection to NULL."
|
||||
VidControl.View DVBTune
|
||||
CheckError "There was a problem with passing the DVB tune request to the MSVidCtl.View() method."
|
||||
VidControl.Run
|
||||
CheckError "There was a problem running the graph. Check that your TV tuner card and video card are properly installed."
|
||||
If (VidControl.State = STATE_UNBUILT) Then
|
||||
Call cmdPowerOff_click
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Call MakeDigitalTVToolsVisible
|
||||
txtSID.Visible = True
|
||||
lblSID.Visible = True
|
||||
cmdEnterDVB.Visible = True
|
||||
'Hide these buttons, as they aren't used for DVB
|
||||
cmdCapture.Visible = False
|
||||
cmdCaptureOff.Visible = False
|
||||
txtPhysicalChannel.Visible = False
|
||||
txtMinorChannel.Visible = False
|
||||
lblPhysicalChannel.Visible = False
|
||||
lblMinorChannel.Visible = False
|
||||
txtChannel.Visible = False
|
||||
cmdEnterATSC.Visible = False
|
||||
cmdSeekUpDigital.Visible = False
|
||||
cmdSeekDownDigital.Visible = False
|
||||
|
||||
'Digital DVB-S TV w/CC playback init
|
||||
ElseIf cbSource.Text = "DVB-S Digital TV w/CC & Mixing Mode" Then
|
||||
'Find all of the DVB-S tuning spaces
|
||||
Set TuningSpaceCollection = TuningSpaceContainer.TuningSpacesForCLSID(DVBS_GUID)
|
||||
If TuningSpaceCollection.Count = 0 Then
|
||||
MsgBox ("Couldn't find a DVB Tuning Space.")
|
||||
Call cmdPowerOff_click
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
'Pick any DVB-S tuning space we find
|
||||
For Each TS In TuningSpaceCollection
|
||||
If Not (TS Is Nothing) Then
|
||||
Set DVBSTV = TS
|
||||
End If
|
||||
Next
|
||||
|
||||
'Create a DVB tune request and view it
|
||||
Set DVBTune = DVBSTV.CreateTuneRequest
|
||||
CheckError "There was a problem creating the DVB-S tune request."
|
||||
DVBTune.SID = 101
|
||||
VidControl.View DVBTune
|
||||
CheckError "There was a problem with passing the DVB tune request to the MSVidCtl.View() method."
|
||||
|
||||
'Enable CC (and mixing mode)
|
||||
Set FeaturesAvailableColl = VidControl.FeaturesAvailable
|
||||
CheckError "There was a problem getting the FeaturesAvailable collection."
|
||||
|
||||
For Each Feature In FeaturesAvailableColl
|
||||
If Feature.ClassID = CC_GUID Then
|
||||
FeaturesColl.Add Feature
|
||||
CheckError "There was a problem adding a feature to the collection."
|
||||
End If
|
||||
Next
|
||||
|
||||
VidControl.FeaturesActive = FeaturesColl
|
||||
CheckError "There was a problem with putting the FeaturesActive collection."
|
||||
|
||||
VidControl.Run
|
||||
CheckError "There was a problem running the graph. Check that your TV tuner card and video card are properly installed."
|
||||
If (VidControl.State = STATE_UNBUILT) Then
|
||||
Call cmdPowerOff_click
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Call MakeDigitalTVToolsVisible
|
||||
txtSID.Visible = True
|
||||
lblSID.Visible = True
|
||||
cmdEnterDVB.Visible = True
|
||||
'Hide the objects that aren't needed for DVB
|
||||
txtPhysicalChannel.Visible = False
|
||||
txtMinorChannel.Visible = False
|
||||
lblPhysicalChannel.Visible = False
|
||||
lblMinorChannel.Visible = False
|
||||
txtChannel.Visible = False
|
||||
cmdEnterATSC.Visible = False
|
||||
cmdSeekUpDigital.Visible = False
|
||||
cmdSeekDownDigital.Visible = False
|
||||
|
||||
'User didn't pick a playback type
|
||||
Else
|
||||
MsgBox "You have chosen a playback type that is not implemented. Please try again."
|
||||
End If
|
||||
|
||||
Exit Sub
|
||||
|
||||
ON_ERROR:
|
||||
Call ProcessGeneralErorr
|
||||
End Sub
|
||||
|
||||
Sub ProcessGeneralErorr()
|
||||
On Error Resume Next
|
||||
VidControl.Stop
|
||||
VidControl.Decompose
|
||||
ATSCTune = Null
|
||||
AnalogTune = Null
|
||||
DVBTune = Null
|
||||
AnalogTV = Null
|
||||
ATSCTV = Null
|
||||
DVBSTV = Null
|
||||
ATSCLoc = Null
|
||||
CheckError "General error - graph cannot run"
|
||||
End Sub
|
||||
|
||||
'User is done with this playback
|
||||
Sub cmdPowerOff_click()
|
||||
On Error Resume Next
|
||||
Call HideTools
|
||||
VidControl.Stop
|
||||
VidControl.Decompose
|
||||
|
||||
CheckError "There was a problem tearing down the graph."
|
||||
End Sub
|
||||
|
||||
Sub MakeAnalogTVToolsVisible()
|
||||
'Make the appropriate analog TV controls visible
|
||||
cmdPowerOff.Visible = True
|
||||
cmdCapture.Visible = True
|
||||
cmdCaptureOff.Visible = True
|
||||
cmdEnterAnalog.Visible = True
|
||||
lblChannel.Visible = True
|
||||
txtChannel.Visible = True
|
||||
lblSourceInUse.Caption = cbSource.Text
|
||||
lblSourceInUse.Visible = True
|
||||
cbSource.Visible = False
|
||||
txtChannel.Text = AnalogTune.Channel
|
||||
cmdVolumeUp.Visible = True
|
||||
cmdVolumeDown.Visible = True
|
||||
cmdSeekUpAnalog.Visible = True
|
||||
cmdSeekDownAnalog.Visible = True
|
||||
cmdViewNext.Visible = True
|
||||
cmdInfo.Visible = True
|
||||
End Sub
|
||||
|
||||
Sub MakeDigitalTVToolsVisible()
|
||||
'Make the appropriate TV controls visible
|
||||
cmdPowerOff.Visible = True
|
||||
cmdCapture.Visible = True
|
||||
cmdCaptureOff.Visible = True
|
||||
cmdSeekUpDigital.Visible = True
|
||||
cmdSeekDownDigital.Visible = True
|
||||
cmdEnterATSC.Visible = True
|
||||
lblSourceInUse.Caption = cbSource.Text
|
||||
cbSource.Visible = False
|
||||
lblSourceInUse.Visible = True
|
||||
lblMinorChannel.Visible = True
|
||||
txtMinorChannel.Visible = True
|
||||
lblPhysicalChannel.Visible = True
|
||||
txtPhysicalChannel.Visible = True
|
||||
cmdVolumeUp.Visible = True
|
||||
cmdVolumeDown.Visible = True
|
||||
cmdViewNext.Visible = True
|
||||
cmdInfo.Visible = True
|
||||
End Sub
|
||||
|
||||
'Hide all the controls we don't need to see
|
||||
Sub HideTools()
|
||||
cmdPowerOff.Visible = False
|
||||
cmdCapture.Visible = False
|
||||
cmdCaptureOff.Visible = False
|
||||
cmdSeekUpAnalog.Visible = False
|
||||
cmdSeekDownAnalog.Visible = False
|
||||
cmdSeekUpDigital.Visible = False
|
||||
cmdSeekDownDigital.Visible = False
|
||||
cmdEnterATSC.Visible = False
|
||||
cmdEnterAnalog.Visible = False
|
||||
lblChannel.Visible = False
|
||||
txtChannel.Visible = False
|
||||
cbSource.Visible = True
|
||||
lblSourceInUse.Visible = False
|
||||
lblMinorChannel.Visible = False
|
||||
txtMinorChannel.Visible = False
|
||||
lblPhysicalChannel.Visible = False
|
||||
txtPhysicalChannel.Visible = False
|
||||
cmdVolumeUp.Visible = False
|
||||
cmdVolumeDown.Visible = False
|
||||
cmdViewNext.Visible = False
|
||||
txtSID.Visible = False
|
||||
cmdEnterDVB.Visible = False
|
||||
lblSID.Visible = False
|
||||
lblInfo.Visible = False
|
||||
cmdInfo.Visible = False
|
||||
End Sub
|
||||
|
||||
'User presses Enter button to change a DVB-S channel
|
||||
Private Sub cmdEnterDVB_Click()
|
||||
On Error Resume Next
|
||||
DVBTune.SID = txtSID.Text
|
||||
VidControl.View DVBTune
|
||||
CheckError "There was a problem with passing the DVB tune request to the MSVidCtl.View() method."
|
||||
End Sub
|
||||
|
||||
'User presses Enter button to change a ATSC channel
|
||||
Private Sub cmdEnterATSC_Click()
|
||||
On Error Resume Next
|
||||
ATSCLoc.PhysicalChannel = txtPhysicalChannel.Text
|
||||
ATSCTune.Locator = ATSCLoc
|
||||
ATSCTune.MinorChannel = txtMinorChannel.Text
|
||||
ATSCTune.Channel = -1
|
||||
VidControl.View ATSCTune
|
||||
CheckError "There was a problem with passing the ATSC tune request to the MSVidCtl.View() method."
|
||||
|
||||
txtPhysicalChannel.Text = VidControl.InputActive.Tune.Locator.PhysicalChannel
|
||||
txtMinorChannel.Text = VidControl.InputActive.Tune.MinorChannel
|
||||
End Sub
|
||||
|
||||
'User presses Enter button to change a NTSC channel
|
||||
Private Sub cmdEnterAnalog_Click()
|
||||
On Error Resume Next
|
||||
AnalogTune.Channel = txtChannel.Text
|
||||
VidControl.View AnalogTune
|
||||
CheckError "There was a problem with passing the analog TV tune request to the MSVidCtl.View() method."
|
||||
|
||||
txtChannel.Text = VidControl.InputActive.Tune.Channel
|
||||
End Sub
|
||||
|
||||
'Change volume
|
||||
Private Sub cmdVolumeUp_Click()
|
||||
On Error Resume Next
|
||||
If (VidControl.AudioRendererActive.Volume < 0) Then
|
||||
VidControl.AudioRendererActive.Volume = VidControl.AudioRendererActive.Volume + 1000
|
||||
CheckError "There was a problem with changing the volume."
|
||||
'Else
|
||||
' MsgBox "Volume is set to maximum."
|
||||
End If
|
||||
End Sub
|
||||
|
||||
'Change volume
|
||||
Private Sub cmdVolumeDown_Click()
|
||||
On Error Resume Next
|
||||
If (VidControl.AudioRendererActive.Volume > -10000) Then
|
||||
VidControl.AudioRendererActive.Volume = VidControl.AudioRendererActive.Volume - 1000
|
||||
CheckError "There was a problem with changing the volume."
|
||||
'Else
|
||||
' MsgBox "Volume is set to minimum."
|
||||
End If
|
||||
End Sub
|
||||
|
||||
'Channel change up for ATSC
|
||||
Private Sub cmdSeekUpDigital_Click()
|
||||
On Error Resume Next
|
||||
ATSCLoc.PhysicalChannel = ATSCLoc.PhysicalChannel + 1
|
||||
ATSCTune.Locator = ATSCLoc
|
||||
ATSCTune.MinorChannel = -1
|
||||
ATSCTune.Channel = -1
|
||||
VidControl.View ATSCTune
|
||||
CheckError "There was a problem with passing the ATSC tune request to the MSVidCtl.View() method."
|
||||
|
||||
txtPhysicalChannel.Text = VidControl.InputActive.Tune.Locator.PhysicalChannel
|
||||
txtMinorChannel.Text = VidControl.InputActive.Tune.MinorChannel
|
||||
End Sub
|
||||
|
||||
'Channel change down for ATSC
|
||||
Private Sub cmdSeekDownDigital_Click()
|
||||
On Error Resume Next
|
||||
ATSCLoc.PhysicalChannel = ATSCLoc.PhysicalChannel - 1
|
||||
ATSCTune.Locator = ATSCLoc
|
||||
ATSCTune.MinorChannel = -1
|
||||
ATSCTune.Channel = -1
|
||||
VidControl.View ATSCTune
|
||||
CheckError "There was a problem with passing the ATSC tune request to the MSVidCtl.View() method."
|
||||
|
||||
txtPhysicalChannel.Text = VidControl.InputActive.Tune.Locator.PhysicalChannel
|
||||
txtMinorChannel.Text = VidControl.InputActive.Tune.MinorChannel
|
||||
End Sub
|
||||
|
||||
'Channel change up for NTSC
|
||||
Private Sub cmdSeekUpAnalog_Click()
|
||||
On Error Resume Next
|
||||
AnalogTune.Channel = AnalogTune.Channel + 1
|
||||
VidControl.View AnalogTune
|
||||
CheckError "There was a problem with passing the ATSC tune request to the MSVidCtl.View() method."
|
||||
|
||||
txtChannel.Text = VidControl.InputActive.Tune.Channel
|
||||
End Sub
|
||||
|
||||
'Channel change down for NTSC
|
||||
Private Sub cmdSeekDownAnalog_Click()
|
||||
On Error Resume Next
|
||||
AnalogTune.Channel = AnalogTune.Channel - 1
|
||||
VidControl.View AnalogTune
|
||||
CheckError "There was a problem with passing the ATSC tune request to the MSVidCtl.View() method."
|
||||
|
||||
txtChannel.Text = VidControl.InputActive.Tune.Channel
|
||||
End Sub
|
||||
|
||||
'Capture current video frame and alpha blend over video
|
||||
Private Sub cmdCapture_Click()
|
||||
On Error Resume Next
|
||||
Dim Alpha As Integer
|
||||
Dim TempVidRend As MSVidVideoRenderer
|
||||
Dim MyRect As IMSVidRect
|
||||
Dim Pict As IPictureDisp
|
||||
|
||||
'The amount of opacity for the image over video is 75% visible
|
||||
Alpha = 75
|
||||
|
||||
'Get the current video renderer
|
||||
Set TempVidRend = VidControl.VideoRendererActive
|
||||
CheckError "Failed to retrieve the current video renderer."
|
||||
|
||||
'Capture the frame of video
|
||||
Set Pict = TempVidRend.Capture
|
||||
CheckError "Failed to capture the video frame."
|
||||
|
||||
'Set the properties for the image and then display it
|
||||
TempVidRend.MixerBitmap = Pict
|
||||
TempVidRend.MixerBitmapOpacity = Alpha
|
||||
Set MyRect = TempVidRend.MixerBitmapPositionRect
|
||||
MyRect.Top = 10
|
||||
MyRect.Left = 10
|
||||
MyRect.Height = (VidControl.Height) / 4
|
||||
MyRect.Width = (VidControl.Width) / 4
|
||||
TempVidRend.MixerBitmapPositionRect = MyRect
|
||||
CheckError "Failed to display the frame capture. Your video card may not be compatible with the WindowsXP Video Mixing Renderer."
|
||||
End Sub
|
||||
|
||||
'Remove the alpha blended image
|
||||
Private Sub cmdCaptureOff_Click()
|
||||
On Error Resume Next
|
||||
Dim TempVidRend As MSVidVideoRenderer
|
||||
Set TempVidRend = VidControl.VideoRendererActive
|
||||
CheckError "Failed to retrieve the current video renderer."
|
||||
TempVidRend.MixerBitmap = Nothing
|
||||
CheckError "Failed to disable MixerBitmap."
|
||||
End Sub
|
||||
|
||||
Private Sub cmdViewNext_Click()
|
||||
'Try the next tuner device
|
||||
On Error Resume Next
|
||||
VidControl.Stop
|
||||
If VidControl.InputActive.TuningSpace.CLSID = NTSC_GUID Then
|
||||
VidControl.ViewNext AnalogTune
|
||||
CheckError "Failed to ViewNext for NTSC."
|
||||
ElseIf VidControl.InputActive.TuningSpace.CLSID = ATSC_GUID Then
|
||||
VidControl.ViewNext ATSCTune
|
||||
CheckError "Failed to ViewNext for ATSC."
|
||||
ElseIf VidControl.InputActive.TuningSpace.CLSID = DVBS_GUID Then
|
||||
VidControl.ViewNext DVBTune
|
||||
CheckError "Failed to ViewNext for DVB."
|
||||
Else
|
||||
MsgBox "There is not a tuning space to match the current InputActive."
|
||||
End If
|
||||
VidControl.Run
|
||||
CheckError "Unable to run after changing InputActive."
|
||||
End Sub
|
||||
|
||||
Private Sub cmdInfo_Click()
|
||||
'Display Input Name and FPS
|
||||
lblInfo.Visible = True
|
||||
lblInfo.Caption = "Device Name: " & VidControl.InputActive.Name & " FPS: " & (VidControl.VideoRendererActive.FramesPerSecond / 100)
|
||||
End Sub
|
||||
|
||||
Binary file not shown.
@@ -0,0 +1,34 @@
|
||||
Windows XP DirectShow Sample -- Visual Basic Video Control
|
||||
-----------------------------------------------------------
|
||||
|
||||
This sample demonstrates using the Microsoft Video Control to view
|
||||
digital television in a window.
|
||||
|
||||
When VBVideoControl launches, it presents you with a list of network
|
||||
providers. Choose a network provider that is available in your area
|
||||
(such as ATSC Digital Antenna TV) and click the Power On button.
|
||||
VBVideoControl will attempt to build a filter graph with the
|
||||
selected network provider.
|
||||
|
||||
If successful, it will update the Visual Basic form to display
|
||||
additional buttons, which you may use to change channels, adjust volume,
|
||||
display device information, and select tuners. You may click Power Off
|
||||
to clear the form and select another tuner.
|
||||
|
||||
NOTE: It may take several seconds to completely build the digital
|
||||
television filter graph, so please be patient.
|
||||
|
||||
|
||||
Requirements
|
||||
------------
|
||||
|
||||
- Windows XP (or greater) operating system
|
||||
|
||||
- BDA-compatible digital tuner card, such as the Broadlogic DTA-100 receiver.
|
||||
|
||||
- If you select ATSC digital TV, you will need an ATSC digital tuner card.
|
||||
- If you select DVB digital TV, you will need a DVB digital tuner card.
|
||||
- If you select NTSC Analog TV, you will need an NTSC Analog tuner card.
|
||||
|
||||
- MPEG-2 decoder (for example, a software DVD decoder)
|
||||
|
||||
Reference in New Issue
Block a user