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,298 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form frmSelectPin
|
||||
Caption = "Connect to Pin"
|
||||
ClientHeight = 3210
|
||||
ClientLeft = 4890
|
||||
ClientTop = 4920
|
||||
ClientWidth = 6270
|
||||
LinkTopic = "Form2"
|
||||
LockControls = -1 'True
|
||||
PaletteMode = 1 'UseZOrder
|
||||
ScaleHeight = 3210
|
||||
ScaleWidth = 6270
|
||||
StartUpPosition = 2 'CenterScreen
|
||||
Begin VB.ListBox listPins
|
||||
Height = 1425
|
||||
ItemData = "Selpin.frx":0000
|
||||
Left = 3360
|
||||
List = "Selpin.frx":0002
|
||||
TabIndex = 3
|
||||
Top = 360
|
||||
Width = 2655
|
||||
End
|
||||
Begin VB.ListBox listFilters
|
||||
Height = 1425
|
||||
ItemData = "Selpin.frx":0004
|
||||
Left = 240
|
||||
List = "Selpin.frx":0006
|
||||
TabIndex = 2
|
||||
Top = 360
|
||||
Width = 2655
|
||||
End
|
||||
Begin VB.CommandButton Cancel
|
||||
Cancel = -1 'True
|
||||
Caption = "Cancel"
|
||||
Height = 375
|
||||
Left = 3360
|
||||
TabIndex = 1
|
||||
Top = 2640
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.CommandButton OK
|
||||
Caption = "OK"
|
||||
Default = -1 'True
|
||||
Height = 375
|
||||
Left = 1920
|
||||
TabIndex = 0
|
||||
Top = 2640
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.Label Label2
|
||||
Caption = "Pins"
|
||||
Height = 252
|
||||
Left = 3240
|
||||
TabIndex = 7
|
||||
Top = 120
|
||||
Width = 492
|
||||
End
|
||||
Begin VB.Label VendorInfoLabel
|
||||
Caption = "Vendor Info:"
|
||||
Height = 252
|
||||
Left = 120
|
||||
TabIndex = 6
|
||||
Top = 2160
|
||||
Width = 972
|
||||
End
|
||||
Begin VB.Label VendorInfo
|
||||
Height = 252
|
||||
Left = 1320
|
||||
TabIndex = 5
|
||||
Top = 2160
|
||||
Visible = 0 'False
|
||||
Width = 2772
|
||||
End
|
||||
Begin VB.Label Label1
|
||||
Caption = "Filters"
|
||||
Height = 255
|
||||
Left = 120
|
||||
TabIndex = 4
|
||||
Top = 120
|
||||
Width = 495
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmSelectPin"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
'*******************************************************************************
|
||||
'* This is a part of the Microsoft DXSDK 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.
|
||||
'* See these sources for detailed information regarding the
|
||||
'* Microsoft samples programs.
|
||||
'*******************************************************************************
|
||||
Option Explicit
|
||||
Option Base 0
|
||||
Option Compare Text
|
||||
|
||||
Public g_objFI As IFilterInfo
|
||||
Public g_objPI As IPinInfo
|
||||
Public g_objMC As IMediaControl
|
||||
|
||||
Public OtherDir As Long
|
||||
Public bOK As Boolean
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- INTRINSIC VBFORM EVENT HANDLERS
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Form_Load
|
||||
' * procedure description: fills the filters listbox with all filters in the current filter graph
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Form_Load()
|
||||
On Local Error GoTo ErrLine
|
||||
Call RefreshFilters
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- CONTROL EVENT HANDLERS
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Cancel_Click
|
||||
' * procedure description: cancel command button click event- no pin connection is made
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Cancel_Click()
|
||||
On Local Error GoTo ErrLine
|
||||
bOK = False: Call Hide
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: listFilters_Click
|
||||
' * procedure description: when the user clicks on a specific filter in the filter graph, this creates the
|
||||
' * list of pins for that filter in the pin listbox
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub listFilters_Click()
|
||||
Dim pin As IPinInfo
|
||||
Dim pfilter As IFilterInfo
|
||||
Dim pinOther As IPinInfo
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'enumerate through each filter in the filter collection
|
||||
For Each pfilter In g_objMC.FilterCollection
|
||||
If LCase(pfilter.Name) = LCase(listFilters.Text) Then
|
||||
' display the information and pins for the selected filter
|
||||
Set g_objFI = pfilter ' global FilterInfo object
|
||||
VendorInfo.Caption = pfilter.VendorInfo
|
||||
listPins.Clear
|
||||
'enumerate through each pin in the filter
|
||||
For Each pin In pfilter.Pins
|
||||
Set pinOther = pin.ConnectedTo
|
||||
If Err.Number <> 0 Then
|
||||
If pin.Direction <> OtherDir Then
|
||||
'append the pin's name to the listbox
|
||||
listPins.AddItem pin.Name
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
Next
|
||||
|
||||
'reset the selected index
|
||||
If listPins.ListCount > 0 Then
|
||||
listPins.ListIndex = 0
|
||||
End If
|
||||
'clean-up & dereference local data
|
||||
If Not pin Is Nothing Then Set pin = Nothing
|
||||
If Not pfilter Is Nothing Then Set pfilter = Nothing
|
||||
If Not pinOther Is Nothing Then Set pinOther = Nothing
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Resume Next
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: RefreshFilters
|
||||
' * procedure description: fills the filters listbox with all filters in the current filter graph
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Sub RefreshFilters()
|
||||
Dim pin As IPinInfo
|
||||
Dim filter As IFilterInfo
|
||||
Dim pinOther As IPinInfo
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'clear the filter listbox
|
||||
listFilters.Clear
|
||||
|
||||
For Each filter In g_objMC.FilterCollection
|
||||
For Each pin In filter.Pins
|
||||
On Error Resume Next
|
||||
Set pinOther = pin.ConnectedTo
|
||||
If Err.Number <> 0 Then
|
||||
If pin.Direction <> OtherDir Then
|
||||
listFilters.AddItem filter.Name
|
||||
Exit For
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
Next
|
||||
|
||||
'reset the list index
|
||||
If listFilters.ListCount > 0 Then
|
||||
listFilters.ListIndex = 0
|
||||
End If
|
||||
|
||||
'clean-up & dereference local data
|
||||
If Not pin Is Nothing Then Set pin = Nothing
|
||||
If Not filter Is Nothing Then Set filter = Nothing
|
||||
If Not pinOther Is Nothing Then Set pinOther = Nothing
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Resume Next
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: OK_Click
|
||||
' * procedure description: connect the selected pins, if possible. if no connection is possible, the pin
|
||||
' * selection box closes and the program continues normally.
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub OK_Click()
|
||||
Dim objPinInfo As IPinInfo
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
For Each objPinInfo In g_objFI.Pins
|
||||
If objPinInfo.Name = listPins.Text Then
|
||||
Set g_objPI = objPinInfo
|
||||
bOK = True
|
||||
Exit For
|
||||
End If
|
||||
Next
|
||||
|
||||
'unload form
|
||||
Unload Me
|
||||
|
||||
'clean-up & dereference local data
|
||||
If Not objPinInfo Is Nothing Then Set objPinInfo = Nothing
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: listPins_Click
|
||||
' * procedure description: When a new pin is selected, store it in the module-level pin object
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub listPins_Click()
|
||||
Dim objPinInfo As IPinInfo
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'enumerate the pins
|
||||
For Each objPinInfo In g_objFI.Pins
|
||||
If LCase(objPinInfo.Name) = LCase(listPins.Text) Then
|
||||
Set g_objPI = objPinInfo 'reset the selected module-level pin
|
||||
End If
|
||||
Next
|
||||
|
||||
'clean-up & dereference local data
|
||||
If Not objPinInfo Is Nothing Then Set objPinInfo = Nothing
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -0,0 +1,45 @@
|
||||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#c:\WINNT\System32\stdole2.tlb#Standard OLE Types
|
||||
Reference=*\G{56A868B0-0AD4-11CE-B03A-0020AF0BA770}#1.0#0#c:\WINNT\System32\quartz.dll#Quartz control type library
|
||||
Reference=*\G{4E6CDE29-C0C4-11D0-8FF1-00C04FD9189D}#1.0#0#c:\WINNT\System32\amstream.dll#DirectShowStream 1.0 Type Library
|
||||
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C602}#1.0#0#c:\WINNT\System32\dx7vb.dll#DirectX 7 for Visual Basic Type Library
|
||||
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; comdlg32.ocx
|
||||
Form=builder.FRM
|
||||
Form=Selpin.frm
|
||||
IconForm="frmMain"
|
||||
Startup="frmMain"
|
||||
HelpFile=""
|
||||
Title="Builder"
|
||||
ExeName32="VB_Builder.exe"
|
||||
Command32=""
|
||||
Name="BuilderVB"
|
||||
HelpContextID="0"
|
||||
Description="Microsoft Directshow Graph Builder Sample Application"
|
||||
CompatibleMode="0"
|
||||
MajorVer=8
|
||||
MinorVer=1
|
||||
RevisionVer=0
|
||||
AutoIncrementVer=0
|
||||
ServerSupportFiles=0
|
||||
VersionCompanyName="Microsoft Corporation"
|
||||
VersionFileDescription="Microsoft Directshow Graph Builder Sample Application"
|
||||
VersionLegalCopyright="Copyright (C) 1999-2001 Microsoft Corporation."
|
||||
CompilationType=0
|
||||
OptimizationType=0
|
||||
FavorPentiumPro(tm)=0
|
||||
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
|
||||
@@ -0,0 +1,9 @@
|
||||
DirectShow Sample -- Builder
|
||||
----------------------------
|
||||
|
||||
Graph building application for Microsoft Visual Basic.
|
||||
|
||||
This sample application demonstrates how to build custom filter graphs
|
||||
using Microsoft Visual Basic.
|
||||
|
||||
|
||||
@@ -0,0 +1,11 @@
|
||||
VisualBasic Helper Library
|
||||
--------------------------
|
||||
|
||||
This type library is a helper file to allow the user of the IFileSinkFilter
|
||||
interface from Visual Basic.
|
||||
|
||||
The IFileSinkFilter interface is not in the quartz.dll (ActiveMovie) type library
|
||||
because one of the methods has an AM_MEDIA_TYPE argument which prevents it from
|
||||
being called from VB. The DShowVBLib type library redefines the interface with
|
||||
a different pointer type to allow VB to call IFileSinkFilter::SetFileName.
|
||||
A null should be passed in for the pointer argument.
|
||||
@@ -0,0 +1,63 @@
|
||||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINNT\System32\stdole2.tlb#OLE Automation
|
||||
Reference=*\G{78530B68-61F9-11D2-8CAD-00A024580902}#1.0#0#C:\WINNT\System32\qedit.dll#Dexter 1.0 Type Library
|
||||
Reference=*\G{56A868B0-0AD4-11CE-B03A-0020AF0BA770}#1.0#0#C:\WINNT\System32\quartz.dll#ActiveMovie control type library
|
||||
Reference=*\G{4E6CDE29-C0C4-11D0-8FF1-00C04FD9189D}#1.0#0#C:\WINNT\System32\amstream.dll#DirectShowStream 1.0 Type Library
|
||||
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; comdlg32.ocx
|
||||
Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; MSCOMCTL.OCX
|
||||
Object={38911DA0-E448-11D0-84A3-00DD01104159}#1.1#0; COMCT332.OCX
|
||||
Form=frmAbout.frm
|
||||
Form=frmClip.frm
|
||||
Form=frmTransitions.frm
|
||||
Form=frmTimeline.frm
|
||||
Form=frmGroup.frm
|
||||
Form=frmComp.frm
|
||||
Form=frmEffect.frm
|
||||
Form=frmTrack.frm
|
||||
Module=modGeneral; modGeneral.bas
|
||||
Form=frmMain.frm
|
||||
Module=modRegistry; modRegistry.bas
|
||||
Module=modDexter; modDexter.bas
|
||||
Module=modGlobalData; modGlobalData.bas
|
||||
Class=VBQuartzHelper; QuartzHelper.cls
|
||||
Module=modDisposable; modDisposable.bas
|
||||
RelatedDoc=resources\doc\DexterVB.doc
|
||||
IconForm="frmMain"
|
||||
Startup="Sub Main"
|
||||
HelpFile=""
|
||||
Title="DexterVB"
|
||||
ExeName32="VB_Dexter.exe"
|
||||
Path32=""
|
||||
Command32=""
|
||||
Name="DexterVB"
|
||||
HelpContextID="0"
|
||||
Description="Microsoft Directshow Editing Services DexterVB Sample Application"
|
||||
CompatibleMode="0"
|
||||
MajorVer=8
|
||||
MinorVer=1
|
||||
RevisionVer=156
|
||||
AutoIncrementVer=1
|
||||
ServerSupportFiles=0
|
||||
VersionCompanyName="Microsoft Corporation"
|
||||
VersionFileDescription="Microsoft Directshow Editing Services DexterVB Sample Application"
|
||||
VersionLegalCopyright="Copyright (C) 1999-2001 Microsoft Corporation."
|
||||
VersionProductName="DexterVB"
|
||||
CompilationType=0
|
||||
OptimizationType=0
|
||||
FavorPentiumPro(tm)=0
|
||||
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
|
||||
@@ -0,0 +1,15 @@
|
||||
frmAbout = 340, 249, 1217, 931, C, 220, 220, 749, 696, C
|
||||
frmClip = 265, 261, 1204, 926, C, 277, 77, 731, 549, C
|
||||
frmTransitions = 66, 66, 917, 842, C, 106, 16, 735, 677, C
|
||||
frmTimeline = 90, 118, 1028, 845, C, 111, -2, 729, 545, C
|
||||
frmGroup = 92, 139, 997, 793, C, 198, 198, 727, 674, C
|
||||
frmComp = 154, 154, 1111, 760, C, 91, 75, 606, 398, C
|
||||
frmEffect = 148, 135, 1064, 771, C, 22, 22, 551, 498, C
|
||||
frmTrack = 184, 71, 977, 766, C, 44, 44, 573, 520, C
|
||||
modGeneral = 192, 234, 890, 831,
|
||||
frmMain = 209, 188, 789, 806, C, 0, 0, 0, 0, C
|
||||
modRegistry = 211, 136, 1205, 862, C
|
||||
modDexter = 151, 186, 917, 816, C
|
||||
modGlobalData = 124, 98, 849, 788, C
|
||||
VBQuartzHelper = 255, 142, 1233, 780,
|
||||
modDisposable = 196, 276, 1118, 902, C
|
||||
@@ -0,0 +1,336 @@
|
||||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
Persistable = 0 'NotPersistable
|
||||
DataBindingBehavior = 0 'vbNone
|
||||
DataSourceBehavior = 0 'vbNone
|
||||
MTSTransactionMode = 0 'NotAnMTSObject
|
||||
END
|
||||
Attribute VB_Name = "VBQuartzHelper"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = True
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
'*******************************************************************************
|
||||
'* This is a part of the Microsoft DXSDK 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.
|
||||
'* See these sources for detailed information regarding the
|
||||
'* Microsoft samples programs.
|
||||
'*******************************************************************************
|
||||
Option Explicit
|
||||
Option Base 0
|
||||
Option Compare Text
|
||||
|
||||
'IMediaControl is used for async rendering & control;
|
||||
'It is a derivitive interface of the FilterGraph Manager.
|
||||
Private m_objFilterGraphManager As IMediaControl
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PUBLIC INTERFACE- ENUMERATIONS
|
||||
' *
|
||||
' *
|
||||
Public Enum QTZSynchronicityConstants
|
||||
QTZSynchronous = 0 'Synchronous execution
|
||||
QTZAsynchronous = 1 'Asynchronous execution
|
||||
End Enum
|
||||
|
||||
Public Enum QTZStatusConstants
|
||||
QTZStatusStopped = 0 'State Stopped
|
||||
QTZStatusPaused = 1 'State Paused
|
||||
QTZStatusPlaying = 2 'State Playing
|
||||
End Enum
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PUBLIC INTERFACE- PROPERTIES
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: FilterGraph
|
||||
' * procedure description: Allows the client to get the encapsulated graph as a FilterGraph object
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Property Get FilterGraph() As FilgraphManager
|
||||
Attribute FilterGraph.VB_UserMemId = 0
|
||||
Attribute FilterGraph.VB_MemberFlags = "200"
|
||||
On Local Error GoTo ErrLine
|
||||
If Not m_objFilterGraphManager Is Nothing Then
|
||||
Set FilterGraph = m_objFilterGraphManager
|
||||
End If
|
||||
Exit Property
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Property
|
||||
End Property
|
||||
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: FilterGraph
|
||||
' * procedure description: Allows the client to set a constructed FilterGraph object for which to render and control.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Property Set FilterGraph(RHS As FilgraphManager)
|
||||
On Local Error GoTo ErrLine
|
||||
If Not RHS Is Nothing Then
|
||||
Set m_objFilterGraphManager = RHS
|
||||
End If
|
||||
Exit Property
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Property
|
||||
End Property
|
||||
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Position
|
||||
' * procedure description: Allows the client to get the current position within the context of the media.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Property Get Position() As Double
|
||||
Dim objPosition As IMediaPosition
|
||||
On Local Error GoTo ErrLine
|
||||
If Not m_objFilterGraphManager Is Nothing Then
|
||||
'derive the position control interface
|
||||
Set objPosition = m_objFilterGraphManager
|
||||
'set the current position using this interface
|
||||
Position = CDbl(objPosition.CurrentPosition)
|
||||
End If
|
||||
Exit Property
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Property
|
||||
End Property
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Position
|
||||
' * procedure description: Allows the client to set the current position within the context of the media.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Property Let Position(RHS As Double)
|
||||
Dim objPosition As IMediaPosition
|
||||
On Local Error GoTo ErrLine
|
||||
If Not m_objFilterGraphManager Is Nothing Then
|
||||
'derive the position control interface
|
||||
Set objPosition = m_objFilterGraphManager
|
||||
'set the current position using this interface
|
||||
objPosition.CurrentPosition = RHS
|
||||
End If
|
||||
Exit Property
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Property
|
||||
End Property
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Position
|
||||
' * procedure description: Allows the client to get the current state of the playback.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Property Get State(Optional Timeout As Long = 1000) As QTZStatusConstants
|
||||
Dim nResultant As Long
|
||||
Dim objControl As IMediaControl
|
||||
On Local Error GoTo ErrLine
|
||||
If Not m_objFilterGraphManager Is Nothing Then
|
||||
'derive the position control interface
|
||||
Set objControl = m_objFilterGraphManager
|
||||
'get the current state using this interface
|
||||
Call objControl.GetState(Timeout, nResultant)
|
||||
'return to client
|
||||
State = nResultant
|
||||
End If
|
||||
Exit Property
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Property
|
||||
End Property
|
||||
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Duration
|
||||
' * procedure description: Allows the client to get the media's duration.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Property Get Duration() As Double
|
||||
Dim objPosition As IMediaPosition
|
||||
On Local Error GoTo ErrLine
|
||||
If Not m_objFilterGraphManager Is Nothing Then
|
||||
Set objPosition = m_objFilterGraphManager
|
||||
Duration = CDbl(objPosition.Duration)
|
||||
End If
|
||||
Exit Property
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Property
|
||||
End Property
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: FPS
|
||||
' * procedure description: Allows the client to get the media's playback rate, in frames per second.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Property Get FPS() As Double
|
||||
Dim objPosition As IMediaPosition
|
||||
On Local Error GoTo ErrLine
|
||||
If Not m_objFilterGraphManager Is Nothing Then
|
||||
Set objPosition = m_objFilterGraphManager
|
||||
FPS = CDbl(objPosition.Rate)
|
||||
End If
|
||||
Exit Property
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Property
|
||||
End Property
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: StopTime
|
||||
' * procedure description: Allows the client to get the media's StopTime (when the media will hault playback)
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Property Get StopTime() As Double
|
||||
Dim objPosition As IMediaPosition
|
||||
On Local Error GoTo ErrLine
|
||||
If Not m_objFilterGraphManager Is Nothing Then
|
||||
Set objPosition = m_objFilterGraphManager
|
||||
StopTime = CDbl(objPosition.StopTime)
|
||||
End If
|
||||
Exit Property
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Property
|
||||
End Property
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PUBLIC INTERFACE- METHODS
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: StopGraph
|
||||
' * procedure description: Stop the rendering/playback of the graph.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Sub StopGraph()
|
||||
On Local Error GoTo ErrLine
|
||||
If Not m_objFilterGraphManager Is Nothing Then
|
||||
Call m_objFilterGraphManager.Stop
|
||||
End If
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: PauseGraph
|
||||
' * procedure description: Pauses the rendering/playback of the graph.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Sub PauseGraph()
|
||||
On Local Error GoTo ErrLine
|
||||
If Not m_objFilterGraphManager Is Nothing Then
|
||||
Call m_objFilterGraphManager.Pause
|
||||
End If
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: RunGraph
|
||||
' * procedure description: Renders the graph.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Sub RunGraph(Optional Synchronicity As QTZSynchronicityConstants = QTZAsynchronous)
|
||||
Dim objPosition As IMediaPosition
|
||||
Dim objControl As IMediaControl
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
If Not m_objFilterGraphManager Is Nothing Then
|
||||
Select Case Synchronicity
|
||||
Case QTZSynchronicityConstants.QTZSynchronous
|
||||
'run the graph
|
||||
Call m_objFilterGraphManager.Run
|
||||
'obtain the position of audio/video
|
||||
Set objPosition = m_objFilterGraphManager
|
||||
'loop with events
|
||||
Do: DoEvents
|
||||
If objPosition.CurrentPosition = objPosition.StopTime Then
|
||||
Call m_objFilterGraphManager.Stop
|
||||
Exit Do
|
||||
End If
|
||||
Loop
|
||||
|
||||
Case QTZSynchronicityConstants.QTZAsynchronous
|
||||
'the client desires to run the graph asynchronously
|
||||
Call m_objFilterGraphManager.Run
|
||||
End Select
|
||||
End If
|
||||
'clean-up & dereference
|
||||
If Not objPosition Is Nothing Then Set objPosition = Nothing
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PUBLIC INTERFACE- METHODS
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Class_Initialize
|
||||
' * procedure description: fired intrinsically by visual basic, occurs when this class initalizes
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Class_Initialize()
|
||||
On Local Error GoTo ErrLine
|
||||
Set m_objFilterGraphManager = New FilgraphManager
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Class_Terminate
|
||||
' * procedure description: fired intrinsically by visual basic, occurs when this class terminates
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Class_Terminate()
|
||||
On Local Error GoTo ErrLine
|
||||
If Not m_objFilterGraphManager Is Nothing Then Set m_objFilterGraphManager = Nothing
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
@@ -0,0 +1,236 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form frmAbout
|
||||
BorderStyle = 3 'Fixed Dialog
|
||||
Caption = "About Dexter VB Sample"
|
||||
ClientHeight = 3555
|
||||
ClientLeft = 60
|
||||
ClientTop = 345
|
||||
ClientWidth = 5730
|
||||
ClipControls = 0 'False
|
||||
Icon = "frmAbout.frx":0000
|
||||
LinkTopic = "Form2"
|
||||
LockControls = -1 'True
|
||||
MaxButton = 0 'False
|
||||
MinButton = 0 'False
|
||||
ScaleHeight = 2453.724
|
||||
ScaleMode = 0 'User
|
||||
ScaleWidth = 5380.766
|
||||
ShowInTaskbar = 0 'False
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
Begin VB.PictureBox picIcon
|
||||
AutoSize = -1 'True
|
||||
ClipControls = 0 'False
|
||||
Height = 540
|
||||
Left = 240
|
||||
Picture = "frmAbout.frx":030A
|
||||
ScaleHeight = 337.12
|
||||
ScaleMode = 0 'User
|
||||
ScaleWidth = 337.12
|
||||
TabIndex = 1
|
||||
Top = 240
|
||||
Width = 540
|
||||
End
|
||||
Begin VB.CommandButton cmdOK
|
||||
Cancel = -1 'True
|
||||
Caption = "OK"
|
||||
Default = -1 'True
|
||||
Height = 345
|
||||
Left = 4245
|
||||
TabIndex = 0
|
||||
Top = 2625
|
||||
Width = 1260
|
||||
End
|
||||
Begin VB.CommandButton cmdSysInfo
|
||||
Caption = "&System Info..."
|
||||
Height = 345
|
||||
Left = 4260
|
||||
TabIndex = 2
|
||||
Top = 3075
|
||||
Width = 1245
|
||||
End
|
||||
Begin VB.Line Line1
|
||||
BorderColor = &H00808080&
|
||||
BorderStyle = 6 'Inside Solid
|
||||
Index = 1
|
||||
X1 = 84.515
|
||||
X2 = 5309.398
|
||||
Y1 = 1687.583
|
||||
Y2 = 1687.583
|
||||
End
|
||||
Begin VB.Label lblDescription
|
||||
Caption = "Copyright (C) 1999-2001 Microsoft Corporation"
|
||||
ForeColor = &H00000000&
|
||||
Height = 1170
|
||||
Left = 1050
|
||||
TabIndex = 3
|
||||
Top = 825
|
||||
Width = 3885
|
||||
End
|
||||
Begin VB.Label lblTitle
|
||||
Caption = "VB Dexter Sample Application"
|
||||
ForeColor = &H00000000&
|
||||
Height = 255
|
||||
Left = 1050
|
||||
TabIndex = 5
|
||||
Top = 240
|
||||
Width = 3885
|
||||
End
|
||||
Begin VB.Line Line1
|
||||
BorderColor = &H00FFFFFF&
|
||||
BorderWidth = 2
|
||||
Index = 0
|
||||
X1 = 98.6
|
||||
X2 = 5309.398
|
||||
Y1 = 1697.936
|
||||
Y2 = 1697.936
|
||||
End
|
||||
Begin VB.Label lblVersion
|
||||
Caption = "Version 1.0"
|
||||
Height = 225
|
||||
Left = 1050
|
||||
TabIndex = 6
|
||||
Top = 525
|
||||
Width = 3885
|
||||
End
|
||||
Begin VB.Label lblDisclaimer
|
||||
Caption = "Warning: You must have DX8 or newer."
|
||||
ForeColor = &H00000000&
|
||||
Height = 825
|
||||
Left = 255
|
||||
TabIndex = 4
|
||||
Top = 2625
|
||||
Width = 3870
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmAbout"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
'*******************************************************************************
|
||||
'* This is a part of the Microsoft DXSDK 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.
|
||||
'* See these sources for detailed information regarding the
|
||||
'* Microsoft samples programs.
|
||||
'*******************************************************************************
|
||||
Option Explicit
|
||||
Option Base 0
|
||||
Option Compare Text
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- FORM EVENT HANDLERS
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Form_Load
|
||||
' * procedure description: Occurs when a form is loaded.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Form_Load()
|
||||
On Local Error GoTo ErrLine
|
||||
Me.Caption = "About " & App.Title: lblTitle.Caption = App.Title
|
||||
lblVersion.Caption = "Version " & CStr(App.Major) & "." & CStr(App.Minor) & "." & CStr(App.Revision)
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Form_QueryUnload
|
||||
' * procedure description: Occurs before a form or application closes.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
Select Case UnloadMode
|
||||
Case vbFormControlMenu
|
||||
'0 The user chose the Close command from the Control menu on the form.
|
||||
Case vbFormCode
|
||||
'1 The Unload statement is invoked from code.
|
||||
Case vbAppWindows
|
||||
'2 The current Microsoft Windows operating environment session is ending.
|
||||
Case vbAppTaskManager
|
||||
'3 The Microsoft Windows Task Manager is closing the application.
|
||||
End
|
||||
Case vbFormMDIForm
|
||||
'4 An MDI child form is closing because the MDI form is closing.
|
||||
Case vbFormOwner
|
||||
'5 A form is closing because its owner is closing
|
||||
End Select
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Form_Unload
|
||||
' * procedure description: Occurs when a form is about to be removed from the screen.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Form_Unload(Cancel As Integer)
|
||||
On Local Error GoTo ErrLine
|
||||
With Me
|
||||
.Move 0 - (Screen.Width * 8), 0 - (Screen.Height * 8): .Visible = False
|
||||
End With
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- CONTROL EVENT HANDLERS
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: cmdSysInfo_Click
|
||||
' * procedure description: occures when the 'System Information' command button is pressed
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub cmdSysInfo_Click()
|
||||
Dim bstrSysInfoPath As String
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'query the registry for a path to msinfo.exe, and execute the application for the user
|
||||
If Registry_DoesKeyExist(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Shared Tools\MSINFO") Then
|
||||
bstrSysInfoPath = Registry_QueryEntryValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Shared Tools\MSINFO", "Path", vbNullString)
|
||||
|
||||
Call Shell(bstrSysInfoPath, vbNormalFocus)
|
||||
End If
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: cmdOK_Click
|
||||
' * procedure description: occures when the 'ok' command button is pressed
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub cmdOk_Click()
|
||||
On Local Error GoTo ErrLine
|
||||
Unload Me
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
Binary file not shown.
@@ -0,0 +1,544 @@
|
||||
VERSION 5.00
|
||||
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
|
||||
Begin VB.Form frmClip
|
||||
Caption = "Clip Menu"
|
||||
ClientHeight = 5715
|
||||
ClientLeft = 60
|
||||
ClientTop = 345
|
||||
ClientWidth = 7005
|
||||
Icon = "frmClip.frx":0000
|
||||
LinkTopic = "Form2"
|
||||
LockControls = -1 'True
|
||||
ScaleHeight = 5715
|
||||
ScaleWidth = 7005
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
Begin VB.CommandButton cmdOK
|
||||
Caption = "OK"
|
||||
Default = -1 'True
|
||||
Height = 340
|
||||
Left = 4500
|
||||
TabIndex = 11
|
||||
Top = 5325
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.CommandButton cmdCancel
|
||||
Caption = "Cancel"
|
||||
Height = 340
|
||||
Left = 5700
|
||||
TabIndex = 12
|
||||
Top = 5325
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.Frame fraFixture
|
||||
Height = 5190
|
||||
Left = 75
|
||||
TabIndex = 13
|
||||
Top = 0
|
||||
Width = 6840
|
||||
Begin VB.TextBox txtMediaName
|
||||
Height = 375
|
||||
Left = 1470
|
||||
Locked = -1 'True
|
||||
TabIndex = 0
|
||||
Top = 300
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.TextBox txtMStart
|
||||
BeginProperty DataFormat
|
||||
Type = 1
|
||||
Format = "0"
|
||||
HaveTrueFalseNull= 0
|
||||
FirstDayOfWeek = 0
|
||||
FirstWeekOfYear = 0
|
||||
LCID = 1033
|
||||
SubFormatType = 1
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 1470
|
||||
TabIndex = 2
|
||||
Top = 780
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.TextBox txtMStop
|
||||
BeginProperty DataFormat
|
||||
Type = 1
|
||||
Format = "0"
|
||||
HaveTrueFalseNull= 0
|
||||
FirstDayOfWeek = 0
|
||||
FirstWeekOfYear = 0
|
||||
LCID = 1033
|
||||
SubFormatType = 1
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 1470
|
||||
TabIndex = 3
|
||||
Top = 1260
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.TextBox txtTStart
|
||||
BeginProperty DataFormat
|
||||
Type = 1
|
||||
Format = "0"
|
||||
HaveTrueFalseNull= 0
|
||||
FirstDayOfWeek = 0
|
||||
FirstWeekOfYear = 0
|
||||
LCID = 1033
|
||||
SubFormatType = 1
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 1470
|
||||
TabIndex = 4
|
||||
Top = 1740
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.TextBox txtTStop
|
||||
BeginProperty DataFormat
|
||||
Type = 1
|
||||
Format = "0"
|
||||
HaveTrueFalseNull= 0
|
||||
FirstDayOfWeek = 0
|
||||
FirstWeekOfYear = 0
|
||||
LCID = 1033
|
||||
SubFormatType = 1
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 1470
|
||||
TabIndex = 5
|
||||
Top = 2220
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.TextBox txtMediaLength
|
||||
BeginProperty DataFormat
|
||||
Type = 1
|
||||
Format = "0"
|
||||
HaveTrueFalseNull= 0
|
||||
FirstDayOfWeek = 0
|
||||
FirstWeekOfYear = 0
|
||||
LCID = 1033
|
||||
SubFormatType = 1
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 1470
|
||||
TabIndex = 6
|
||||
Top = 2700
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.TextBox txtStreamNumber
|
||||
BeginProperty DataFormat
|
||||
Type = 1
|
||||
Format = "0"
|
||||
HaveTrueFalseNull= 0
|
||||
FirstDayOfWeek = 0
|
||||
FirstWeekOfYear = 0
|
||||
LCID = 1033
|
||||
SubFormatType = 1
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 1470
|
||||
TabIndex = 7
|
||||
Top = 3180
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.TextBox txtFPS
|
||||
BeginProperty DataFormat
|
||||
Type = 1
|
||||
Format = "0"
|
||||
HaveTrueFalseNull= 0
|
||||
FirstDayOfWeek = 0
|
||||
FirstWeekOfYear = 0
|
||||
LCID = 1033
|
||||
SubFormatType = 1
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 1470
|
||||
TabIndex = 8
|
||||
Top = 3660
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.TextBox txtStretchMode
|
||||
BeginProperty DataFormat
|
||||
Type = 5
|
||||
Format = ""
|
||||
HaveTrueFalseNull= 1
|
||||
TrueValue = "1"
|
||||
FalseValue = "0"
|
||||
NullValue = ""
|
||||
FirstDayOfWeek = 0
|
||||
FirstWeekOfYear = 0
|
||||
LCID = 1033
|
||||
SubFormatType = 7
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 1470
|
||||
TabIndex = 9
|
||||
Top = 4140
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.TextBox txtMuted
|
||||
BeginProperty DataFormat
|
||||
Type = 5
|
||||
Format = ""
|
||||
HaveTrueFalseNull= 1
|
||||
TrueValue = "1"
|
||||
FalseValue = "0"
|
||||
NullValue = ""
|
||||
FirstDayOfWeek = 0
|
||||
FirstWeekOfYear = 0
|
||||
LCID = 1033
|
||||
SubFormatType = 7
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 1470
|
||||
TabIndex = 10
|
||||
Top = 4620
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.CommandButton cmdBrowse
|
||||
Caption = "Browse"
|
||||
Height = 375
|
||||
Left = 5670
|
||||
TabIndex = 1
|
||||
Top = 300
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.Label lblMediaName
|
||||
Caption = "MediaName"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 23
|
||||
Top = 420
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.Label lblMStart
|
||||
Caption = "MStart"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 22
|
||||
Top = 900
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.Label lblMStop
|
||||
Caption = "MStop"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 21
|
||||
Top = 1380
|
||||
Width = 615
|
||||
End
|
||||
Begin VB.Label lblTStart
|
||||
Caption = "TStart"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 20
|
||||
Top = 1860
|
||||
Width = 615
|
||||
End
|
||||
Begin VB.Label lblTStop
|
||||
Caption = "TStop"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 19
|
||||
Top = 2340
|
||||
Width = 615
|
||||
End
|
||||
Begin VB.Label lblMediaLength
|
||||
Caption = "MediaLength"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 18
|
||||
Top = 2820
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.Label lblStreamNumber
|
||||
Caption = "StreamNumber"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 17
|
||||
Top = 3300
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.Label lblFPS
|
||||
Caption = "FPS"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 16
|
||||
Top = 3780
|
||||
Width = 375
|
||||
End
|
||||
Begin VB.Label lblStretchMode
|
||||
Caption = "StretchMode"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 15
|
||||
Top = 4260
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.Label lblMuted
|
||||
Caption = "Muted"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 14
|
||||
Top = 4740
|
||||
Width = 495
|
||||
End
|
||||
End
|
||||
Begin MSComDlg.CommonDialog dlgCommonDialog2
|
||||
Left = 75
|
||||
Top = 5250
|
||||
_ExtentX = 847
|
||||
_ExtentY = 847
|
||||
_Version = 393216
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmClip"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
'*******************************************************************************
|
||||
'* This is a part of the Microsoft DXSDK 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.
|
||||
'* See these sources for detailed information regarding the
|
||||
'* Microsoft samples programs.
|
||||
'*******************************************************************************
|
||||
Option Explicit
|
||||
Option Base 0
|
||||
Option Compare Text
|
||||
|
||||
Private m_intUnloadMode As Integer
|
||||
Private Const DIALOG_TITLE = "Clip Help"
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PUBLIC INTERFACE- PROPERTIES
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: UnloadMode
|
||||
' * procedure description: Returns an integer specifying the method from which this dialog was last unloaded
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Property Get UnloadMode() As Integer
|
||||
On Local Error GoTo ErrLine
|
||||
'return the value to the client
|
||||
UnloadMode = m_intUnloadMode
|
||||
Exit Property
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Property
|
||||
End Property
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- FORM EVENT HANDLERS
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Form_Load
|
||||
' * procedure description: Occurs when a form is loaded.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Form_Load()
|
||||
On Local Error GoTo ErrLine
|
||||
'set default value(s)
|
||||
With Me
|
||||
.txtMediaName.Text = vbNullString
|
||||
.txtMStart.Text = vbNullString
|
||||
.txtMStop.Text = vbNullString
|
||||
.txtTStart.Text = vbNullString
|
||||
.txtTStop.Text = vbNullString
|
||||
.txtMediaLength.Text = vbNullString
|
||||
.txtStreamNumber.Text = vbNullString
|
||||
.txtFPS.Text = vbNullString
|
||||
.txtStretchMode.Text = vbNullString
|
||||
.txtMuted.Text = vbNullString
|
||||
End With
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Form_QueryUnload
|
||||
' * procedure description: Occurs before a form or application closes.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
Select Case UnloadMode
|
||||
Case vbFormControlMenu
|
||||
'0 The user chose the Close command from the Control menu on the form.
|
||||
Cancel = 1: Me.Visible = False
|
||||
Case vbFormCode
|
||||
'1 The Unload statement is invoked from code.
|
||||
Case vbAppWindows
|
||||
'2 The current Microsoft Windows operating environment session is ending.
|
||||
Case vbAppTaskManager
|
||||
'3 The Microsoft Windows Task Manager is closing the application.
|
||||
End
|
||||
Case vbFormMDIForm
|
||||
'4 An MDI child form is closing because the MDI form is closing.
|
||||
Case vbFormOwner
|
||||
'5 A form is closing because its owner is closing
|
||||
End Select
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Form_Unload
|
||||
' * procedure description: Occurs when a form is about to be removed from the screen.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Form_Unload(Cancel As Integer)
|
||||
On Local Error GoTo ErrLine
|
||||
With Me
|
||||
.Move 0 - (Screen.Width * 8), 0 - (Screen.Height * 8): .Visible = False
|
||||
End With
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- CONTROL EVENT HANDLERS
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: cmdOk_Click
|
||||
' * procedure description: occures when the 'Ok' command button is pressed; proceed to validate user input
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub cmdOk_Click()
|
||||
Dim nResultant As VbMsgBoxResult
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'validation code
|
||||
If Me.txtMediaName.Text = vbNullString Then
|
||||
nResultant = MsgBox("You Must Select A File Name", , DIALOG_TITLE)
|
||||
Me.txtMediaName.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
If Me.txtMStart.Text = vbNullString Then
|
||||
nResultant = MsgBox("You Must Set MStart", , DIALOG_TITLE)
|
||||
Me.txtMStart.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
If Me.txtMStop.Text = vbNullString Then
|
||||
nResultant = MsgBox("You Must Set MStop", , DIALOG_TITLE)
|
||||
Me.txtMStop.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
If Me.txtTStart.Text = vbNullString Then
|
||||
nResultant = MsgBox("You Must Set TStart", , DIALOG_TITLE)
|
||||
Me.txtTStart.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
If Me.txtTStop.Text = vbNullString Then
|
||||
nResultant = MsgBox("You Must Set TStop", , DIALOG_TITLE)
|
||||
Me.txtTStop.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
If Me.txtMediaLength.Text = vbNullString Then
|
||||
nResultant = MsgBox("You Must Set MediaLength", , DIALOG_TITLE)
|
||||
Me.txtMediaLength.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
If Me.txtStreamNumber.Text = vbNullString Then
|
||||
nResultant = MsgBox("You Must Set StreamNumber", , DIALOG_TITLE)
|
||||
Me.txtStreamNumber.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
If Me.txtFPS.Text = vbNullString Then
|
||||
nResultant = MsgBox("You Must Set FPS", , DIALOG_TITLE)
|
||||
Me.txtFPS.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
If Me.txtStretchMode.Text = vbNullString Then
|
||||
nResultant = MsgBox("You Must Set StretchMode", , DIALOG_TITLE)
|
||||
Me.txtStretchMode.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
If Me.txtMuted.Text = vbNullString Then
|
||||
nResultant = MsgBox("You Must Set Muted", , DIALOG_TITLE)
|
||||
Me.txtMuted.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
If CLng(Me.txtMStart.Text) > CLng(Me.txtMStop.Text) Then
|
||||
nResultant = MsgBox("MStart Must Be Lower Then MStop", , DIALOG_TITLE)
|
||||
Me.txtMStart.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
If CLng(Me.txtTStart.Text) > CLng(Me.txtTStop.Text) Then
|
||||
nResultant = MsgBox("TStart Must Be Lower Then TStop", , DIALOG_TITLE)
|
||||
Me.txtTStart.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
'hide the dialog
|
||||
Me.Visible = False
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: cmdCancel_Click
|
||||
' * procedure description: occures when the 'Cancel' command button is pressed
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub cmdCancel_Click()
|
||||
On Local Error GoTo ErrLine
|
||||
'hide the dialog
|
||||
Me.Visible = False
|
||||
m_intUnloadMode = 1
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: cmdBrowse_Click
|
||||
' * procedure description: occures when the 'Browse' command button is pressed
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub cmdBrowse_Click()
|
||||
Dim bstrFilename As String
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'request a filename from the user..
|
||||
bstrFilename = ShowCommonDlgOpen(, vbNullString, "Media Files(*.asf, *.avi, *.au, *.mpeg, *.mpg, *.wav)")
|
||||
'validate the user's input from the common dialog
|
||||
If Len(bstrFilename) = 0 Then
|
||||
Exit Sub
|
||||
Else: Me.txtMediaName.Text = bstrFilename
|
||||
End If
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
Binary file not shown.
@@ -0,0 +1,293 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form frmComp
|
||||
Caption = "Composite Menu"
|
||||
ClientHeight = 2505
|
||||
ClientLeft = 60
|
||||
ClientTop = 345
|
||||
ClientWidth = 5790
|
||||
Icon = "frmComp.frx":0000
|
||||
LinkTopic = "Form2"
|
||||
LockControls = -1 'True
|
||||
ScaleHeight = 2505
|
||||
ScaleWidth = 5790
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
Begin VB.Frame fraFixture
|
||||
Height = 1965
|
||||
Left = 75
|
||||
TabIndex = 5
|
||||
Top = 0
|
||||
Width = 5640
|
||||
Begin VB.TextBox txtPriority
|
||||
BeginProperty DataFormat
|
||||
Type = 1
|
||||
Format = "0"
|
||||
HaveTrueFalseNull= 0
|
||||
FirstDayOfWeek = 0
|
||||
FirstWeekOfYear = 0
|
||||
LCID = 1033
|
||||
SubFormatType = 1
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 1470
|
||||
TabIndex = 0
|
||||
Top = 300
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.TextBox txtStartTime
|
||||
BeginProperty DataFormat
|
||||
Type = 1
|
||||
Format = "0"
|
||||
HaveTrueFalseNull= 0
|
||||
FirstDayOfWeek = 0
|
||||
FirstWeekOfYear = 0
|
||||
LCID = 1033
|
||||
SubFormatType = 1
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 1470
|
||||
TabIndex = 1
|
||||
Top = 780
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.TextBox txtStopTime
|
||||
BeginProperty DataFormat
|
||||
Type = 1
|
||||
Format = "0"
|
||||
HaveTrueFalseNull= 0
|
||||
FirstDayOfWeek = 0
|
||||
FirstWeekOfYear = 0
|
||||
LCID = 1033
|
||||
SubFormatType = 1
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 1470
|
||||
TabIndex = 2
|
||||
Top = 1260
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.Label lblPriority
|
||||
Caption = "Priority"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 8
|
||||
Top = 420
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.Label lblStart
|
||||
Caption = "Start"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 7
|
||||
Top = 900
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.Label lblStop
|
||||
Caption = "Stop"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 6
|
||||
Top = 1380
|
||||
Width = 615
|
||||
End
|
||||
End
|
||||
Begin VB.CommandButton cmdOk
|
||||
Caption = "OK"
|
||||
Default = -1 'True
|
||||
Height = 340
|
||||
Left = 3270
|
||||
TabIndex = 3
|
||||
Top = 2070
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.CommandButton cmdCancel
|
||||
Caption = "Cancel"
|
||||
Height = 340
|
||||
Left = 4470
|
||||
TabIndex = 4
|
||||
Top = 2070
|
||||
Width = 1215
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmComp"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
'*******************************************************************************
|
||||
'* This is a part of the Microsoft DXSDK 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.
|
||||
'* See these sources for detailed information regarding the
|
||||
'* Microsoft samples programs.
|
||||
'*******************************************************************************
|
||||
Option Explicit
|
||||
Option Base 0
|
||||
Option Compare Text
|
||||
|
||||
Private m_intUnloadMode As Integer
|
||||
Private Const DIALOG_TITLE = "Composition Help"
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PUBLIC INTERFACE- PROPERTIES
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: UnloadMode
|
||||
' * procedure description: Returns an integer specifying the method from which this dialog was last unloaded
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Property Get UnloadMode() As Integer
|
||||
On Local Error GoTo ErrLine
|
||||
'return the value to the client
|
||||
UnloadMode = m_intUnloadMode
|
||||
Exit Property
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Property
|
||||
End Property
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- FORM EVENT HANDLERS
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Form_Load
|
||||
' * procedure description: Occurs when a form is loaded.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Form_Load()
|
||||
On Local Error GoTo ErrLine
|
||||
'set default value(s)
|
||||
With Me
|
||||
.txtPriority.Text = vbNullString
|
||||
.txtStartTime.Text = vbNullString
|
||||
.txtStopTime.Text = vbNullString
|
||||
End With
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Form_QueryUnload
|
||||
' * procedure description: Occurs before a form or application closes.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
Select Case UnloadMode
|
||||
Case vbFormControlMenu
|
||||
'0 The user chose the Close command from the Control menu on the form.
|
||||
Cancel = 1: Me.Visible = False
|
||||
Case vbFormCode
|
||||
'1 The Unload statement is invoked from code.
|
||||
Case vbAppWindows
|
||||
'2 The current Microsoft Windows operating environment session is ending.
|
||||
Case vbAppTaskManager
|
||||
'3 The Microsoft Windows Task Manager is closing the application.
|
||||
End
|
||||
Case vbFormMDIForm
|
||||
'4 An MDI child form is closing because the MDI form is closing.
|
||||
Case vbFormOwner
|
||||
'5 A form is closing because its owner is closing
|
||||
End Select
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Form_Unload
|
||||
' * procedure description: Occurs when a form is about to be removed from the screen.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Form_Unload(Cancel As Integer)
|
||||
On Local Error GoTo ErrLine
|
||||
With Me
|
||||
.Move 0 - (Screen.Width * 8), 0 - (Screen.Height * 8): .Visible = False
|
||||
End With
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- CONTROL EVENT HANDLERS
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: cmdOK_Click
|
||||
' * procedure description: occures when the user clicks the 'Ok' command button
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub cmdOk_Click()
|
||||
Dim nResultant As VbMsgBoxResult
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'validation code
|
||||
If frmComp.txtPriority.Text = vbNullString Then
|
||||
nResultant = MsgBox("You Must Set Priority", , DIALOG_TITLE)
|
||||
frmComp.txtPriority.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
If frmComp.txtStartTime.Text = vbNullString Then
|
||||
nResultant = MsgBox("You Must Set Start", , DIALOG_TITLE)
|
||||
frmComp.txtStartTime.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
If frmComp.txtStopTime.Text = vbNullString Then
|
||||
nResultant = MsgBox("You Must Set Stop", , DIALOG_TITLE)
|
||||
frmComp.txtStopTime.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
If IsNumeric(frmComp.txtStartTime.Text) And IsNumeric(frmComp.txtStopTime.Text) Then
|
||||
If CLng(frmComp.txtStartTime.Text) > CLng(frmComp.txtStopTime.Text) Then
|
||||
nResultant = MsgBox("Start Must Be Lower Than Stop", , DIALOG_TITLE)
|
||||
frmComp.txtStartTime.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
|
||||
'hide the dialog
|
||||
Me.Visible = False
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: cmdCancel_Click
|
||||
' * procedure description: occures when the user clicks the 'Cancel' command button
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub cmdCancel_Click()
|
||||
On Local Error GoTo ErrLine
|
||||
'hide the dialog
|
||||
Me.Visible = False
|
||||
m_intUnloadMode = 1
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
Binary file not shown.
@@ -0,0 +1,272 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form frmEffect
|
||||
Caption = "Effect Form"
|
||||
ClientHeight = 2640
|
||||
ClientLeft = 60
|
||||
ClientTop = 345
|
||||
ClientWidth = 6045
|
||||
Icon = "frmEffect.frx":0000
|
||||
LinkTopic = "Form2"
|
||||
LockControls = -1 'True
|
||||
ScaleHeight = 2640
|
||||
ScaleWidth = 6045
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
Begin VB.Frame fraFixture
|
||||
Height = 2115
|
||||
Left = 75
|
||||
TabIndex = 7
|
||||
Top = 0
|
||||
Width = 5865
|
||||
Begin VB.TextBox txtStartTime
|
||||
Height = 375
|
||||
Left = 1710
|
||||
TabIndex = 1
|
||||
Top = 695
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.TextBox txtStopTime
|
||||
Height = 375
|
||||
Left = 1710
|
||||
TabIndex = 2
|
||||
Top = 1140
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.ComboBox cmbEffect
|
||||
Height = 315
|
||||
Left = 1710
|
||||
Sorted = -1 'True
|
||||
TabIndex = 0
|
||||
Top = 300
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.TextBox txtPriority
|
||||
Height = 375
|
||||
Left = 1710
|
||||
TabIndex = 3
|
||||
ToolTipText = "-1"
|
||||
Top = 1600
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.Label lblEffect
|
||||
Caption = "Effect"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 11
|
||||
Top = 300
|
||||
Width = 1695
|
||||
End
|
||||
Begin VB.Label lblStart
|
||||
Caption = "Start"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 10
|
||||
Top = 780
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.Label lblStop
|
||||
Caption = "Stop"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 9
|
||||
Top = 1260
|
||||
Width = 615
|
||||
End
|
||||
Begin VB.Label lblPriority
|
||||
Caption = "Priority"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 8
|
||||
Top = 1740
|
||||
Width = 615
|
||||
End
|
||||
End
|
||||
Begin VB.CommandButton cmdOk
|
||||
Caption = "OK"
|
||||
Default = -1 'True
|
||||
Height = 340
|
||||
Left = 3540
|
||||
TabIndex = 4
|
||||
Top = 2220
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.CommandButton cmdCancel
|
||||
Caption = "Cancel"
|
||||
Height = 340
|
||||
Left = 4740
|
||||
TabIndex = 5
|
||||
Top = 2220
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.TextBox GetSubObjectGUIDB
|
||||
Height = 375
|
||||
Left = 4650
|
||||
TabIndex = 6
|
||||
Top = 2775
|
||||
Visible = 0 'False
|
||||
Width = 1335
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmEffect"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
'*******************************************************************************
|
||||
'* This is a part of the Microsoft DXSDK 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.
|
||||
'* See these sources for detailed information regarding the
|
||||
'* Microsoft samples programs.
|
||||
'*******************************************************************************
|
||||
Option Explicit
|
||||
Option Base 0
|
||||
Option Compare Text
|
||||
|
||||
Private m_intUnloadMode As Integer
|
||||
Private Const DIALOG_TITLE = "Effect Help"
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PUBLIC INTERFACE- PROPERTIES
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: UnloadMode
|
||||
' * procedure description: Returns an integer specifying the method from which this dialog was last unloaded
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Property Get UnloadMode() As Integer
|
||||
On Local Error GoTo ErrLine
|
||||
'return the value to the client
|
||||
UnloadMode = m_intUnloadMode
|
||||
Exit Property
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Property
|
||||
End Property
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- FORM EVENT HANDLERS
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Form_Load
|
||||
' * procedure description: Occurs when a form is loaded.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Form_Load()
|
||||
On Local Error GoTo ErrLine
|
||||
'set default value(s)
|
||||
With cmbEffect
|
||||
.AddItem "BasicImage"
|
||||
.AddItem "Blur"
|
||||
.AddItem "Chroma"
|
||||
.AddItem "DropShadow"
|
||||
.AddItem "Emboss"
|
||||
.AddItem "Engrave"
|
||||
.AddItem "Fade"
|
||||
.AddItem "Pixelate"
|
||||
End With
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Form_QueryUnload
|
||||
' * procedure description: Occurs before a form or application closes.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
Select Case UnloadMode
|
||||
Case vbFormControlMenu
|
||||
'0 The user chose the Close command from the Control menu on the form.
|
||||
Cancel = 1: Me.Visible = False
|
||||
Case vbFormCode
|
||||
'1 The Unload statement is invoked from code.
|
||||
Case vbAppWindows
|
||||
'2 The current Microsoft Windows operating environment session is ending.
|
||||
Case vbAppTaskManager
|
||||
'3 The Microsoft Windows Task Manager is closing the application.
|
||||
End
|
||||
Case vbFormMDIForm
|
||||
'4 An MDI child form is closing because the MDI form is closing.
|
||||
Case vbFormOwner
|
||||
'5 A form is closing because its owner is closing
|
||||
End Select
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Form_Unload
|
||||
' * procedure description: Occurs when a form is about to be removed from the screen.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Form_Unload(Cancel As Integer)
|
||||
On Local Error GoTo ErrLine
|
||||
With Me
|
||||
.Move 0 - (Screen.Width * 8), 0 - (Screen.Height * 8): .Visible = False
|
||||
End With
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- CONTROL EVENT HANDLERS
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: cmdOk_Click
|
||||
' * procedure description: occures when the 'Ok' command button is pressed
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub cmdOk_Click()
|
||||
On Local Error GoTo ErrLine
|
||||
'hide the dialog
|
||||
Me.Visible = False
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: cmdCancel_Click
|
||||
' * procedure description: occures when the 'Cancel' command button is pressed
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub cmdCancel_Click()
|
||||
On Local Error GoTo ErrLine
|
||||
'hide the dialog
|
||||
Me.Visible = False
|
||||
m_intUnloadMode = 1
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
Binary file not shown.
@@ -0,0 +1,373 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form frmGroup
|
||||
Caption = "Group Menu"
|
||||
ClientHeight = 3675
|
||||
ClientLeft = 60
|
||||
ClientTop = 345
|
||||
ClientWidth = 5805
|
||||
Icon = "frmGroup.frx":0000
|
||||
LinkTopic = "Form2"
|
||||
LockControls = -1 'True
|
||||
ScaleHeight = 3675
|
||||
ScaleWidth = 5805
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
Begin VB.Frame fraFixture
|
||||
Height = 3165
|
||||
Left = 75
|
||||
TabIndex = 8
|
||||
Top = 0
|
||||
Width = 5640
|
||||
Begin VB.TextBox txtBuffering
|
||||
BeginProperty DataFormat
|
||||
Type = 1
|
||||
Format = "0"
|
||||
HaveTrueFalseNull= 0
|
||||
FirstDayOfWeek = 0
|
||||
FirstWeekOfYear = 0
|
||||
LCID = 1033
|
||||
SubFormatType = 1
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 1470
|
||||
TabIndex = 5
|
||||
Top = 2625
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.TextBox txtPreviewMode
|
||||
BeginProperty DataFormat
|
||||
Type = 1
|
||||
Format = "0"
|
||||
HaveTrueFalseNull= 0
|
||||
FirstDayOfWeek = 0
|
||||
FirstWeekOfYear = 0
|
||||
LCID = 1033
|
||||
SubFormatType = 1
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 1470
|
||||
TabIndex = 4
|
||||
Top = 2145
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.TextBox txtOutputFPS
|
||||
BeginProperty DataFormat
|
||||
Type = 1
|
||||
Format = "0"
|
||||
HaveTrueFalseNull= 0
|
||||
FirstDayOfWeek = 0
|
||||
FirstWeekOfYear = 0
|
||||
LCID = 1033
|
||||
SubFormatType = 1
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 1470
|
||||
TabIndex = 3
|
||||
Top = 1665
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.TextBox txtPriority
|
||||
BeginProperty DataFormat
|
||||
Type = 1
|
||||
Format = "0"
|
||||
HaveTrueFalseNull= 0
|
||||
FirstDayOfWeek = 0
|
||||
FirstWeekOfYear = 0
|
||||
LCID = 1033
|
||||
SubFormatType = 1
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 1470
|
||||
TabIndex = 2
|
||||
Top = 1185
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.TextBox txtMediaType
|
||||
BeginProperty DataFormat
|
||||
Type = 1
|
||||
Format = "0"
|
||||
HaveTrueFalseNull= 0
|
||||
FirstDayOfWeek = 0
|
||||
FirstWeekOfYear = 0
|
||||
LCID = 1033
|
||||
SubFormatType = 1
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 1470
|
||||
TabIndex = 1
|
||||
ToolTipText = "0 - Video / 1 - Audio"
|
||||
Top = 705
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.TextBox txtGroupName
|
||||
Height = 375
|
||||
Left = 1470
|
||||
TabIndex = 0
|
||||
Top = 225
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.Label lblBuffering
|
||||
Caption = "Buffering"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 14
|
||||
Top = 2745
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.Label lblPreviewMode
|
||||
Caption = "PreviewMode"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 13
|
||||
Top = 2265
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.Label lblOutputFPS
|
||||
Caption = "OutputFPS"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 12
|
||||
Top = 1785
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.Label lblPriority
|
||||
Caption = "Priority"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 11
|
||||
Top = 1305
|
||||
Width = 615
|
||||
End
|
||||
Begin VB.Label lblMediaType
|
||||
Caption = "MediaType"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 10
|
||||
ToolTipText = "0 - Video / 1 - Audio"
|
||||
Top = 825
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.Label lblGroupName
|
||||
Caption = "GroupName"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 9
|
||||
Top = 345
|
||||
Width = 1095
|
||||
End
|
||||
End
|
||||
Begin VB.CommandButton cmdCancel
|
||||
Caption = "Cancel"
|
||||
Height = 340
|
||||
Left = 4500
|
||||
TabIndex = 7
|
||||
Top = 3255
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.CommandButton cmdOk
|
||||
Caption = "OK"
|
||||
Default = -1 'True
|
||||
Height = 340
|
||||
Left = 3300
|
||||
TabIndex = 6
|
||||
Top = 3255
|
||||
Width = 1095
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmGroup"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
'*******************************************************************************
|
||||
'* This is a part of the Microsoft DXSDK 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.
|
||||
'* See these sources for detailed information regarding the
|
||||
'* Microsoft samples programs.
|
||||
'*******************************************************************************
|
||||
Option Explicit
|
||||
Option Base 0
|
||||
Option Compare Text
|
||||
|
||||
Private m_intUnloadMode As Integer
|
||||
Private Const DIALOG_TITLE = "Group Help"
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PUBLIC INTERFACE- PROPERTIES
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: UnloadMode
|
||||
' * procedure description: Returns an integer specifying the method from which this dialog was last unloaded
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Property Get UnloadMode() As Integer
|
||||
On Local Error GoTo ErrLine
|
||||
'return the value to the client
|
||||
UnloadMode = m_intUnloadMode
|
||||
Exit Property
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Property
|
||||
End Property
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- FORM EVENT HANDLERS
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Form_Load
|
||||
' * procedure description: Occurs when a form is loaded.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Form_Load()
|
||||
On Local Error GoTo ErrLine
|
||||
'set default value(s)
|
||||
With Me
|
||||
.txtGroupName.Text = vbNullString
|
||||
.txtMediaType.Text = vbNullString
|
||||
.txtPriority.Text = vbNullString
|
||||
.txtOutputFPS.Text = vbNullString
|
||||
.txtPreviewMode.Text = vbNullString
|
||||
.txtBuffering.Text = vbNullString
|
||||
End With
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Form_QueryUnload
|
||||
' * procedure description: Occurs before a form or application closes.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
Select Case UnloadMode
|
||||
Case vbFormControlMenu
|
||||
'0 The user chose the Close command from the Control menu on the form.
|
||||
Cancel = 1: Me.Visible = False
|
||||
Case vbFormCode
|
||||
'1 The Unload statement is invoked from code.
|
||||
Case vbAppWindows
|
||||
'2 The current Microsoft Windows operating environment session is ending.
|
||||
Case vbAppTaskManager
|
||||
'3 The Microsoft Windows Task Manager is closing the application.
|
||||
End
|
||||
Case vbFormMDIForm
|
||||
'4 An MDI child form is closing because the MDI form is closing.
|
||||
Case vbFormOwner
|
||||
'5 A form is closing because its owner is closing
|
||||
End Select
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Form_Unload
|
||||
' * procedure description: Occurs when a form is about to be removed from the screen.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Form_Unload(Cancel As Integer)
|
||||
On Local Error GoTo ErrLine
|
||||
With Me
|
||||
.Move 0 - (Screen.Width * 8), 0 - (Screen.Height * 8): .Visible = False
|
||||
End With
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- CONTROL EVENT HANDLERS
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: cmdOk_Click
|
||||
' * procedure description: occures when the user presses the "Ok" button
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub cmdOk_Click()
|
||||
Dim nResultant As VbMsgBoxResult
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'validation code
|
||||
If frmGroup.txtGroupName.Text = vbNullString Then
|
||||
nResultant = MsgBox("You Must Set GroupName", , DIALOG_TITLE)
|
||||
frmGroup.txtGroupName.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
If frmGroup.txtMediaType.Text = vbNullString Then
|
||||
nResultant = MsgBox("You Must Set MediaType", , DIALOG_TITLE)
|
||||
frmGroup.txtMediaType.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
If frmGroup.txtPriority.Text = vbNullString Then
|
||||
nResultant = MsgBox("You Must Set Priority", , DIALOG_TITLE)
|
||||
frmGroup.txtPriority.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
If frmGroup.txtOutputFPS.Text = vbNullString Then
|
||||
nResultant = MsgBox("You Must Set OutputFPS", , DIALOG_TITLE)
|
||||
frmGroup.txtOutputFPS.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
If frmGroup.txtPreviewMode.Text = vbNullString Then
|
||||
nResultant = MsgBox("You Must Set PreviewMode", , DIALOG_TITLE)
|
||||
frmGroup.txtPreviewMode.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
If frmGroup.txtBuffering.Text = vbNullString Then
|
||||
nResultant = MsgBox("You Must Set Buffering", , DIALOG_TITLE)
|
||||
frmGroup.txtBuffering.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
'hide the dialog
|
||||
Me.Visible = False
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: cmdCancel_Click
|
||||
' * procedure description: occures when the user presses the "Cancel" button
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub cmdCancel_Click()
|
||||
On Local Error GoTo ErrLine
|
||||
'hide the dialog
|
||||
Me.Visible = False
|
||||
m_intUnloadMode = 1
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -0,0 +1,504 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form frmTimeline
|
||||
Caption = "TimeLine Menu"
|
||||
ClientHeight = 4605
|
||||
ClientLeft = 60
|
||||
ClientTop = 345
|
||||
ClientWidth = 6015
|
||||
Icon = "frmTimeline.frx":0000
|
||||
LinkTopic = "Form2"
|
||||
LockControls = -1 'True
|
||||
ScaleHeight = 4605
|
||||
ScaleWidth = 6015
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
Begin VB.Frame fraFixture
|
||||
Height = 4065
|
||||
Left = 75
|
||||
TabIndex = 12
|
||||
Top = 0
|
||||
Width = 5865
|
||||
Begin VB.TextBox txtDirty
|
||||
BeginProperty DataFormat
|
||||
Type = 1
|
||||
Format = "0"
|
||||
HaveTrueFalseNull= 0
|
||||
FirstDayOfWeek = 0
|
||||
FirstWeekOfYear = 0
|
||||
LCID = 1033
|
||||
SubFormatType = 1
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 1710
|
||||
TabIndex = 5
|
||||
ToolTipText = "Not Setable By User / read Only"
|
||||
Top = 2625
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.TextBox txtDefaultFPS
|
||||
BeginProperty DataFormat
|
||||
Type = 1
|
||||
Format = "0"
|
||||
HaveTrueFalseNull= 0
|
||||
FirstDayOfWeek = 0
|
||||
FirstWeekOfYear = 0
|
||||
LCID = 1033
|
||||
SubFormatType = 1
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 1710
|
||||
TabIndex = 4
|
||||
ToolTipText = "Default Frames Per Second"
|
||||
Top = 2145
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.TextBox txtDuration
|
||||
BeginProperty DataFormat
|
||||
Type = 1
|
||||
Format = "0"
|
||||
HaveTrueFalseNull= 0
|
||||
FirstDayOfWeek = 0
|
||||
FirstWeekOfYear = 0
|
||||
LCID = 1033
|
||||
SubFormatType = 1
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 1710
|
||||
TabIndex = 3
|
||||
ToolTipText = "Not Setable By User / read Only"
|
||||
Top = 1665
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.TextBox txtEffectsEnabled
|
||||
BeginProperty DataFormat
|
||||
Type = 1
|
||||
Format = "0"
|
||||
HaveTrueFalseNull= 0
|
||||
FirstDayOfWeek = 0
|
||||
FirstWeekOfYear = 0
|
||||
LCID = 1033
|
||||
SubFormatType = 1
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 1710
|
||||
TabIndex = 2
|
||||
ToolTipText = "0 Disabled / 1 Enabled"
|
||||
Top = 1185
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.TextBox txtTransitionsEnabled
|
||||
BeginProperty DataFormat
|
||||
Type = 1
|
||||
Format = "0"
|
||||
HaveTrueFalseNull= 0
|
||||
FirstDayOfWeek = 0
|
||||
FirstWeekOfYear = 0
|
||||
LCID = 1033
|
||||
SubFormatType = 1
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 1710
|
||||
TabIndex = 1
|
||||
ToolTipText = "0 Disabled / 1 Enabled"
|
||||
Top = 705
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.TextBox txtInsertMode
|
||||
BeginProperty DataFormat
|
||||
Type = 1
|
||||
Format = "0"
|
||||
HaveTrueFalseNull= 0
|
||||
FirstDayOfWeek = 0
|
||||
FirstWeekOfYear = 0
|
||||
LCID = 1033
|
||||
SubFormatType = 1
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 1710
|
||||
TabIndex = 0
|
||||
ToolTipText = "1 Insert / 2 Overlay"
|
||||
Top = 225
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.ComboBox cmbDefaultTransition
|
||||
Height = 315
|
||||
Left = 1710
|
||||
Sorted = -1 'True
|
||||
TabIndex = 6
|
||||
Top = 3105
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.ComboBox cmbDefaultEffect
|
||||
Height = 315
|
||||
Left = 1710
|
||||
Sorted = -1 'True
|
||||
TabIndex = 7
|
||||
Top = 3585
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.Label lblDefaultEffect
|
||||
Caption = "DefaultEffect"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 20
|
||||
Top = 3705
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.Label lblDefaultTransition
|
||||
Caption = "DefaultTransition"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 19
|
||||
Top = 3225
|
||||
Width = 1455
|
||||
End
|
||||
Begin VB.Label lblDirty
|
||||
Caption = "Dirty"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 18
|
||||
Top = 2745
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.Label lblDefaultFPS
|
||||
Caption = "DefaultFPS"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 17
|
||||
Top = 2265
|
||||
Width = 1575
|
||||
End
|
||||
Begin VB.Label lblDuration
|
||||
Caption = "Duration"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 16
|
||||
Top = 1785
|
||||
Width = 615
|
||||
End
|
||||
Begin VB.Label lblEffectsEnable
|
||||
Caption = "EffectsEnable"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 15
|
||||
Top = 1305
|
||||
Width = 1935
|
||||
End
|
||||
Begin VB.Label lblTransitionsEnable
|
||||
Caption = "TransitionsEnable"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 14
|
||||
Top = 825
|
||||
Width = 1575
|
||||
End
|
||||
Begin VB.Label lblInsertMode
|
||||
Caption = "InsertMode"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 13
|
||||
Top = 345
|
||||
Width = 1095
|
||||
End
|
||||
End
|
||||
Begin VB.CommandButton cmdCancel
|
||||
Caption = "Cancel"
|
||||
Height = 340
|
||||
Left = 4695
|
||||
TabIndex = 9
|
||||
Top = 4170
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.CommandButton cmdOk
|
||||
Caption = "OK"
|
||||
Default = -1 'True
|
||||
Height = 340
|
||||
Left = 3495
|
||||
TabIndex = 8
|
||||
Top = 4170
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.TextBox DefaultTransition
|
||||
BeginProperty DataFormat
|
||||
Type = 1
|
||||
Format = "0"
|
||||
HaveTrueFalseNull= 0
|
||||
FirstDayOfWeek = 0
|
||||
FirstWeekOfYear = 0
|
||||
LCID = 1033
|
||||
SubFormatType = 1
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 7200
|
||||
TabIndex = 10
|
||||
TabStop = 0 'False
|
||||
Top = 150
|
||||
Visible = 0 'False
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.TextBox DefaultEffect
|
||||
BeginProperty DataFormat
|
||||
Type = 1
|
||||
Format = "0"
|
||||
HaveTrueFalseNull= 0
|
||||
FirstDayOfWeek = 0
|
||||
FirstWeekOfYear = 0
|
||||
LCID = 1033
|
||||
SubFormatType = 1
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 7200
|
||||
TabIndex = 11
|
||||
TabStop = 0 'False
|
||||
Top = 600
|
||||
Visible = 0 'False
|
||||
Width = 975
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmTimeline"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
'*******************************************************************************
|
||||
'* This is a part of the Microsoft DXSDK 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.
|
||||
'* See these sources for detailed information regarding the
|
||||
'* Microsoft samples programs.
|
||||
'*******************************************************************************
|
||||
Option Explicit
|
||||
Option Base 0
|
||||
Option Compare Text
|
||||
|
||||
Private m_intUnloadMode As Integer
|
||||
Private Const DIALOG_TITLE = "Timeline Help"
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PUBLIC INTERFACE- PROPERTIES
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: UnloadMode
|
||||
' * procedure description: Returns an integer specifying the method from which this dialog was last unloaded
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Property Get UnloadMode() As Integer
|
||||
On Local Error GoTo ErrLine
|
||||
'return the value to the client
|
||||
UnloadMode = m_intUnloadMode
|
||||
Exit Property
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Property
|
||||
End Property
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- FORM EVENT HANDLERS
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Form_Load
|
||||
' * procedure description: Occurs when a form is loaded.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Form_Load()
|
||||
On Local Error GoTo ErrLine
|
||||
'set default value(s)
|
||||
With Me
|
||||
.txtInsertMode.Text = vbNullString
|
||||
.txtTransitionsEnabled.Text = vbNullString
|
||||
.txtEffectsEnabled.Text = vbNullString
|
||||
.txtDuration.Text = vbNullString
|
||||
.txtDefaultFPS.Text = vbNullString
|
||||
.txtDirty.Text = vbNullString
|
||||
.cmbDefaultTransition.Text = vbNullString
|
||||
.cmbDefaultEffect.Text = vbNullString
|
||||
End With
|
||||
|
||||
With cmbDefaultTransition
|
||||
.AddItem "Barn"
|
||||
.AddItem "Blinds"
|
||||
.AddItem "BurnFilm"
|
||||
.AddItem "CenterCurls"
|
||||
.AddItem "ColorFade"
|
||||
.AddItem "Compositor"
|
||||
.AddItem "Curls"
|
||||
.AddItem "Curtains"
|
||||
.AddItem "Fade"
|
||||
.AddItem "FadeWhite"
|
||||
.AddItem "FlowMotion"
|
||||
.AddItem "GlassBlock"
|
||||
.AddItem "Grid"
|
||||
.AddItem "Inset"
|
||||
.AddItem "Iris"
|
||||
.AddItem "Jaws"
|
||||
.AddItem "Lens"
|
||||
.AddItem "LightWipe"
|
||||
.AddItem "Liquid"
|
||||
.AddItem "PageCurl"
|
||||
.AddItem "PeelABCD"
|
||||
.AddItem "Pixelate"
|
||||
.AddItem "RadialWipe"
|
||||
.AddItem "Ripple"
|
||||
.AddItem "RollDown"
|
||||
.AddItem "Slide"
|
||||
.AddItem "SMPTE Wipe"
|
||||
.AddItem "Spiral"
|
||||
.AddItem "Stretch"
|
||||
.AddItem "Threshold"
|
||||
.AddItem "Twister"
|
||||
.AddItem "Vacuum"
|
||||
.AddItem "Water"
|
||||
.AddItem "Wheel"
|
||||
.AddItem "Wipe"
|
||||
.AddItem "WormHole"
|
||||
.AddItem "Zigzag"
|
||||
End With
|
||||
|
||||
With cmbDefaultEffect
|
||||
.AddItem "BasicImage"
|
||||
.AddItem "Blur"
|
||||
.AddItem "Chroma"
|
||||
.AddItem "DropShadow"
|
||||
.AddItem "Emboss"
|
||||
.AddItem "Engrave"
|
||||
.AddItem "Fade"
|
||||
.AddItem "Pixelate"
|
||||
End With
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Form_QueryUnload
|
||||
' * procedure description: Occurs before a form or application closes.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
Select Case UnloadMode
|
||||
Case vbFormControlMenu
|
||||
'0 The user chose the Close command from the Control menu on the form.
|
||||
Cancel = 1: Me.Visible = False
|
||||
Case vbFormCode
|
||||
'1 The Unload statement is invoked from code.
|
||||
Case vbAppWindows
|
||||
'2 The current Microsoft Windows operating environment session is ending.
|
||||
Case vbAppTaskManager
|
||||
'3 The Microsoft Windows Task Manager is closing the application.
|
||||
End
|
||||
Case vbFormMDIForm
|
||||
'4 An MDI child form is closing because the MDI form is closing.
|
||||
Case vbFormOwner
|
||||
'5 A form is closing because its owner is closing
|
||||
End Select
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Form_Unload
|
||||
' * procedure description: Occurs when a form is about to be removed from the screen.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Form_Unload(Cancel As Integer)
|
||||
On Local Error GoTo ErrLine
|
||||
With Me
|
||||
.Move 0 - (Screen.Width * 8), 0 - (Screen.Height * 8): .Visible = False
|
||||
End With
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- CONTROL EVENT HANDLERS
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: cmdOk_Click
|
||||
' * procedure description: fired intrinsically when this form is loaded
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub cmdOk_Click()
|
||||
Dim nResultant As VbMsgBoxResult
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'validation code
|
||||
If frmTimeline.txtInsertMode.Text = vbNullString Then
|
||||
nResultant = MsgBox("You Must Set txtInsertMode", , DIALOG_TITLE)
|
||||
frmTimeline.txtInsertMode.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
If frmTimeline.txtTransitionsEnabled.Text = vbNullString Then
|
||||
nResultant = MsgBox("You Must Set txtTransitionsEnabled", , DIALOG_TITLE)
|
||||
frmTimeline.txtTransitionsEnabled.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
If frmTimeline.txtEffectsEnabled.Text = vbNullString Then
|
||||
nResultant = MsgBox("You Must Set txtEffectsEnabled", , DIALOG_TITLE)
|
||||
frmTimeline.txtEffectsEnabled.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
If frmTimeline.txtDefaultFPS.Text = vbNullString Then
|
||||
nResultant = MsgBox("You Must Set txtDefaultFPS", , DIALOG_TITLE)
|
||||
frmTimeline.txtDefaultFPS.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
If frmTimeline.cmbDefaultTransition.Text = vbNullString Then
|
||||
nResultant = MsgBox("You Must Set cmbDefaultTransition", , DIALOG_TITLE)
|
||||
frmTimeline.cmbDefaultTransition.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
If frmTimeline.cmbDefaultEffect.Text = vbNullString Then
|
||||
nResultant = MsgBox("You Must Set cmbDefaultEffect", , DIALOG_TITLE)
|
||||
frmTimeline.cmbDefaultEffect.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
'hide the dialog
|
||||
Me.Visible = False
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: cmdCancel_Click
|
||||
' * procedure description: occures when the user presses the 'Cancel' command button
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub cmdCancel_Click()
|
||||
On Local Error GoTo ErrLine
|
||||
'hide the dialog
|
||||
Me.Visible = False
|
||||
m_intUnloadMode = 1
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
Binary file not shown.
@@ -0,0 +1,357 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form frmTrack
|
||||
Caption = "Track Menu"
|
||||
ClientHeight = 3270
|
||||
ClientLeft = 60
|
||||
ClientTop = 345
|
||||
ClientWidth = 5805
|
||||
Icon = "frmTrack.frx":0000
|
||||
LinkTopic = "Form2"
|
||||
LockControls = -1 'True
|
||||
ScaleHeight = 3270
|
||||
ScaleWidth = 5805
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
Begin VB.Frame fraFixture
|
||||
Height = 2715
|
||||
Left = 75
|
||||
TabIndex = 7
|
||||
Top = 0
|
||||
Width = 5640
|
||||
Begin VB.TextBox txtPriority
|
||||
BeginProperty DataFormat
|
||||
Type = 1
|
||||
Format = "0"
|
||||
HaveTrueFalseNull= 0
|
||||
FirstDayOfWeek = 0
|
||||
FirstWeekOfYear = 0
|
||||
LCID = 1033
|
||||
SubFormatType = 1
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 1470
|
||||
TabIndex = 0
|
||||
Top = 225
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.TextBox txtBlank
|
||||
BeginProperty DataFormat
|
||||
Type = 5
|
||||
Format = "0"
|
||||
HaveTrueFalseNull= 1
|
||||
TrueValue = "1"
|
||||
FalseValue = "0"
|
||||
NullValue = ""
|
||||
FirstDayOfWeek = 0
|
||||
FirstWeekOfYear = 0
|
||||
LCID = 1033
|
||||
SubFormatType = 7
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 1470
|
||||
TabIndex = 1
|
||||
Top = 705
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.TextBox txtMuted
|
||||
BeginProperty DataFormat
|
||||
Type = 5
|
||||
Format = "0"
|
||||
HaveTrueFalseNull= 1
|
||||
TrueValue = "1"
|
||||
FalseValue = "0"
|
||||
NullValue = ""
|
||||
FirstDayOfWeek = 0
|
||||
FirstWeekOfYear = 0
|
||||
LCID = 1033
|
||||
SubFormatType = 7
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 1470
|
||||
TabIndex = 2
|
||||
Top = 1185
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.TextBox txtStartTime
|
||||
BeginProperty DataFormat
|
||||
Type = 1
|
||||
Format = "0"
|
||||
HaveTrueFalseNull= 0
|
||||
FirstDayOfWeek = 0
|
||||
FirstWeekOfYear = 0
|
||||
LCID = 1033
|
||||
SubFormatType = 1
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 1470
|
||||
TabIndex = 3
|
||||
Top = 1665
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.TextBox txtStopTime
|
||||
BeginProperty DataFormat
|
||||
Type = 1
|
||||
Format = "0"
|
||||
HaveTrueFalseNull= 0
|
||||
FirstDayOfWeek = 0
|
||||
FirstWeekOfYear = 0
|
||||
LCID = 1033
|
||||
SubFormatType = 1
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 1470
|
||||
TabIndex = 4
|
||||
Top = 2145
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.Label lblPriority
|
||||
Caption = "Priority"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 12
|
||||
Top = 345
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.Label lblBlank
|
||||
Caption = "Blank"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 11
|
||||
Top = 825
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.Label lblMuted
|
||||
Caption = "Muted"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 10
|
||||
Top = 1305
|
||||
Width = 615
|
||||
End
|
||||
Begin VB.Label lblStart
|
||||
Caption = "Start"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 9
|
||||
Top = 1785
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.Label lblStop
|
||||
Caption = "Stop"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 8
|
||||
Top = 2265
|
||||
Width = 1215
|
||||
End
|
||||
End
|
||||
Begin VB.CommandButton cmdOk
|
||||
Caption = "OK"
|
||||
Default = -1 'True
|
||||
Height = 340
|
||||
Left = 3300
|
||||
TabIndex = 5
|
||||
Top = 2850
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.CommandButton cmdCancel
|
||||
Caption = "Cancel"
|
||||
Height = 340
|
||||
Left = 4500
|
||||
TabIndex = 6
|
||||
Top = 2850
|
||||
Width = 1215
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmTrack"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
'*******************************************************************************
|
||||
'* This is a part of the Microsoft DXSDK 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.
|
||||
'* See these sources for detailed information regarding the
|
||||
'* Microsoft samples programs.
|
||||
'*******************************************************************************
|
||||
Option Explicit
|
||||
Option Base 0
|
||||
Option Compare Text
|
||||
|
||||
Private m_intUnloadMode As Integer
|
||||
Private Const DIALOG_TITLE = "Track Help"
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PUBLIC INTERFACE- PROPERTIES
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: UnloadMode
|
||||
' * procedure description: Returns an integer specifying the method from which this dialog was last unloaded
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Property Get UnloadMode() As Integer
|
||||
On Local Error GoTo ErrLine
|
||||
'return the value to the client
|
||||
UnloadMode = m_intUnloadMode
|
||||
Exit Property
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Property
|
||||
End Property
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- FORM EVENT HANDLERS
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Form_Load
|
||||
' * procedure description: Occurs when a form is loaded.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Form_Load()
|
||||
On Local Error GoTo ErrLine
|
||||
'set default value(s)
|
||||
With Me
|
||||
.txtPriority.Text = vbNullString
|
||||
.txtBlank.Text = vbNullString
|
||||
.txtMuted.Text = vbNullString
|
||||
.txtStartTime.Text = vbNullString
|
||||
.txtStopTime.Text = vbNullString
|
||||
End With
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Form_QueryUnload
|
||||
' * procedure description: Occurs before a form or application closes.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
Select Case UnloadMode
|
||||
Case vbFormControlMenu
|
||||
'0 The user chose the Close command from the Control menu on the form.
|
||||
Cancel = 1: Me.Visible = False
|
||||
Case vbFormCode
|
||||
'1 The Unload statement is invoked from code.
|
||||
Case vbAppWindows
|
||||
'2 The current Microsoft Windows operating environment session is ending.
|
||||
Case vbAppTaskManager
|
||||
'3 The Microsoft Windows Task Manager is closing the application.
|
||||
End
|
||||
Case vbFormMDIForm
|
||||
'4 An MDI child form is closing because the MDI form is closing.
|
||||
Case vbFormOwner
|
||||
'5 A form is closing because its owner is closing
|
||||
End Select
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Form_Unload
|
||||
' * procedure description: Occurs when a form is about to be removed from the screen.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Form_Unload(Cancel As Integer)
|
||||
On Local Error GoTo ErrLine
|
||||
With Me
|
||||
.Move 0 - (Screen.Width * 8), 0 - (Screen.Height * 8): .Visible = False
|
||||
End With
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- CONTROL EVENT HANDLERS
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: cmdOk_Click
|
||||
' * procedure description: occures when the 'Ok' command button is pressed
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub cmdOk_Click()
|
||||
Dim nResultant As VbMsgBoxResult
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'validation code
|
||||
If frmTrack.txtPriority.Text = vbNullString Then
|
||||
nResultant = MsgBox("You Must Set Priority", , DIALOG_TITLE)
|
||||
frmTrack.txtPriority.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
If frmTrack.txtBlank.Text = vbNullString Then
|
||||
nResultant = MsgBox("You Must Set Blank", , DIALOG_TITLE)
|
||||
frmTrack.txtBlank.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
If frmTrack.txtMuted.Text = vbNullString Then
|
||||
nResultant = MsgBox("You Must Set Muted", , DIALOG_TITLE)
|
||||
frmTrack.txtMuted.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
If frmTrack.txtStartTime.Text = vbNullString Then
|
||||
nResultant = MsgBox("You Must Set Start", , DIALOG_TITLE)
|
||||
frmTrack.txtStartTime.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
If frmTrack.txtStopTime.Text = vbNullString Then
|
||||
nResultant = MsgBox("You Must Set Stop", , DIALOG_TITLE)
|
||||
frmTrack.txtStopTime.SetFocus
|
||||
Exit Sub
|
||||
End If
|
||||
If CLng(frmTrack.txtStartTime.Text) > CLng(frmTrack.txtStopTime.Text) Then
|
||||
nResultant = MsgBox("Start Must Be Lower Than Stop", , DIALOG_TITLE)
|
||||
frmTrack.txtStartTime.SetFocus
|
||||
End If
|
||||
|
||||
'hide the dialog
|
||||
Me.Visible = False
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: cmdCancel_Click
|
||||
' * procedure description: occures when the user presses the "Cancel" button
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub cmdCancel_Click()
|
||||
On Local Error GoTo ErrLine
|
||||
'hide the dialog
|
||||
Me.Visible = False
|
||||
m_intUnloadMode = 1
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
Binary file not shown.
@@ -0,0 +1,17 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form frmTrans
|
||||
Caption = "Transition Menu"
|
||||
ClientHeight = 3195
|
||||
ClientLeft = 60
|
||||
ClientTop = 345
|
||||
ClientWidth = 4680
|
||||
LinkTopic = "Form2"
|
||||
ScaleHeight = 3195
|
||||
ScaleWidth = 4680
|
||||
StartUpPosition = 3 'Windows Default
|
||||
End
|
||||
Attribute VB_Name = "frmTrans"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
@@ -0,0 +1,328 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form frmTransitions
|
||||
Caption = "Transitions Menu"
|
||||
ClientHeight = 3660
|
||||
ClientLeft = 60
|
||||
ClientTop = 345
|
||||
ClientWidth = 6120
|
||||
Icon = "frmTransitions.frx":0000
|
||||
LinkTopic = "Form2"
|
||||
LockControls = -1 'True
|
||||
ScaleHeight = 3660
|
||||
ScaleWidth = 6120
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
Begin VB.Frame fraFixture
|
||||
Height = 3165
|
||||
Left = 75
|
||||
TabIndex = 9
|
||||
Top = 0
|
||||
Width = 5940
|
||||
Begin VB.TextBox txtSwapInputs
|
||||
Height = 375
|
||||
Left = 1830
|
||||
TabIndex = 5
|
||||
Top = 2625
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.TextBox txtCutsOnly
|
||||
Height = 375
|
||||
Left = 1830
|
||||
TabIndex = 4
|
||||
Top = 2145
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.TextBox txtCutpoint
|
||||
Height = 375
|
||||
Left = 1830
|
||||
TabIndex = 3
|
||||
Top = 1665
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.TextBox txtStopTime
|
||||
Height = 375
|
||||
Left = 1830
|
||||
TabIndex = 2
|
||||
Top = 1185
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.TextBox txtStartTime
|
||||
Height = 375
|
||||
Left = 1830
|
||||
TabIndex = 1
|
||||
Top = 705
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.ComboBox cmbTransition
|
||||
Height = 315
|
||||
Left = 1830
|
||||
Sorted = -1 'True
|
||||
TabIndex = 0
|
||||
Top = 225
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.Label lblSwapInputs
|
||||
Caption = "Swap Inputs"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 15
|
||||
Top = 2745
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.Label lblCutsOnly
|
||||
Caption = "Cuts Only"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 14
|
||||
Top = 2265
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.Label lblCutpoint
|
||||
Caption = "Cutpoint"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 13
|
||||
Top = 1785
|
||||
Width = 1335
|
||||
End
|
||||
Begin VB.Label lblStop
|
||||
Caption = "Stop"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 12
|
||||
Top = 1305
|
||||
Width = 615
|
||||
End
|
||||
Begin VB.Label lblStart
|
||||
Caption = "Start"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 11
|
||||
Top = 825
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.Label lblTransition
|
||||
Caption = "Transition"
|
||||
Height = 255
|
||||
Left = 150
|
||||
TabIndex = 10
|
||||
Top = 345
|
||||
Width = 1695
|
||||
End
|
||||
End
|
||||
Begin VB.CommandButton cmdOk
|
||||
Caption = "OK"
|
||||
Default = -1 'True
|
||||
Height = 340
|
||||
Left = 3615
|
||||
TabIndex = 6
|
||||
Top = 3255
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.CommandButton cmdCancel
|
||||
Caption = "Cancel"
|
||||
Height = 340
|
||||
Left = 4815
|
||||
TabIndex = 7
|
||||
Top = 3255
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.TextBox GetSubObjectGUIDB
|
||||
Height = 420
|
||||
Left = 6300
|
||||
TabIndex = 8
|
||||
Top = 75
|
||||
Visible = 0 'False
|
||||
Width = 915
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmTransitions"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
'*******************************************************************************
|
||||
'* This is a part of the Microsoft DXSDK 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.
|
||||
'* See these sources for detailed information regarding the
|
||||
'* Microsoft samples programs.
|
||||
'*******************************************************************************
|
||||
Option Explicit
|
||||
Option Base 0
|
||||
Option Compare Text
|
||||
|
||||
Private m_intUnloadMode As Integer
|
||||
Private Const DIALOG_TITLE = "Transition Help"
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PUBLIC INTERFACE- PROPERTIES
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: UnloadMode
|
||||
' * procedure description: Returns an integer specifying the method from which this dialog was last unloaded
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Property Get UnloadMode() As Integer
|
||||
On Local Error GoTo ErrLine
|
||||
'return the value to the client
|
||||
UnloadMode = m_intUnloadMode
|
||||
Exit Property
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Property
|
||||
End Property
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- FORM EVENT HANDLERS
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Form_Load
|
||||
' * procedure description: Occurs when a form is loaded.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Form_Load()
|
||||
On Local Error GoTo ErrLine
|
||||
'set default value(s)
|
||||
With cmbTransition
|
||||
.AddItem "Barn"
|
||||
.AddItem "Blinds"
|
||||
.AddItem "BurnFilm"
|
||||
.AddItem "CenterCurls"
|
||||
.AddItem "ColorFade"
|
||||
.AddItem "Compositor"
|
||||
.AddItem "Curls"
|
||||
.AddItem "Curtains"
|
||||
.AddItem "Fade"
|
||||
.AddItem "FadeWhite"
|
||||
.AddItem "FlowMotion"
|
||||
.AddItem "GlassBlock"
|
||||
.AddItem "Grid"
|
||||
.AddItem "Inset"
|
||||
.AddItem "Iris"
|
||||
.AddItem "Jaws"
|
||||
.AddItem "Lens"
|
||||
.AddItem "LightWipe"
|
||||
.AddItem "Liquid"
|
||||
.AddItem "PageCurl"
|
||||
.AddItem "PeelABCD"
|
||||
.AddItem "Pixelate"
|
||||
.AddItem "RadialWipe"
|
||||
.AddItem "Ripple"
|
||||
.AddItem "RollDown"
|
||||
.AddItem "Slide"
|
||||
.AddItem "SMPTE Wipe"
|
||||
.AddItem "Spiral"
|
||||
.AddItem "Stretch"
|
||||
.AddItem "Threshold"
|
||||
.AddItem "Twister"
|
||||
.AddItem "Vacuum"
|
||||
.AddItem "Water"
|
||||
.AddItem "Wheel"
|
||||
.AddItem "Wipe"
|
||||
.AddItem "WormHole"
|
||||
.AddItem "Zigzag"
|
||||
End With
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Form_QueryUnload
|
||||
' * procedure description: Occurs before a form or application closes.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
Select Case UnloadMode
|
||||
Case vbFormControlMenu
|
||||
'0 The user chose the Close command from the Control menu on the form.
|
||||
Cancel = 1: Me.Visible = False
|
||||
Case vbFormCode
|
||||
'1 The Unload statement is invoked from code.
|
||||
Case vbAppWindows
|
||||
'2 The current Microsoft Windows operating environment session is ending.
|
||||
Case vbAppTaskManager
|
||||
'3 The Microsoft Windows Task Manager is closing the application.
|
||||
End
|
||||
Case vbFormMDIForm
|
||||
'4 An MDI child form is closing because the MDI form is closing.
|
||||
Case vbFormOwner
|
||||
'5 A form is closing because its owner is closing
|
||||
End Select
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Form_Unload
|
||||
' * procedure description: Occurs when a form is about to be removed from the screen.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Form_Unload(Cancel As Integer)
|
||||
On Local Error GoTo ErrLine
|
||||
With Me
|
||||
.Move 0 - (Screen.Width * 8), 0 - (Screen.Height * 8): .Visible = False
|
||||
End With
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- CONTROL EVENT HANDLERS
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: cmdOk_Click
|
||||
' * procedure description: occures when the user presses the 'Ok' button
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub cmdOk_Click()
|
||||
On Local Error GoTo ErrLine
|
||||
'hide dialog
|
||||
Me.Visible = False
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: cmdOk_Click
|
||||
' * procedure description: occures when the user presses the 'Cancel' button
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub cmdCancel_Click()
|
||||
On Local Error GoTo ErrLine
|
||||
'hide dialog
|
||||
Me.Visible = False
|
||||
m_intUnloadMode = 1
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,768 @@
|
||||
Attribute VB_Name = "modDisposable"
|
||||
'*******************************************************************************
|
||||
'* This is a part of the Microsoft DXSDK 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.
|
||||
'* See these sources for detailed information regarding the
|
||||
'* Microsoft samples programs.
|
||||
'*******************************************************************************
|
||||
Option Explicit
|
||||
Option Base 0
|
||||
Option Compare Text
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PUBLIC INTERFACE- GENERAL PROCEDURES
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: GetTimelineDirect
|
||||
' * procedure description: Populate the treeview control by walking the Timeline via Dexter API's
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Sub GetTimelineDirect(ctrlTreeView As TreeView, objTimeline As AMTimeline, Optional colDataStore As Collection)
|
||||
Dim nCount As Long
|
||||
Dim objNode As node
|
||||
Dim nGroupCount As Long
|
||||
Dim bstrRootGUID As String
|
||||
Dim bstrGroupGUID As String
|
||||
Dim objGroup As AMTimelineGroup
|
||||
Dim objTimelineObject As AMTimelineObj
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'Ensure the treeview control's nodes are cleared
|
||||
If Not ctrlTreeView Is Nothing Then
|
||||
If ctrlTreeView.Nodes.Count <> 0 Then
|
||||
ctrlTreeView.Nodes.Clear
|
||||
End If
|
||||
End If
|
||||
|
||||
'clear the collection
|
||||
If Not colDataStore Is Nothing Then
|
||||
Do Until colDataStore.Count = 0
|
||||
colDataStore.Remove 1
|
||||
Loop
|
||||
End If
|
||||
|
||||
'get a guid for a key
|
||||
bstrRootGUID = GetGUID
|
||||
'Insert the root timeline node
|
||||
Set objNode = ctrlTreeView.Nodes.Add(, , bstrRootGUID, "TimeLine 1", 1)
|
||||
objNode.Tag = "AMTimeline"
|
||||
'append to datastore (optional)
|
||||
If Not colDataStore Is Nothing Then colDataStore.Add objTimeline, bstrRootGUID
|
||||
|
||||
|
||||
'Obtain the number of groups to populate with
|
||||
nGroupCount = GetGroupCount(objTimeline)
|
||||
While nCount < nGroupCount: DoEvents
|
||||
'get the group
|
||||
objTimeline.GetGroup objTimelineObject, nCount
|
||||
'instantiate the local copy
|
||||
Set objGroup = objTimelineObject
|
||||
'get a guid for a key
|
||||
bstrGroupGUID = GetGUID
|
||||
'Insert the group timeline node
|
||||
Set objNode = ctrlTreeView.Nodes.Add(1, 4, bstrGroupGUID, "Group" + CStr(nCount) & Chr(32), 2)
|
||||
objNode.Tag = "AMTimelineGroup"
|
||||
'append to datastore (optional)
|
||||
If Not colDataStore Is Nothing Then colDataStore.Add objGroup, bstrGroupGUID
|
||||
'append all tracks
|
||||
AddTracks ctrlTreeView, bstrGroupGUID, objTimelineObject, colDataStore
|
||||
'append all effects
|
||||
AddEffects ctrlTreeView, bstrGroupGUID, objTimelineObject, colDataStore
|
||||
'append all transitions
|
||||
AddTransitions ctrlTreeView, bstrGroupGUID, objTimelineObject, colDataStore
|
||||
'append compositions
|
||||
AddComposites ctrlTreeView, bstrGroupGUID, objTimelineObject, colDataStore
|
||||
'dereference & clean-up
|
||||
If Not objGroup Is Nothing Then Set objGroup = Nothing
|
||||
If Not objTimelineObject Is Nothing Then Set objTimelineObject = Nothing
|
||||
'increment the group count by a factor of one
|
||||
nCount = nCount + 1
|
||||
Wend
|
||||
|
||||
'expand all items in the treeview control
|
||||
For nCount = 1 To ctrlTreeView.Nodes.Count
|
||||
ctrlTreeView.Nodes(nCount).Expanded = True
|
||||
Next
|
||||
|
||||
'clean-up & dereference
|
||||
If Not objGroup Is Nothing Then Set objGroup = Nothing
|
||||
If Not objTimelineObject Is Nothing Then Set objTimelineObject = Nothing
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: RefreshListView
|
||||
' * procedure description: Updates the listview
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Sub RefreshListView(ctrlListView As ListView, bstrType As String, bstrKey As String)
|
||||
Dim objListItem As ListItem
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'setup listview
|
||||
If ctrlListView.View <> lvwReport Then ctrlListView.View = lvwReport
|
||||
If ctrlListView.ListItems.Count <> 0 Then Call ctrlListView.ListItems.Clear
|
||||
If ctrlListView.ColumnHeaders.Count = 0 Then
|
||||
ctrlListView.ColumnHeaders.Add , "Parameter", "Parameter", (ctrlListView.Width / 2) - 50
|
||||
ctrlListView.ColumnHeaders.Add , "Value", "Value", (ctrlListView.Width / 2) - 50
|
||||
End If
|
||||
'append items to the listview
|
||||
Set objListItem = ctrlListView.ListItems.Add(1, "Type", "Type")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = bstrType
|
||||
Set objListItem = ctrlListView.ListItems.Add(2, "Key Name", "Key Name")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = bstrKey
|
||||
Set objListItem = ctrlListView.ListItems.Add(3, Space(1), Space(1))
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = Space(1)
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PUBLIC INTERFACE- ADD PROCEDURES (PROCEDURES ADD GIVEN ITEMS TO THE TREEVIEW)
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: AddComposites
|
||||
' * procedure description: appends all composites on to the treeview
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Sub AddComposites(ctrlTreeView As TreeView, bstrParent As String, objTimelineObject As AMTimelineObj, Optional colDataStore As Collection)
|
||||
Dim nType As Long
|
||||
Dim objNode As node
|
||||
Dim nPriority As Long
|
||||
Dim bstrGUID As String
|
||||
Dim nTrackCount As Long
|
||||
Dim nTotalVirtualTracks As Long
|
||||
Dim objComp As AMTimelineComp
|
||||
Dim objLocalTimelineObject As AMTimelineObj
|
||||
Dim objCompVirtualTrack As IAMTimelineVirtualTrack
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'derive composition
|
||||
Set objComp = objTimelineObject
|
||||
'obtain track count
|
||||
objComp.VTrackGetCount nTotalVirtualTracks
|
||||
|
||||
|
||||
'loop through the tracks
|
||||
While nTrackCount < nTotalVirtualTracks: DoEvents
|
||||
'get the object
|
||||
objComp.GetVTrack objLocalTimelineObject, nTrackCount
|
||||
'obtain the timeline type
|
||||
objLocalTimelineObject.GetTimelineType nType
|
||||
|
||||
If nType = TIMELINE_MAJOR_TYPE_COMPOSITE Then
|
||||
'obtain the comp
|
||||
Set objCompVirtualTrack = objLocalTimelineObject
|
||||
'obtain the Priority
|
||||
objCompVirtualTrack.TrackGetPriority nPriority
|
||||
'get a guid for a key
|
||||
bstrGUID = GetGUID
|
||||
'Insert the root timeline node
|
||||
Set objNode = ctrlTreeView.Nodes.Add(bstrParent, 4, bstrGUID, "Comp" & CStr(nPriority) & Chr(32), 2)
|
||||
objNode.Tag = "AMTimelineComp"
|
||||
'append to datastore (optional)
|
||||
If Not colDataStore Is Nothing Then colDataStore.Add objCompVirtualTrack, bstrGUID
|
||||
'recursive call of dependent children
|
||||
Call AddEffects(ctrlTreeView, bstrGUID, objLocalTimelineObject, colDataStore)
|
||||
Call AddTransitions(ctrlTreeView, bstrGUID, objLocalTimelineObject, colDataStore)
|
||||
Call AddComposites(ctrlTreeView, bstrGUID, objLocalTimelineObject, colDataStore)
|
||||
|
||||
ElseIf nType = TIMELINE_MAJOR_TYPE_TRACK Then
|
||||
'recursive call of dependent children
|
||||
AddTracks ctrlTreeView, bstrParent, objLocalTimelineObject, colDataStore
|
||||
End If
|
||||
|
||||
'clean-up & dereference
|
||||
If Not objCompVirtualTrack Is Nothing Then Set objCompVirtualTrack = Nothing
|
||||
If Not objLocalTimelineObject Is Nothing Then Set objLocalTimelineObject = Nothing
|
||||
'increment track counter
|
||||
nTrackCount = nTrackCount + 1
|
||||
Wend
|
||||
|
||||
'clean-up & dereference
|
||||
If Not objNode Is Nothing Then Set objNode = Nothing
|
||||
If Not objComp Is Nothing Then Set objComp = Nothing
|
||||
If Not objCompVirtualTrack Is Nothing Then Set objCompVirtualTrack = Nothing
|
||||
If Not objLocalTimelineObject Is Nothing Then Set objLocalTimelineObject = Nothing
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: AddEffects
|
||||
' * procedure description: appends all effects on to the treeview
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Sub AddEffects(ctrlTreeView As TreeView, bstrParent As String, objTimelineObject As AMTimelineObj, Optional colDataStore As Collection)
|
||||
Dim objNode As node
|
||||
Dim bstrGUID As String
|
||||
Dim nEffectCount As Long
|
||||
Dim nTotalEffects As Long
|
||||
Dim objEffect As AMTimelineEffect
|
||||
Dim objLocalTimelineObject As AMTimelineObj
|
||||
Dim objEffectable As IAMTimelineEffectable
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
Set objEffectable = objTimelineObject
|
||||
objEffectable.EffectGetCount nTotalEffects
|
||||
|
||||
While nEffectCount < nTotalEffects: DoEvents
|
||||
'get the timeline object
|
||||
objEffectable.GetEffect objLocalTimelineObject, nEffectCount
|
||||
'get the effect from the timeline object
|
||||
Set objEffect = objLocalTimelineObject
|
||||
'get a guid for a key
|
||||
bstrGUID = GetGUID
|
||||
'Insert the effect timeline node
|
||||
Set objNode = ctrlTreeView.Nodes.Add(bstrParent, 4, bstrGUID, "Effect" & CStr(nEffectCount) & Chr(32), 2)
|
||||
objNode.Tag = "AMTimelineEffect"
|
||||
'append to datastore (optional)
|
||||
If Not colDataStore Is Nothing Then colDataStore.Add objEffect, bstrGUID
|
||||
'clean-up & dereference
|
||||
If Not objEffect Is Nothing Then Set objEffect = Nothing
|
||||
If Not objLocalTimelineObject Is Nothing Then Set objLocalTimelineObject = Nothing
|
||||
'increment the count
|
||||
nEffectCount = nEffectCount + 1
|
||||
Wend
|
||||
|
||||
'clean-up & dereference
|
||||
If Not objNode Is Nothing Then Set objNode = Nothing
|
||||
If Not objEffect Is Nothing Then Set objEffect = Nothing
|
||||
If Not objEffectable Is Nothing Then Set objEffectable = Nothing
|
||||
If Not objLocalTimelineObject Is Nothing Then Set objLocalTimelineObject = Nothing
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: AddTracks
|
||||
' * procedure description: appends all tracks on to the treeview; objTimelineObject evaluates to a virtual track
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Sub AddTracks(ctrlTreeView As TreeView, bstrParent As String, objTimelineObject As AMTimelineObj, Optional colDataStore As Collection)
|
||||
Dim objNode As node
|
||||
Dim nPriority As Long
|
||||
Dim bstrGUID As String
|
||||
Dim objTrack As AMTimelineTrack
|
||||
Dim objVirtualTrack As IAMTimelineVirtualTrack
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'get the track object
|
||||
Set objTrack = objTimelineObject
|
||||
'get the virtual track object
|
||||
Set objVirtualTrack = objTrack
|
||||
'get the virtual track priority
|
||||
objVirtualTrack.TrackGetPriority nPriority
|
||||
|
||||
'get a guid for a key
|
||||
bstrGUID = GetGUID
|
||||
'Insert the root timeline node
|
||||
Set objNode = ctrlTreeView.Nodes.Add(bstrParent, 4, bstrGUID, "Track" & CStr(nPriority) & Chr(32), 2)
|
||||
objNode.Tag = "AMTimelineTrack"
|
||||
'append to datastore (optional)
|
||||
If Not colDataStore Is Nothing Then colDataStore.Add objTrack, bstrGUID
|
||||
'recursive call of dependent children
|
||||
Call AddSources(ctrlTreeView, bstrGUID, objTimelineObject, colDataStore)
|
||||
Call AddEffects(ctrlTreeView, bstrGUID, objTimelineObject, colDataStore)
|
||||
Call AddTransitions(ctrlTreeView, bstrGUID, objTimelineObject, colDataStore)
|
||||
'clean-up & dereference
|
||||
If Not objNode Is Nothing Then Set objNode = Nothing
|
||||
If Not objTrack Is Nothing Then Set objTrack = Nothing
|
||||
If Not objVirtualTrack Is Nothing Then Set objVirtualTrack = Nothing
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: AddSources
|
||||
' * procedure description: appends all sources on to the treeview
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Sub AddSources(ctrlTreeView As TreeView, bstrParent As String, objTimelineObject As AMTimelineObj, Optional colDataStore As Collection)
|
||||
Dim objNode As node
|
||||
Dim dblStart As Double
|
||||
Dim bstrGUID As String
|
||||
Dim nSourceCount As Long
|
||||
Dim nTotalSources As Long
|
||||
Dim objSource As AMTimelineSrc
|
||||
Dim objTrack As AMTimelineTrack
|
||||
Dim objLocalTimelineObject As AMTimelineObj
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'get a track
|
||||
Set objTrack = objTimelineObject
|
||||
'get the number of sources
|
||||
objTrack.GetSourcesCount nTotalSources
|
||||
|
||||
|
||||
While nSourceCount < nTotalSources: DoEvents
|
||||
'get the timeline object
|
||||
objTrack.GetNextSrc2 objLocalTimelineObject, dblStart
|
||||
'derive the source object from the timeline object
|
||||
Set objSource = objLocalTimelineObject
|
||||
'get a guid for a key
|
||||
bstrGUID = GetGUID
|
||||
'Insert the root timeline node
|
||||
Set objNode = ctrlTreeView.Nodes.Add(bstrParent, 4, bstrGUID, "Clip" & CStr(nSourceCount) & Chr(32), 2)
|
||||
objNode.Tag = "AMTimelineSrc"
|
||||
'append to datastore (optional)
|
||||
If Not colDataStore Is Nothing Then colDataStore.Add objSource, bstrGUID
|
||||
'dereference & clean-up
|
||||
If Not objSource Is Nothing Then Set objSource = Nothing
|
||||
If Not objLocalTimelineObject Is Nothing Then Set objLocalTimelineObject = Nothing
|
||||
'increment the source counter
|
||||
nSourceCount = nSourceCount + 1
|
||||
Wend
|
||||
'dereference & clean-up
|
||||
If Not objNode Is Nothing Then Set objNode = Nothing
|
||||
If Not objTrack Is Nothing Then Set objTrack = Nothing
|
||||
If Not objSource Is Nothing Then Set objSource = Nothing
|
||||
If Not objLocalTimelineObject Is Nothing Then Set objLocalTimelineObject = Nothing
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: AddTransitions
|
||||
' * procedure description: appends an all the transitions on to the treeview
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Sub AddTransitions(ctrlTreeView As TreeView, bstrParent As String, objTimelineObject As AMTimelineObj, Optional colDataStore As Collection)
|
||||
Dim objNode As node
|
||||
Dim bstrGUID As String
|
||||
Dim nTransitionCount As Long
|
||||
Dim nTotalTransitions As Long
|
||||
Dim dblReferenceTime As Double
|
||||
Dim objTransition As AMTimelineTrans
|
||||
Dim objTransable As IAMTimelineTransable
|
||||
Dim objLocalTimelineObject As AMTimelineObj
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'get the transable
|
||||
Set objTransable = objTimelineObject
|
||||
'get the transition count
|
||||
objTransable.TransGetCount nTotalTransitions
|
||||
|
||||
While nTransitionCount < nTotalTransitions: DoEvents
|
||||
'get the next transition into a timeline object
|
||||
objTransable.GetNextTrans2 objLocalTimelineObject, dblReferenceTime
|
||||
'get the transition object from the timeline object
|
||||
Set objTransition = objLocalTimelineObject
|
||||
'get a guid for a key
|
||||
bstrGUID = GetGUID
|
||||
'Insert the root timeline node
|
||||
Set objNode = ctrlTreeView.Nodes.Add(bstrParent, 4, bstrGUID, "Transition" & CStr(nTransitionCount) & Chr(32), 2)
|
||||
objNode.Tag = "AMTimelineTrans"
|
||||
'append to datastore (optional)
|
||||
If Not colDataStore Is Nothing Then colDataStore.Add objTransition, bstrGUID
|
||||
'clean-up & dereference
|
||||
If Not objTransition Is Nothing Then Set objTransition = Nothing
|
||||
If Not objLocalTimelineObject Is Nothing Then Set objLocalTimelineObject = Nothing
|
||||
'increment the transition count
|
||||
nTransitionCount = nTransitionCount + 1
|
||||
Wend
|
||||
|
||||
'clean-up & dereference
|
||||
If Not objNode Is Nothing Then Set objNode = Nothing
|
||||
If Not objTransable Is Nothing Then Set objTransable = Nothing
|
||||
If Not objTransition Is Nothing Then Set objTransition = Nothing
|
||||
If Not objLocalTimelineObject Is Nothing Then Set objLocalTimelineObject = Nothing
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PUBLIC INTERFACE- VIEW PROCEDURES (PROCEDURES GET INFO FROM A TIMELINE OBJECT & DISPLAY IN LISTVIEW)
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: ViewTimelineInfo
|
||||
' * procedure description: updates the ide/listview to display the given objTimeline information
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Sub ViewTimelineInfo(ctrlListView As ListView, objTimeline As AMTimeline)
|
||||
Dim nDirty As Long
|
||||
Dim nInsertMode As Long
|
||||
Dim dblDuration As Double
|
||||
Dim objListItem As ListItem
|
||||
Dim nEffectsEnabled As Long
|
||||
Dim dblDefaultFPS As Double
|
||||
Dim bstrDefaultEffect As String
|
||||
Dim nTransitionsEnabled As Long
|
||||
Dim bstrDefaultTransition As String
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'obtain property value(s)
|
||||
objTimeline.GetInsertMode nInsertMode
|
||||
objTimeline.TransitionsEnabled nTransitionsEnabled
|
||||
objTimeline.EffectsEnabled nEffectsEnabled
|
||||
objTimeline.GetDefaultFPS dblDefaultFPS
|
||||
objTimeline.IsDirty nDirty
|
||||
bstrDefaultTransition = objTimeline.GetDefaultTransitionB
|
||||
bstrDefaultEffect = objTimeline.GetDefaultEffectB
|
||||
|
||||
'append timeline's information to the listview
|
||||
Set objListItem = ctrlListView.ListItems.Add(4, "InsertMode", "InsertMode")
|
||||
If nInsertMode = 2 Then
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = "INSERT"
|
||||
Else: objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = "OVERLAY"
|
||||
End If
|
||||
Set objListItem = ctrlListView.ListItems.Add(5, "TransitionsEnabled", "TransitionsEnabled")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(nTransitionsEnabled)
|
||||
Set objListItem = ctrlListView.ListItems.Add(6, "EffectsEnabled", "EffectsEnabled")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(nEffectsEnabled)
|
||||
Set objListItem = ctrlListView.ListItems.Add(7, "Duration", "Duration")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(dblDuration)
|
||||
Set objListItem = ctrlListView.ListItems.Add(8, "DefaultFPS", "DefaultFPS")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(dblDefaultFPS)
|
||||
Set objListItem = ctrlListView.ListItems.Add(9, "Dirty", "Dirty")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(nDirty)
|
||||
Set objListItem = ctrlListView.ListItems.Add(10, "DefaultTransition", "DefaultTransition")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = bstrDefaultTransition
|
||||
Set objListItem = ctrlListView.ListItems.Add(11, "DefaultEffect", "DefaultEffect")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = bstrDefaultEffect
|
||||
|
||||
'clean-up & dereference
|
||||
If Not objListItem Is Nothing Then Set objListItem = Nothing
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: ViewGroupInfo
|
||||
' * procedure description: updates the ide/listview to display the given group information
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Sub ViewGroupInfo(ctrlListView As ListView, objTimelineObject As AMTimelineObj)
|
||||
Dim nPriority As Long
|
||||
Dim nMediaType As Long
|
||||
Dim objListItem As ListItem
|
||||
Dim nPreviewMode As Long
|
||||
Dim dblOutputFPS As Double
|
||||
Dim bstrGroupName As String
|
||||
Dim nOutputBuffering As Long
|
||||
Dim objGroup As AMTimelineGroup
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'obtain group from timeline object
|
||||
Set objGroup = objTimelineObject
|
||||
|
||||
'obtain property value(s)
|
||||
objGroup.GetPriority nPriority
|
||||
objGroup.GetOutputFPS dblOutputFPS
|
||||
objGroup.GetPreviewMode nPreviewMode
|
||||
objGroup.GetOutputBuffering nOutputBuffering
|
||||
|
||||
'append the timeline's information to the listview control
|
||||
Set objListItem = ctrlListView.ListItems.Add(4, "GroupName", "GroupName")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(bstrGroupName)
|
||||
Set objListItem = ctrlListView.ListItems.Add(5, "MediaType", "MediaType")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(nMediaType)
|
||||
Set objListItem = ctrlListView.ListItems.Add(6, "Priority", "Priority")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(nPriority)
|
||||
Set objListItem = ctrlListView.ListItems.Add(7, "OutputFPS", "OutputFPS")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(dblOutputFPS)
|
||||
Set objListItem = ctrlListView.ListItems.Add(8, "PreviewMode", "PreviewMode")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(nPreviewMode)
|
||||
Set objListItem = ctrlListView.ListItems.Add(9, "Buffering", "Buffering")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(nOutputBuffering)
|
||||
|
||||
'clean-up & dereference
|
||||
If Not objGroup Is Nothing Then Set objGroup = Nothing
|
||||
If Not objListItem Is Nothing Then Set objListItem = Nothing
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: ViewCompositeInfo
|
||||
' * procedure description: updates the ide/listview to display the given composition information
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Sub ViewCompositeInfo(ctrlListView As ListView, objTimelineObject As AMTimelineObj)
|
||||
Dim nPriority As Long
|
||||
Dim objListItem As ListItem
|
||||
Dim dblStartTime As Double
|
||||
Dim dblStopTime As Double
|
||||
Dim objVirtualTrack As IAMTimelineVirtualTrack
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'obtain the virtual track from the timeline object
|
||||
Set objVirtualTrack = objTimelineObject
|
||||
|
||||
'obtain property value(s)
|
||||
objVirtualTrack.TrackGetPriority nPriority
|
||||
objTimelineObject.GetStartStop2 dblStartTime, dblStopTime
|
||||
|
||||
'append the composite's information to the listview control
|
||||
Set objListItem = ctrlListView.ListItems.Add(4, "Priority", "Priority")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(nPriority)
|
||||
Set objListItem = ctrlListView.ListItems.Add(5, "Start", "Start")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(dblStartTime)
|
||||
Set objListItem = ctrlListView.ListItems.Add(6, "Stop", "Stop")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(dblStopTime)
|
||||
|
||||
'clean-up & dereference
|
||||
If Not objListItem Is Nothing Then Set objListItem = Nothing
|
||||
If Not objVirtualTrack Is Nothing Then Set objVirtualTrack = Nothing
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: ViewTransitionInfo
|
||||
' * procedure description: updates the ide/listview to display the given transition information
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Sub ViewTransitionInfo(ctrlListView As ListView, objTimelineObject As AMTimelineObj)
|
||||
Dim nCutsOnly As Long
|
||||
Dim nSwapInputs As Long
|
||||
Dim dblCutpoint As Double
|
||||
Dim objListItem As ListItem
|
||||
Dim dblStartTime As Double
|
||||
Dim dblStopTime As Double
|
||||
Dim objTransition As AMTimelineTrans
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'obtain transition from given timeline object
|
||||
Set objTransition = objTimelineObject
|
||||
|
||||
'obtain property values
|
||||
objTimelineObject.GetStartStop2 dblStartTime, dblStopTime
|
||||
objTransition.GetCutPoint2 dblCutpoint
|
||||
objTransition.GetCutsOnly nCutsOnly
|
||||
objTransition.GetSwapInputs nSwapInputs
|
||||
|
||||
'append transition's information to the listview control
|
||||
Set objListItem = ctrlListView.ListItems.Add(4, "CLSID", "CLSID")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(objTimelineObject.GetSubObjectGUIDB)
|
||||
Set objListItem = ctrlListView.ListItems.Add(5, "Start", "Start")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(dblStartTime)
|
||||
Set objListItem = ctrlListView.ListItems.Add(6, "Stop", "Stop")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(dblStopTime)
|
||||
Set objListItem = ctrlListView.ListItems.Add(7, "CutPoint", "CutPoint")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(dblCutpoint)
|
||||
Set objListItem = ctrlListView.ListItems.Add(8, "CutsOnly", "CutsOnly")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(nCutsOnly)
|
||||
Set objListItem = ctrlListView.ListItems.Add(9, "SwapIputs", "SwapIputs")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(nSwapInputs)
|
||||
|
||||
'clean-up & dereference
|
||||
If Not objTransition Is Nothing Then Set objTransition = Nothing
|
||||
If Not objListItem Is Nothing Then Set objListItem = Nothing
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: ViewEffectInfo
|
||||
' * procedure description: updates the ide/listview to display the given effect information
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Sub ViewEffectInfo(ctrlListView As ListView, objTimelineObject As AMTimelineObj)
|
||||
Dim nPriority As Long
|
||||
Dim objListItem As ListItem
|
||||
Dim dblStartTime As Double
|
||||
Dim dblStopTime As Double
|
||||
Dim objEffect As AMTimelineEffect
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'obtain effect object from timeline object
|
||||
Set objEffect = objTimelineObject
|
||||
|
||||
'obtain property values
|
||||
objEffect.EffectGetPriority nPriority
|
||||
objTimelineObject.GetStartStop2 dblStartTime, dblStopTime
|
||||
|
||||
'append the effect's information to the listview control
|
||||
Set objListItem = ctrlListView.ListItems.Add(4, "CLSID", "CLSID")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(objTimelineObject.GetSubObjectGUIDB)
|
||||
Set objListItem = ctrlListView.ListItems.Add(5, "Start", "Start")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(dblStartTime)
|
||||
Set objListItem = ctrlListView.ListItems.Add(6, "Stop", "Stop")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(dblStopTime)
|
||||
|
||||
'clean-up & dereference
|
||||
If Not objEffect Is Nothing Then Set objEffect = Nothing
|
||||
If Not objListItem Is Nothing Then Set objListItem = Nothing
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: ViewTrackInfo
|
||||
' * procedure description: updates the ide/listview to display the given track information
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Sub ViewTrackInfo(ctrlListView As ListView, objTimelineObject As AMTimelineObj)
|
||||
Dim nBlank As Long
|
||||
Dim nPriority As Long
|
||||
Dim nMuted As Long
|
||||
Dim dblStartTime As Double
|
||||
Dim dblStopTime As Double
|
||||
Dim objListItem As ListItem
|
||||
Dim objTimelineTrack As AMTimelineTrack
|
||||
Dim objTimelineVirtualTrack As IAMTimelineVirtualTrack
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'obtain timeline track from given timeline object
|
||||
Set objTimelineTrack = objTimelineObject
|
||||
'obtain virtual timeline track from given timeline object
|
||||
Set objTimelineVirtualTrack = objTimelineTrack
|
||||
|
||||
'get track property values
|
||||
objTimelineTrack.AreYouBlank nBlank
|
||||
objTimelineObject.GetMuted nMuted
|
||||
objTimelineObject.GetStartStop2 dblStartTime, dblStopTime
|
||||
objTimelineVirtualTrack.TrackGetPriority nPriority
|
||||
|
||||
'append the track's information to the listview control
|
||||
Set objListItem = ctrlListView.ListItems.Add(4, "Priority", "Priority")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(nPriority)
|
||||
Set objListItem = ctrlListView.ListItems.Add(5, "Blank", "Blank")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(nBlank)
|
||||
Set objListItem = ctrlListView.ListItems.Add(6, "Muted", "Muted")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(nMuted)
|
||||
Set objListItem = ctrlListView.ListItems.Add(7, "Start", "Start")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(dblStartTime)
|
||||
Set objListItem = ctrlListView.ListItems.Add(8, "Stop", "Stop")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(dblStopTime)
|
||||
|
||||
'dereference & clean-up
|
||||
If Not objListItem Is Nothing Then Set objListItem = Nothing
|
||||
If Not objTimelineTrack Is Nothing Then Set objTimelineTrack = Nothing
|
||||
If Not objTimelineVirtualTrack Is Nothing Then Set objTimelineVirtualTrack = Nothing
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: ViewSourceInfo
|
||||
' * procedure description: updates the ide/listview to display the given source information
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Sub ViewSourceInfo(ctrlListView As ListView, objTimelineObject As AMTimelineObj)
|
||||
Dim nMuted As Long
|
||||
Dim dblTStart As Double
|
||||
Dim dblTStop As Double
|
||||
Dim nStretchMode As Long
|
||||
Dim objListItem As ListItem
|
||||
Dim dblStartTime As Double
|
||||
Dim nStreamNumber As Long
|
||||
Dim dblDefaultFPS As Double
|
||||
Dim bstrMediaName As String
|
||||
Dim dblMediaLength As Double
|
||||
Dim dblMediaStartTime As Double
|
||||
Dim dblMediaStopTime As Double
|
||||
Dim objTimelineSource As AMTimelineSrc
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'obtain source from given timeline object
|
||||
Set objTimelineSource = objTimelineObject
|
||||
|
||||
'obtain property values given the source object
|
||||
bstrMediaName = objTimelineSource.GetMediaName
|
||||
objTimelineSource.GetMediaTimes2 dblMediaStartTime, dblMediaStopTime
|
||||
objTimelineObject.GetStartStop2 dblTStart, dblTStop
|
||||
objTimelineSource.GetDefaultFPS dblDefaultFPS
|
||||
objTimelineSource.GetStreamNumber nStreamNumber
|
||||
objTimelineSource.GetStretchMode nStretchMode
|
||||
objTimelineObject.GetMuted nMuted
|
||||
|
||||
'append source information on to the listview control
|
||||
Set objListItem = ctrlListView.ListItems.Add(4, "MediaName", "MediaName")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(bstrMediaName)
|
||||
Set objListItem = ctrlListView.ListItems.Add(5, "MStart", "MStart")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(dblMediaStartTime)
|
||||
Set objListItem = ctrlListView.ListItems.Add(6, "MStop", "MStop")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(dblMediaStopTime)
|
||||
Set objListItem = ctrlListView.ListItems.Add(7, "TStart", "TStart")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(dblTStart)
|
||||
Set objListItem = ctrlListView.ListItems.Add(8, "TStop", "TStop")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(dblTStop)
|
||||
Set objListItem = ctrlListView.ListItems.Add(9, "MediaLength", "MediaLength")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(dblMediaLength)
|
||||
Set objListItem = ctrlListView.ListItems.Add(10, "StreamNumber", "StreamNumber")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(nStreamNumber)
|
||||
Set objListItem = ctrlListView.ListItems.Add(11, "FPS", "FPS")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(dblDefaultFPS)
|
||||
Set objListItem = ctrlListView.ListItems.Add(12, "StretchMode", "StretchMode")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(nStretchMode)
|
||||
Set objListItem = ctrlListView.ListItems.Add(13, "Muted", "Muted")
|
||||
objListItem.SubItems(ctrlListView.ColumnHeaders("Value").SubItemIndex) = CStr(nMuted)
|
||||
|
||||
'clean-up & dereference
|
||||
If Not objListItem Is Nothing Then Set objListItem = Nothing
|
||||
If Not objTimelineSource Is Nothing Then Set objTimelineSource = Nothing
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
@@ -0,0 +1,197 @@
|
||||
Attribute VB_Name = "modGeneral"
|
||||
'*******************************************************************************
|
||||
'* This is a part of the Microsoft DXSDK 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.
|
||||
'* See these sources for detailed information regarding the
|
||||
'* Microsoft samples programs.
|
||||
'*******************************************************************************
|
||||
Option Explicit
|
||||
Option Base 0
|
||||
Option Compare Text
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- CONSTANTS
|
||||
' *
|
||||
' *
|
||||
Private Const MAX_PATH = 255
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- DATA STRUCTURES
|
||||
' *
|
||||
' *
|
||||
Private Type GUID
|
||||
Guid1 As Long
|
||||
Guid2 As Long
|
||||
Guid3 As Long
|
||||
Guid4(0 To 7) As Byte
|
||||
End Type
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- DECLARATIONS
|
||||
' *
|
||||
' *
|
||||
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
|
||||
Private Declare Function GetComputerNameW Lib "kernel32" (lpBuffer As Any, nSize As Long) As Long
|
||||
Private Declare Function CoCreateGuid Lib "OLE32.DLL" (pGUID As GUID) As Long
|
||||
Private Declare Function StringFromGUID2 Lib "OLE32.DLL" (pGUID As GUID, ByVal PointerToString As Long, ByVal MaxLength As Long) As Long
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PUBLIC INTERFACE- PROCEDURES
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Buffer_ParseEx
|
||||
' * procedure description: Parse's a fixed length string buffer of all vbNullCharacters AND vbNullStrings.
|
||||
' * Argument bstrBuffer evaluates to either an ANSII or Unicode BSTR string buffer.
|
||||
' * (bstrBuffer is almost always the output from a windows api call which needs parsed)
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Function Buffer_ParseEx(bstrBuffer As String) As String
|
||||
Dim iCount As Long, bstrChar As String, bstrReturn As String
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
For iCount = 1 To Len(bstrBuffer) 'set up a loop to remove the vbNullChar's from the buffer.
|
||||
bstrChar = Strings.Mid(bstrBuffer, iCount, 1)
|
||||
If bstrChar <> vbNullChar And bstrChar <> vbNullString Then bstrReturn = (bstrReturn + bstrChar)
|
||||
Next
|
||||
Buffer_ParseEx = bstrReturn
|
||||
Exit Function
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Function
|
||||
End Function
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: System_GetComputerName
|
||||
' * procedure description: Returns the name associated with the local system.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Function System_GetComputerName() As String
|
||||
Dim bstrBuffer As String * MAX_PATH, bstrReturn As String
|
||||
On Local Error GoTo ErrLine
|
||||
'obtain the computer name via the win32 api
|
||||
GetComputerName bstrBuffer, Len(bstrBuffer) + 1
|
||||
'assign the fixed length buffer to a variable length string
|
||||
bstrReturn = bstrBuffer
|
||||
'return the value to the client
|
||||
System_GetComputerName = Buffer_ParseEx(bstrReturn)
|
||||
Exit Function
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Function
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: ShowCommonDlgOpen
|
||||
' * procedure description:
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Function ShowCommonDlgOpen(Optional bstrCurrentDirectory As String, Optional bstrDefaultExtension As String, Optional bstrFilter As String) As String
|
||||
Dim ctrl As Object
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'instantiate control
|
||||
If Not CreateObject("MSComDlg.CommonDialog.1") Is Nothing Then
|
||||
Set ctrl = CreateObject("MSComDlg.CommonDialog.1")
|
||||
ElseIf Not CreateObject("MSComDlg.CommonDialog") Is Nothing Then
|
||||
Set ctrl = CreateObject("MSComDlg.CommonDialog")
|
||||
End If
|
||||
|
||||
If Not ctrl Is Nothing Then
|
||||
'set properties
|
||||
ctrl.Filter = bstrFilter
|
||||
ctrl.DefaultExt = bstrDefaultExtension
|
||||
ctrl.InitDir = bstrCurrentDirectory
|
||||
ctrl.ShowOpen
|
||||
'return to client
|
||||
ShowCommonDlgOpen = ctrl.FileName
|
||||
End If
|
||||
|
||||
'clean-up & dereference
|
||||
If Not ctrl Is Nothing Then Set ctrl = Nothing
|
||||
Exit Function
|
||||
|
||||
ErrLine:
|
||||
|
||||
Err.Clear
|
||||
Exit Function
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: ShowCommonDlgSave
|
||||
' * procedure description:
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Function ShowCommonDlgSave(Optional bstrCurrentDirectory As String, Optional bstrDefaultExtension As String, Optional bstrFilter As String) As String
|
||||
Dim ctrl As Object
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'instantiate control
|
||||
If Not CreateObject("MSComDlg.CommonDialog.1") Is Nothing Then
|
||||
Set ctrl = CreateObject("MSComDlg.CommonDialog.1")
|
||||
ElseIf Not CreateObject("MSComDlg.CommonDialog") Is Nothing Then
|
||||
Set ctrl = CreateObject("MSComDlg.CommonDialog")
|
||||
End If
|
||||
|
||||
If Not ctrl Is Nothing Then
|
||||
'set properties
|
||||
ctrl.Filter = bstrFilter
|
||||
ctrl.DefaultExt = bstrDefaultExtension
|
||||
ctrl.InitDir = bstrCurrentDirectory
|
||||
ctrl.ShowSave
|
||||
'return to client
|
||||
ShowCommonDlgSave = ctrl.FileName
|
||||
End If
|
||||
|
||||
'clean-up & dereference
|
||||
If Not ctrl Is Nothing Then Set ctrl = Nothing
|
||||
Exit Function
|
||||
|
||||
ErrLine:
|
||||
|
||||
Err.Clear
|
||||
Exit Function
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: GetGUID
|
||||
' * procedure description: returns a random global unique identifier
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Function GetGUID() As String
|
||||
Dim udtGUID As GUID, bstrGUID As String, nResultant As Long
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
nResultant = CoCreateGuid(udtGUID)
|
||||
If nResultant Then
|
||||
bstrGUID = vbNullString
|
||||
Else
|
||||
bstrGUID = String$(38, 0)
|
||||
StringFromGUID2 udtGUID, StrPtr(bstrGUID), 39
|
||||
End If
|
||||
GetGUID = bstrGUID
|
||||
Exit Function
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Function
|
||||
End Function
|
||||
@@ -0,0 +1,211 @@
|
||||
Attribute VB_Name = "modGlobalData"
|
||||
'*******************************************************************************
|
||||
'* This is a part of the Microsoft DXSDK 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.
|
||||
'* See these sources for detailed information regarding the
|
||||
'* Microsoft samples programs.
|
||||
'*******************************************************************************
|
||||
Option Explicit
|
||||
Option Base 0
|
||||
Option Compare Text
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * GLOBAL INTERFACE- DATA
|
||||
' *
|
||||
' *
|
||||
'global timeline reference in application
|
||||
Global gbl_bstrLoadFile As String 'the last file name/path opened by the user
|
||||
Global gbl_colNormalEnum As Collection 'collection for maintaining node/object relational data
|
||||
Global gbl_objQuartzVB As VBQuartzHelper 'helper object for rendering filtergraph's using quartz.dll
|
||||
Global gbl_objTimeline As AMTimeline 'global application timeline
|
||||
Global gbl_objRenderEngine As RenderEngine 'global application render engine
|
||||
Global gbl_objFilterGraph As FilgraphManager 'global application filtergraph manager
|
||||
Global gbl_objDexterObject As AMTimelineObj 'global application dexter object (current object in treeview)
|
||||
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PUBLIC INTERFACE- PROCEDURES
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Main
|
||||
' * procedure description: Application Entry Point
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Sub Main()
|
||||
Dim nStart As Long
|
||||
Dim nLength As Long
|
||||
Dim bstrFileName As String
|
||||
Dim boolDynamic As Boolean
|
||||
Dim boolPlayback As Boolean
|
||||
Dim boolSmartRecomp As Boolean
|
||||
Dim boolCloseOnComplete As Boolean
|
||||
Dim objLocalTimeline As AMTimeline
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
|
||||
'inhibit dupe instances of this application
|
||||
If App.PrevInstance = False Then
|
||||
'initalize global data
|
||||
Set gbl_objTimeline = New AMTimeline
|
||||
'display the main form for the application
|
||||
Load frmMain: frmMain.Move 0, 0: frmMain.Show: frmMain.Refresh
|
||||
Else: Exit Sub
|
||||
End If
|
||||
|
||||
|
||||
'handle command line
|
||||
If Command <> vbNullString Then
|
||||
'check the command line argument(s) for a valid xtl filename with double quotes
|
||||
If InStr(1, UCase(Command), Chr(34)) > 0 Then
|
||||
nStart = InStr(1, UCase(Command), Chr(34))
|
||||
nLength = InStr(nStart + 1, Command, Chr(34))
|
||||
If nLength - nStart > Len(Command) Then
|
||||
bstrFileName = Mid(Command, nStart, nLength)
|
||||
End If
|
||||
bstrFileName = Trim(LCase(Command))
|
||||
bstrFileName = Replace(bstrFileName, "/r", vbNullString)
|
||||
bstrFileName = Replace(bstrFileName, "/d", vbNullString)
|
||||
bstrFileName = Replace(bstrFileName, Chr(34), vbNullString)
|
||||
bstrFileName = Trim(bstrFileName)
|
||||
If InStr(1, bstrFileName, ".xtl") > 0 Then
|
||||
If InStr(1, bstrFileName, ".xtl") + 4 <> Len(bstrFileName) Then
|
||||
bstrFileName = Left(bstrFileName, InStr(1, bstrFileName, ".xtl") + 4)
|
||||
End If
|
||||
End If
|
||||
'check the command line argument(s) for a valid xtl filename with single quotes
|
||||
ElseIf InStr(1, UCase(Command), Chr(39)) > 0 Then
|
||||
nStart = InStr(1, UCase(Command), Chr(39))
|
||||
nLength = InStr(nStart + 1, Command, Chr(39))
|
||||
If nLength - nStart > Len(Command) Then
|
||||
bstrFileName = Mid(Command, nStart, nLength)
|
||||
End If
|
||||
bstrFileName = Trim(LCase(Command))
|
||||
bstrFileName = Replace(bstrFileName, "/r", vbNullString)
|
||||
bstrFileName = Replace(bstrFileName, "/d", vbNullString)
|
||||
bstrFileName = Replace(bstrFileName, Chr(39), vbNullString)
|
||||
bstrFileName = Trim(bstrFileName)
|
||||
If InStr(1, bstrFileName, ".xtl") > 0 Then
|
||||
If InStr(1, bstrFileName, ".xtl") + 4 <> Len(bstrFileName) Then
|
||||
bstrFileName = Left(bstrFileName, InStr(1, bstrFileName, ".xtl") + 4)
|
||||
End If
|
||||
End If
|
||||
'check the command line argument(s) for a valid xtl filename with no quotes
|
||||
Else
|
||||
bstrFileName = Trim(LCase(Command))
|
||||
bstrFileName = Replace(bstrFileName, "/r", vbNullString)
|
||||
bstrFileName = Replace(bstrFileName, "/d", vbNullString)
|
||||
bstrFileName = Trim(bstrFileName)
|
||||
If InStr(1, bstrFileName, ".xtl") > 0 Then
|
||||
If InStr(1, bstrFileName, ".xtl") + 4 <> Len(bstrFileName) Then
|
||||
bstrFileName = Left(bstrFileName, InStr(1, bstrFileName, ".xtl") + 4)
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
|
||||
'check the command line argument(s) for smart recomp optional
|
||||
If InStr(1, UCase(Command), Space(1) & "/R") > 0 Then
|
||||
boolSmartRecomp = True
|
||||
End If
|
||||
|
||||
'check the command line argument(s) for dynamic connections optional
|
||||
If InStr(1, UCase(Command), Space(1) & "/D") > 0 Then
|
||||
boolDynamic = True
|
||||
End If
|
||||
|
||||
'check the command line argument(s) for playback optional
|
||||
If InStr(1, UCase(Command), Space(1) & "/P") > 0 Then
|
||||
boolPlayback = True
|
||||
End If
|
||||
|
||||
'check the command line argument(s) for close when finished optional
|
||||
If InStr(1, UCase(Command), Space(1) & "/C") > 0 Then
|
||||
boolCloseOnComplete = True
|
||||
End If
|
||||
End If
|
||||
|
||||
|
||||
|
||||
'proceed to load the xtl file into the application ide and render it
|
||||
If InStr(1, LCase(bstrFileName), ".xtl") > 0 Then
|
||||
'at least it's been named an xtl file, proceed to attempt an import..
|
||||
Set objLocalTimeline = New AMTimeline
|
||||
Call RestoreTimeline(objLocalTimeline, bstrFileName, DEXImportXTL)
|
||||
'verify restoration
|
||||
If Not objLocalTimeline Is Nothing Then
|
||||
'import succeeded; clean-up global scope
|
||||
If Not gbl_objTimeline Is Nothing Then
|
||||
Call ClearTimeline(gbl_objTimeline)
|
||||
Set gbl_objTimeline = Nothing
|
||||
End If
|
||||
'assign the local timeline to global scope
|
||||
Set gbl_objTimeline = objLocalTimeline
|
||||
'reset application-level filename
|
||||
gbl_bstrLoadFile = bstrFileName
|
||||
'reset the caption on the application's main form
|
||||
bstrFileName = Mid(bstrFileName, InStrRev(bstrFileName, "\") + 1)
|
||||
frmMain.Caption = "DexterVB - " & bstrFileName
|
||||
Else: Exit Sub
|
||||
End If
|
||||
End If
|
||||
|
||||
|
||||
'render the timeline and derive a filter graph manager
|
||||
Set gbl_objFilterGraph = RenderTimeline(gbl_objTimeline, boolDynamic, boolSmartRecomp)
|
||||
Set gbl_objQuartzVB.FilterGraph = gbl_objFilterGraph
|
||||
'map the timeline to the userinterface
|
||||
Call GetTimelineDirect(frmMain.tvwSimpleTree, gbl_objTimeline, gbl_colNormalEnum)
|
||||
frmMain.mnuTimeLineClearRenderEngine.Enabled = False
|
||||
'update the button(s)
|
||||
With frmMain.tbMain.Buttons
|
||||
.Item("Play").Image = 6
|
||||
.Item("Pause").Image = 7
|
||||
.Item("Stop").Image = 22
|
||||
.Item("Rewind").Image = 18
|
||||
.Item("FastForward").Image = 24
|
||||
.Item("SeekForward").Image = 23
|
||||
.Item("SeekBackward").Image = 19
|
||||
.Item("Play").Enabled = True
|
||||
.Item("Pause").Enabled = True
|
||||
.Item("Stop").Enabled = False
|
||||
.Item("Rewind").Enabled = False
|
||||
.Item("FastForward").Enabled = False
|
||||
.Item("SeekForward").Enabled = False
|
||||
.Item("SeekBackward").Enabled = False
|
||||
End With
|
||||
'update the state on the popup context menu
|
||||
frmMain.mnuTimeLinePlay.Enabled = True
|
||||
frmMain.mnuTimeLineStop.Enabled = False
|
||||
frmMain.mnuTimeLinePause.Enabled = True
|
||||
frmMain.mnuTimeLineRenderTimeLine.Enabled = False
|
||||
frmMain.mnuTimeLineClearRenderEngine.Enabled = False
|
||||
|
||||
If boolPlayback Then
|
||||
'run the graph
|
||||
Call gbl_objFilterGraph.Run
|
||||
|
||||
'if optional close on complete, unload when the timeline is finished rendering..
|
||||
If boolCloseOnComplete = True Then
|
||||
Do Until gbl_objQuartzVB.Position = gbl_objQuartzVB.StopTime: DoEvents: DoEvents
|
||||
If frmMain.Visible = False Then
|
||||
Exit Do
|
||||
End If
|
||||
Loop
|
||||
Unload frmMain: Set frmMain = Nothing: Exit Sub
|
||||
End If
|
||||
End If
|
||||
|
||||
'clean-up & dereference
|
||||
If Not objLocalTimeline Is Nothing Then Set objLocalTimeline = Nothing
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
@@ -0,0 +1,622 @@
|
||||
Attribute VB_Name = "modRegistry"
|
||||
'*******************************************************************************
|
||||
'* This is a part of the Microsoft DXSDK 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.
|
||||
'* See these sources for detailed information regarding the
|
||||
'* Microsoft samples programs.
|
||||
'*******************************************************************************
|
||||
Option Explicit
|
||||
Option Base 0
|
||||
Option Compare Text
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- DATA STRUCTURES
|
||||
' *
|
||||
' *
|
||||
Private Type ACL
|
||||
AclRevision As Byte
|
||||
Sbz1 As Byte
|
||||
AclSize As Integer
|
||||
AceCount As Integer
|
||||
Sbz2 As Integer
|
||||
End Type
|
||||
|
||||
Private Type FILETIME
|
||||
dwLowDateTime As Long
|
||||
dwHighDateTime As Long
|
||||
End Type
|
||||
|
||||
Private Type SECURITY_ATTRIBUTES
|
||||
nLength As Long
|
||||
lpSecurityDescriptor As Long
|
||||
bInheritHandle As Long
|
||||
End Type
|
||||
|
||||
Private Type SECURITY_DESCRIPTOR
|
||||
Revision As Byte
|
||||
Sbz1 As Byte
|
||||
Control As Long
|
||||
Owner As Long
|
||||
Group As Long
|
||||
Sacl As ACL
|
||||
Dacl As ACL
|
||||
End Type
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- PREDEFINED CONSTANTS
|
||||
' *
|
||||
' *
|
||||
Private Const MAX_PATH = 255
|
||||
Private Const ERROR_SUCCESS = 0
|
||||
|
||||
Private Const KEY_ALL_ACCESS = &H1F0000 '((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
|
||||
Private Const KEY_CREATE_LINK = &H20
|
||||
Private Const KEY_CREATE_SUB_KEY = &H4
|
||||
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
|
||||
Private Const KEY_EVENT = &H1 ''"" Event contains key event record
|
||||
Private Const KEY_EXECUTE = &H1 '((KEY_READ) And (Not SYNCHRONIZE))
|
||||
Private Const KEY_FULL_MATCH_SEARCH = &H1
|
||||
Private Const KEY_LENGTH_MASK = &HFFFF0000
|
||||
Private Const KEY_NOTIFY = &H10
|
||||
Private Const KEY_PARTIAL_MATCH_SEARCH = &H2
|
||||
Private Const KEY_QUERY_VALUE = &H1
|
||||
Private Const KEY_READ = KEY_QUERY_VALUE '((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
|
||||
Private Const KEY_SET_VALUE = &H2
|
||||
Private Const KEY_WRITE = KEY_SET_VALUE '((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
|
||||
|
||||
Private Const REG_CREATED_NEW_KEY = &H1
|
||||
Private Const REG_FULL_RESOURCE_DESCRIPTOR = 9
|
||||
Private Const REG_LEGAL_CHANGE_FILTER = &H2 ' (REG_NOTIFY_CHANGE_NAME Or REG_NOTIFY_CHANGE_ATTRIBUTES Or REG_NOTIFY_CHANGE_LAST_SET Or REG_NOTIFY_CHANGE_SECURITY)
|
||||
Private Const REG_LEGAL_OPTION = 0 '(REG_OPTION_RESERVED Or REG_OPTION_NON_VOLATILE Or REG_OPTION_VOLATILE Or REG_OPTION_CREATE_LINK Or REG_OPTION_BACKUP_RESTORE)
|
||||
Private Const REG_NOTIFY_CHANGE_ATTRIBUTES = &H2
|
||||
Private Const REG_NOTIFY_CHANGE_LAST_SET = &H4
|
||||
Private Const REG_NOTIFY_CHANGE_NAME = &H1
|
||||
Private Const REG_NOTIFY_CHANGE_SECURITY = &H8
|
||||
Private Const REG_OPENED_EXISTING_KEY = &H2
|
||||
Private Const REG_OPTION_BACKUP_RESTORE = 4
|
||||
Private Const REG_OPTION_CREATE_LINK = 2
|
||||
Private Const REG_OPTION_NON_VOLATILE = 0
|
||||
Private Const REG_OPTION_RESERVED = 0
|
||||
Private Const REG_OPTION_VOLATILE = 1
|
||||
Private Const REG_REFRESH_HIVE = &H2
|
||||
Private Const REG_RESOURCE_REQUIREMENTS_LIST = 10
|
||||
Private Const REG_WHOLE_HIVE_VOLATILE = &H1
|
||||
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- WIN32 API DECLARATIONS
|
||||
' *
|
||||
' *
|
||||
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
|
||||
Private Declare Function RegConnectRegistry Lib "advapi32.dll" Alias "RegConnectRegistryA" (ByVal lpMachineName As String, ByVal hKey As Long, phkResult As Long) As Long
|
||||
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
|
||||
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long
|
||||
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
|
||||
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
|
||||
Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
|
||||
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
|
||||
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
|
||||
Private Declare Function RegFlushKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
|
||||
Private Declare Function RegGetKeySecurity Lib "advapi32.dll" (ByVal hKey As Long, ByVal SecurityInformation As Long, pSecurityDescriptor As SECURITY_DESCRIPTOR, lpcbSecurityDescriptor As Long) As Long
|
||||
Private Declare Function RegLoadKey Lib "advapi32.dll" Alias "RegLoadKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpFile As String) As Long
|
||||
Private Declare Function RegNotifyChangeKeyValue Lib "advapi32.dll" (ByVal hKey As Long, ByVal bWatchSubtree As Long, ByVal dwNotifyFilter As Long, ByVal hEvent As Long, ByVal fAsynchronus As Long) As Long
|
||||
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
|
||||
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
|
||||
Private Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hKey As Long, ByVal lpClass As String, lpcbClass As Long, ByVal lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, lpftLastWriteTime As FILETIME) As Long
|
||||
Private Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long
|
||||
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
|
||||
Private Declare Function RegReplaceKey Lib "advapi32.dll" Alias "RegReplaceKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpNewFile As String, ByVal lpOldFile As String) As Long
|
||||
Private Declare Function RegRestoreKey Lib "advapi32.dll" Alias "RegRestoreKeyA" (ByVal hKey As Long, ByVal lpFile As String, ByVal dwFlags As Long) As Long
|
||||
Private Declare Function RegSaveKey Lib "advapi32.dll" Alias "RegSaveKeyA" (ByVal hKey As Long, ByVal lpFile As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
|
||||
Private Declare Function RegSetKeySecurity Lib "advapi32.dll" (ByVal hKey As Long, ByVal SecurityInformation As Long, pSecurityDescriptor As SECURITY_DESCRIPTOR) As Long
|
||||
Private Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
|
||||
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
|
||||
Private Declare Function RegUnLoadKey Lib "advapi32.dll" Alias "RegUnLoadKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
|
||||
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PUBLIC INTERFACE- ENUMERATIONS
|
||||
' *
|
||||
' *
|
||||
Public Enum hKey
|
||||
HKEY_CLASSES_ROOT = &H80000000
|
||||
HKEY_CURRENT_CONFIG = &H80000005
|
||||
HKEY_CURRENT_USER = &H80000001
|
||||
HKEY_DYN_DATA = &H80000006
|
||||
HKEY_LOCAL_MACHINE = &H80000002
|
||||
HKEY_PERFORMANCE_DATA = &H80000004
|
||||
HKEY_USERS = &H80000003
|
||||
End Enum
|
||||
|
||||
|
||||
Public Enum EntryFormat
|
||||
REG_BINARY = 0 'Binary data in any form.
|
||||
REG_DWORD = 1 'A 32-bit number.
|
||||
REG_DWORD_LITTLE_ENDIAN = 2 'A 32-bit number in little-endian format. This is equivalent to REG_DWORD.
|
||||
REG_DWORD_BIG_ENDIAN = 3 'A 32-bit number in big-endian format.
|
||||
REG_EXPAND_SZ = 4 'A null-terminated string that contains unexpanded references to environment variables
|
||||
REG_LINK = 5 'A Unicode symbolic link.
|
||||
REG_MULTI_SZ = 6 'An array of null-terminated strings, terminated by two null characters.
|
||||
REG_NONE = 7 'No defined value type.
|
||||
REG_RESOURCE_LIST = 8 'A device-driver resource list.
|
||||
REG_SZ = 9 'A null-terminated string. It will be a Unicode or ANSI string depending on whether you use Unicode or ANSI.
|
||||
End Enum
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PUBLIC INTERFACE- PROCEDURES
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Registry_CreateKey
|
||||
' * procedure description: Create's a new key in the window's system registry.
|
||||
' * Returns the registry error code on failure, the new handle on success
|
||||
' ******************************************************************************************************************************
|
||||
Public Function Registry_CreateKey(MainKey As hKey, SubKey As String) As Long
|
||||
Dim nRet As Long, nDisposition As Long, nKey As Long
|
||||
Dim sSubKey As String, nSubStart As Integer, SecAttr As SECURITY_ATTRIBUTES
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'check to ensure subkey is valid
|
||||
If Len(SubKey) = 0 Then Exit Function
|
||||
|
||||
'check to ensure the mainkey is valid
|
||||
If CLng(MainKey) = 0 Then Exit Function
|
||||
|
||||
'convert to upper case
|
||||
SubKey = UCase(SubKey)
|
||||
|
||||
'check for backslash
|
||||
If Left(SubKey, 1) = "\" Then SubKey = Mid(SubKey, 2, Len(SubKey))
|
||||
|
||||
'Create a new Key
|
||||
nRet = RegCreateKeyEx(CLng(MainKey), SubKey, 0, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, SecAttr, nKey, nDisposition)
|
||||
|
||||
If nKey <> 0 Then 'the key was created successfully; return the handle.
|
||||
RegCloseKey (nKey)
|
||||
Registry_CreateKey = nRet
|
||||
Else 'an error occured, return zero and exit.
|
||||
Registry_CreateKey = 0
|
||||
Exit Function
|
||||
End If
|
||||
Exit Function
|
||||
|
||||
ErrLine:
|
||||
|
||||
Err.Clear
|
||||
If nKey <> 0 Then RegCloseKey (nKey) 'the key is open close it and exit
|
||||
Exit Function
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Registry_DeleteKey
|
||||
' * procedure description: deletes an existing key in the window's system registry.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Function Registry_DeleteKey(MainKey As hKey, SubKey As String) As Long
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'check to ensure subkey is valid
|
||||
If Len(SubKey) = 0 Then Exit Function
|
||||
|
||||
'check to ensure the mainkey is valid
|
||||
If CLng(MainKey) = 0 Then Exit Function
|
||||
|
||||
'convert to upper case
|
||||
SubKey = UCase(SubKey)
|
||||
|
||||
'check for backslash
|
||||
If Left(SubKey, 1) = "\" Then SubKey = Mid(SubKey, 2, Len(SubKey))
|
||||
|
||||
'delete the key from the registry; if WinNT this will fail if the key has subkeys
|
||||
Registry_DeleteKey = RegDeleteKey(CLng(MainKey), SubKey)
|
||||
'exit
|
||||
Exit Function
|
||||
|
||||
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Function
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Registry_DoesKeyExist
|
||||
' * procedure description: Checks to ensure a key does in fact exist
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Function Registry_DoesKeyExist(MainKey As hKey, SubKey As String) As Boolean
|
||||
Dim nSubHandle As Long
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'check to ensure subkey is valid
|
||||
If Len(SubKey) = 0 Then Exit Function
|
||||
|
||||
'check to ensure the mainkey is valid
|
||||
If CLng(MainKey) = 0 Then Exit Function
|
||||
|
||||
'convert to upper case
|
||||
SubKey = UCase(SubKey)
|
||||
|
||||
'check for backslash
|
||||
If Left(SubKey, 1) = "\" Then SubKey = Mid(SubKey, 2, Len(SubKey))
|
||||
|
||||
|
||||
'open the key for read access
|
||||
RegOpenKeyEx CLng(MainKey), SubKey, 0, KEY_READ, nSubHandle
|
||||
|
||||
'return and exit
|
||||
If nSubHandle <> 0 Then
|
||||
Registry_DoesKeyExist = True
|
||||
RegCloseKey (nSubHandle)
|
||||
Else: Registry_DoesKeyExist = False
|
||||
End If
|
||||
Exit Function
|
||||
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Function
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Registry_CreateEntry
|
||||
' * procedure description: Creates an entry for the user
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Function Registry_CreateEntry(MainKey As hKey, SubKey As String, strEntry As String, Optional strEntryValue As String = vbNullString, Optional Format As EntryFormat = REG_SZ) As Long
|
||||
Dim nSubHandle As Long, nRet As Long, strBuffer As String
|
||||
On Local Error GoTo ErrLine
|
||||
'check to ensure subkey is valid
|
||||
If Len(SubKey) = 0 Then Exit Function
|
||||
|
||||
'check to ensure the mainkey is valid
|
||||
If CLng(MainKey) = 0 Then Exit Function
|
||||
|
||||
'check to ensure the entry's string data is null-terminated
|
||||
If Right(strEntryValue, 1) <> vbNullChar Then strEntryValue = (strEntryValue & vbNullChar)
|
||||
|
||||
'form a buffer for the entry's string data to be passed the the api
|
||||
strBuffer = String(Len(strEntryValue), 0)
|
||||
strBuffer = strEntryValue
|
||||
|
||||
'convert to upper case
|
||||
SubKey = UCase(SubKey)
|
||||
|
||||
'check for backslash
|
||||
If Left(SubKey, 1) = "\" Then SubKey = Mid(SubKey, 2, Len(SubKey))
|
||||
|
||||
'open the key with update value access; this should be all that is required to append an entry..
|
||||
nRet = RegOpenKeyEx(CLng(MainKey), SubKey, 0, KEY_SET_VALUE, nSubHandle)
|
||||
|
||||
'check api return for success before continueing
|
||||
If nRet <> ERROR_SUCCESS Or nSubHandle = 0 Then Exit Function
|
||||
|
||||
'set the new entry value to the key
|
||||
Registry_CreateEntry = RegSetValueEx(nSubHandle, strEntry, 0, CLng(Format), ByVal strBuffer, Len(strBuffer) + 1)
|
||||
|
||||
'close the key handle
|
||||
RegCloseKey (nSubHandle)
|
||||
|
||||
'exit
|
||||
Exit Function
|
||||
|
||||
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Function
|
||||
End Function
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Registry_DeleteEntry
|
||||
' * procedure description: Delete's an entry in a registry subkey
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Function Registry_DeleteEntry(MainKey As hKey, SubKey As String, strEntry As String) As Long
|
||||
Dim nSubHandle, nRet As Long
|
||||
On Local Error GoTo ErrLine
|
||||
'check to ensure subkey is valid
|
||||
If Len(SubKey) = 0 Then Exit Function
|
||||
|
||||
'check to ensure the mainkey is valid
|
||||
If CLng(MainKey) = 0 Then Exit Function
|
||||
|
||||
'check to ensure the entryname is valid
|
||||
If strEntry = vbNullString Then Exit Function
|
||||
'check that it is null terminated
|
||||
If Right(strEntry, 1) <> vbNullChar Then strEntry = (strEntry & vbNullChar)
|
||||
|
||||
'convert to upper case
|
||||
SubKey = UCase(SubKey)
|
||||
|
||||
'check for backslash
|
||||
If Left(SubKey, 1) = "\" Then SubKey = Mid(SubKey, 2, Len(SubKey))
|
||||
|
||||
'open the key with local write access; this should be all that is required to append an entry..
|
||||
nRet = RegOpenKeyEx(CLng(MainKey), SubKey, 0, KEY_WRITE, nSubHandle)
|
||||
|
||||
'check api return before continueing
|
||||
If nRet <> ERROR_SUCCESS Or nSubHandle = 0 Then Exit Function
|
||||
|
||||
'attempt to delete the entry and return the result
|
||||
Registry_DeleteEntry = RegDeleteValue(nSubHandle, strEntry)
|
||||
|
||||
'close the open key handle and exit
|
||||
RegCloseKey (nSubHandle)
|
||||
Exit Function
|
||||
|
||||
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Function
|
||||
End Function
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Registry_UpdateEntry
|
||||
' * procedure description: Updates the value of an entry within a subkey; this function will create it if it does not exist.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Function Registry_UpdateEntry(MainKey As hKey, SubKey As String, strEntry As String, strEntryValue As String, Optional Format As EntryFormat = REG_SZ) As Long
|
||||
Dim nSubHandle As Long, nRet As Long, strBuffer As String
|
||||
On Local Error GoTo ErrLine
|
||||
'check to ensure subkey is valid
|
||||
If Len(SubKey) = 0 Then Exit Function
|
||||
|
||||
'check to ensure the mainkey is valid
|
||||
If CLng(MainKey) = 0 Then Exit Function
|
||||
|
||||
'check to ensure the entry's string data is null-terminated
|
||||
If Right(strEntryValue, 1) <> vbNullChar Then strEntryValue = (strEntryValue & vbNullChar)
|
||||
|
||||
'form a buffer for the entry's string data to be passed the the api
|
||||
strBuffer = String(Len(strEntryValue), 0)
|
||||
strBuffer = strEntryValue
|
||||
|
||||
'convert to upper case
|
||||
SubKey = UCase(SubKey)
|
||||
|
||||
'check for backslash
|
||||
If Left(SubKey, 1) = "\" Then SubKey = Mid(SubKey, 2, Len(SubKey))
|
||||
|
||||
'open the key with update value access; this should be all that is required to append an entry..
|
||||
nRet = RegOpenKeyEx(CLng(MainKey), SubKey, 0, KEY_SET_VALUE, nSubHandle)
|
||||
|
||||
'check api return for success before continueing
|
||||
If nRet <> ERROR_SUCCESS Or nSubHandle = 0 Then Exit Function
|
||||
|
||||
'set the new entry value to the key
|
||||
Registry_UpdateEntry = RegSetValueEx(nSubHandle, strEntry, 0, CLng(Format), ByVal strBuffer, Len(strBuffer) + 1)
|
||||
|
||||
'close the key handle
|
||||
RegCloseKey (nSubHandle)
|
||||
|
||||
'exit
|
||||
Exit Function
|
||||
|
||||
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Function
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Registry_QueryEntryValue
|
||||
' * procedure description: Returns the value of an entry; on error returns default
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Function Registry_QueryEntryValue(MainKey As hKey, SubKey As String, strEntry As String, Optional Default As String = vbNullString) As String
|
||||
Dim nSubHandle As Long, nFileTime As FILETIME
|
||||
Dim nRet As Long, strBuffer As String, nMaxValueLen As Long
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'check to ensure subkey is valid
|
||||
If Len(SubKey) = 0 Then Exit Function
|
||||
|
||||
'check to ensure the mainkey is valid
|
||||
If CLng(MainKey) = 0 Then Exit Function
|
||||
|
||||
'Check to ensure the entry is valid
|
||||
If strEntry = vbNullString Then Exit Function
|
||||
|
||||
'convert to upper case
|
||||
SubKey = UCase(SubKey)
|
||||
|
||||
'check for backslash
|
||||
If Left(SubKey, 1) = "\" Then SubKey = Mid(SubKey, 2, Len(SubKey))
|
||||
|
||||
'open the key and get a handle
|
||||
nRet = RegOpenKeyEx(CLng(MainKey), SubKey, 0, KEY_READ, nSubHandle)
|
||||
|
||||
'check the api return
|
||||
If nRet <> ERROR_SUCCESS Or nSubHandle = 0 Then Exit Function
|
||||
|
||||
'get the length of the largest given entry in the subkey so that we may be able to form a properly sized buffer
|
||||
nRet = RegQueryInfoKey(nSubHandle, vbNullString, 0, 0, 0, 0, 0, 0, 0, nMaxValueLen, 0, nFileTime)
|
||||
|
||||
'set up a properly sized buffer given the known largest entry value size; set to MAX_PATH in case of last api failure
|
||||
If nMaxValueLen < 255 Then nMaxValueLen = 255
|
||||
strBuffer = String(nMaxValueLen, 0)
|
||||
|
||||
'query the key for an entry value
|
||||
nMaxValueLen = Len(strBuffer) + 1
|
||||
nRet = RegQueryValueEx(nSubHandle, strEntry, 0, 0, ByVal strBuffer, nMaxValueLen)
|
||||
If nRet = ERROR_SUCCESS Then
|
||||
strBuffer = Left(strBuffer, nMaxValueLen)
|
||||
Registry_QueryEntryValue = strBuffer
|
||||
Else: Registry_QueryEntryValue = Default
|
||||
End If
|
||||
|
||||
'close the handle, return the value and exit
|
||||
RegCloseKey (nSubHandle)
|
||||
Exit Function
|
||||
|
||||
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Function
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Registry_QueryEntryType
|
||||
' * procedure description: Returns the type of data an entry contains.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Function Registry_QueryEntryType(MainKey As hKey, SubKey As String, strEntry As String) As EntryFormat
|
||||
Dim nType As Long, nSubHandle As Long, nRet As Long
|
||||
On Local Error GoTo ErrLine
|
||||
'check to ensure subkey is valid
|
||||
If Len(SubKey) = 0 Then Exit Function
|
||||
|
||||
'check to ensure the mainkey is valid
|
||||
If CLng(MainKey) = 0 Then Exit Function
|
||||
|
||||
'Check to ensure the entry is valid
|
||||
If strEntry = vbNullString Then Exit Function
|
||||
|
||||
'convert to upper case
|
||||
SubKey = UCase(SubKey)
|
||||
|
||||
'check for backslash
|
||||
If Left(SubKey, 1) = "\" Then SubKey = Mid(SubKey, 2, Len(SubKey))
|
||||
|
||||
'open the key for read access
|
||||
nRet = RegOpenKeyEx(CLng(MainKey), SubKey, 0, KEY_READ, nSubHandle)
|
||||
|
||||
'check return on api call
|
||||
If nRet <> ERROR_SUCCESS Or nSubHandle = 0 Then Exit Function
|
||||
|
||||
'query the entry in the key for any given type information
|
||||
nRet = RegQueryValueEx(nSubHandle, ByVal strEntry, 0, nType, 0, 0)
|
||||
|
||||
Select Case nType
|
||||
Case 0: Registry_QueryEntryType = REG_BINARY
|
||||
Case 1: Registry_QueryEntryType = REG_DWORD
|
||||
Case 2: Registry_QueryEntryType = REG_DWORD_BIG_ENDIAN
|
||||
Case 3: Registry_QueryEntryType = REG_DWORD_LITTLE_ENDIAN
|
||||
Case 4: Registry_QueryEntryType = REG_EXPAND_SZ
|
||||
Case 5: Registry_QueryEntryType = REG_LINK
|
||||
Case 6: Registry_QueryEntryType = REG_MULTI_SZ
|
||||
Case 7: Registry_QueryEntryType = REG_NONE
|
||||
Case 8: Registry_QueryEntryType = REG_RESOURCE_LIST
|
||||
Case 9: Registry_QueryEntryType = REG_SZ
|
||||
End Select
|
||||
|
||||
'exit
|
||||
Exit Function
|
||||
|
||||
ErrLine:
|
||||
|
||||
Err.Clear
|
||||
Exit Function
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Registry_DoesEntryExist
|
||||
' * procedure description: Checks to ensure an entry does in fact exist
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Function Registry_DoesEntryExist(MainKey As hKey, SubKey As String, strEntry As String) As Boolean
|
||||
Dim nType As Long, nSubHandle As Long, nRet As Long
|
||||
On Local Error GoTo ErrLine
|
||||
'check to ensure subkey is valid
|
||||
If Len(SubKey) = 0 Then Exit Function
|
||||
|
||||
'check to ensure the mainkey is valid
|
||||
If CLng(MainKey) = 0 Then Exit Function
|
||||
|
||||
'Check to ensure the entry is valid
|
||||
If strEntry = vbNullString Then Exit Function
|
||||
|
||||
'convert to upper case
|
||||
SubKey = UCase(SubKey)
|
||||
|
||||
'check for backslash
|
||||
If Left(SubKey, 1) = "\" Then SubKey = Mid(SubKey, 2, Len(SubKey))
|
||||
|
||||
'open the key for read access
|
||||
nRet = RegOpenKeyEx(CLng(MainKey), SubKey, 0, KEY_READ, nSubHandle)
|
||||
|
||||
'check return on api call
|
||||
If nRet <> ERROR_SUCCESS Or nSubHandle = 0 Then Exit Function
|
||||
|
||||
'query the entry in the key for any given type information
|
||||
nRet = RegQueryValueEx(nSubHandle, ByVal strEntry, 0, nType, 0, 0)
|
||||
|
||||
'verify api return
|
||||
If nRet > 0 Then
|
||||
Registry_DoesEntryExist = True
|
||||
Else
|
||||
Registry_DoesEntryExist = False
|
||||
End If
|
||||
|
||||
'exit
|
||||
Exit Function
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Function
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- PROCEDURES
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Reg_KeyToStr
|
||||
' * procedure description: Returns a string denoteing the current key handle; this can be used later
|
||||
' * if you decide to extend remote registry access functionality into this module.
|
||||
' ******************************************************************************************************************************
|
||||
Private Function Reg_KeyToStr(nKey As Long) As String
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
Select Case nKey
|
||||
Case HKEY_CLASSES_ROOT: Reg_KeyToStr = "HKEY_CLASSES_ROOT"
|
||||
Case HKEY_CURRENT_CONFIG: Reg_KeyToStr = "HKEY_CURRENT_CONFIG"
|
||||
Case HKEY_CURRENT_USER: Reg_KeyToStr = "HKEY_CURRENT_USER"
|
||||
Case HKEY_LOCAL_MACHINE: Reg_KeyToStr = "HKEY_LOCAL_MACHINE"
|
||||
Case HKEY_USERS: Reg_KeyToStr = "HKEY_USERS"
|
||||
Case HKEY_DYN_DATA: Reg_KeyToStr = "HKEY_DYN_DATA"
|
||||
Case HKEY_PERFORMANCE_DATA: Reg_KeyToStr = "HKEY_PERFORMANCE_DATA"
|
||||
Case Else: Reg_KeyToStr = vbNullString
|
||||
End Select
|
||||
Exit Function
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Function
|
||||
End Function
|
||||
@@ -0,0 +1,14 @@
|
||||
DirectShow Sample -- DexterVB
|
||||
-----------------------------
|
||||
|
||||
Video editing application for Microsoft Visual Basic.
|
||||
|
||||
This sample application is a graphical tool for creating Microsoft DirectShow
|
||||
Editing Services timelines. It demonstrates the following tasks:
|
||||
|
||||
- Loading and saving XTL project files
|
||||
- Adding, editing, and deleting timeline objects
|
||||
- Previewing a timeline
|
||||
|
||||
For more information about this sample, see "DirectShow Samples" in the
|
||||
DirectX 8 SDK documentation.
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 726 B |
Binary file not shown.
|
After Width: | Height: | Size: 726 B |
Binary file not shown.
|
After Width: | Height: | Size: 726 B |
Binary file not shown.
|
After Width: | Height: | Size: 726 B |
Binary file not shown.
|
After Width: | Height: | Size: 726 B |
Binary file not shown.
|
After Width: | Height: | Size: 726 B |
Binary file not shown.
|
After Width: | Height: | Size: 726 B |
Binary file not shown.
|
After Width: | Height: | Size: 726 B |
Binary file not shown.
|
After Width: | Height: | Size: 726 B |
Binary file not shown.
|
After Width: | Height: | Size: 726 B |
Binary file not shown.
|
After Width: | Height: | Size: 726 B |
Binary file not shown.
|
After Width: | Height: | Size: 726 B |
Binary file not shown.
|
After Width: | Height: | Size: 726 B |
Binary file not shown.
|
After Width: | Height: | Size: 726 B |
Binary file not shown.
|
After Width: | Height: | Size: 726 B |
Binary file not shown.
|
After Width: | Height: | Size: 726 B |
Binary file not shown.
|
After Width: | Height: | Size: 726 B |
Binary file not shown.
|
After Width: | Height: | Size: 726 B |
Binary file not shown.
|
After Width: | Height: | Size: 726 B |
Binary file not shown.
|
After Width: | Height: | Size: 726 B |
Binary file not shown.
|
After Width: | Height: | Size: 726 B |
Binary file not shown.
|
After Width: | Height: | Size: 774 B |
Binary file not shown.
|
After Width: | Height: | Size: 774 B |
Binary file not shown.
|
After Width: | Height: | Size: 774 B |
@@ -0,0 +1,43 @@
|
||||
Dexter (DirectShow Editing Services) VB Sample Application
|
||||
|
||||
Source: (SDK root)\Samples\Multimedia\VBSamples\DirectShow\Editing\DexterVB
|
||||
|
||||
The Dexter VB Sample application is a GUI-based tool used to create a multimedia timeline and to load, edit, and save the timeline to an .XTL file. This sample application demonstrates the following tasks related to timeline functions in Visual Basic:
|
||||
|
||||
* Loading and saving .XTL files through the Dexter libraries
|
||||
* Adding, editing, and deleting items from the timeline through the Dexter libraries
|
||||
* Support for rendering audio and video playback to an ActiveMovie window through the Dexter libraries
|
||||
|
||||
The user interface is divided into the following parts.
|
||||
|
||||
1. Pull Down Menus
|
||||
a. Creating New Timelines.
|
||||
b. Opening Existing Timelines
|
||||
c. Saving Timelines
|
||||
d. Exiting the Application
|
||||
2. Button Bar
|
||||
3. Tree View
|
||||
4. Explorer View
|
||||
|
||||
The button bar is divided into the following sections, from left to right.
|
||||
|
||||
New
|
||||
Open
|
||||
Save
|
||||
Seek To Beginning of timeline
|
||||
Seek Backward 1 second
|
||||
Play Timeline
|
||||
Pause Playback
|
||||
Stop Playback
|
||||
Seek Forward 1 second
|
||||
Seek to End of timeline
|
||||
|
||||
|
||||
Once the timeline is loaded, the timeline will appear in the left pane of the application in the tree view.
|
||||
|
||||
If you select an item in the tree view, the properties for that item are displayed in the right pane (in a read-only list view control).
|
||||
|
||||
Timeline Operations (Inserts / Edits / Deletes) are accomplished by right clicking on an item in the left pane. A context-sensitive menu will appear that will allow you to modify the timeline. A different popup menu will appear depending on the item selected in the TreeView. For example, right clicking on the timeline will bring up the timeline menu, whereas right clicking on the group will bring up the group menu. These menus are different and will only allow you to do timeline modifications that are allowed on the selected object.
|
||||
|
||||
The pull-down menus are for creating a new timeline, opening an existing timeline, and saving a timeline as an XML file.
|
||||
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 766 B |
Binary file not shown.
|
After Width: | Height: | Size: 766 B |
Binary file not shown.
|
After Width: | Height: | Size: 9.9 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 9.9 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 9.9 KiB |
@@ -0,0 +1,51 @@
|
||||
Type=Exe
|
||||
Reference=*\G{78530B68-61F9-11D2-8CAD-00A024580902}#1.0#0#c:\WINNT\System32\qedit.dll#Dexter 1.0 Type Library
|
||||
Reference=*\G{56A868B0-0AD4-11CE-B03A-0020AF0BA770}#1.0#0#c:\WINNT\System32\quartz.dll#ActiveMovie control type library
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#c:\WINNT\System32\stdole2.tlb#OLE Automation
|
||||
Reference=*\G{3D4B7DCD-B4FB-4469-ACD2-990F371F8460}#1.0#0#..\DShowVBLib\DshowVBLib.tlb#DshowForVBLib
|
||||
Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; MSCOMCTL.OCX
|
||||
Object={86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0; MSCOMCT2.OCX
|
||||
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; comdlg32.ocx
|
||||
Module=modGlobalData; modGlobalData.bas
|
||||
Module=modGeneral; modGeneral.bas
|
||||
UserControl=SourceClip.ctl
|
||||
Form=frmMain.frm
|
||||
Module=modDexter; modDexter.bas
|
||||
RelatedDoc=resources\doc\Slideshowvb.doc
|
||||
IconForm="frmMain"
|
||||
Startup="Sub Main"
|
||||
HelpFile=""
|
||||
Title="SlideShow"
|
||||
ExeName32="VB_SlideShow.exe"
|
||||
Command32=""
|
||||
Name="SlideshowVB"
|
||||
HelpContextID="0"
|
||||
Description="Microsoft Directshow Editing Services SlideShowVB Sample Application"
|
||||
CompatibleMode="0"
|
||||
MajorVer=8
|
||||
MinorVer=1
|
||||
RevisionVer=0
|
||||
AutoIncrementVer=0
|
||||
ServerSupportFiles=0
|
||||
VersionCompanyName="Microsoft Corporation"
|
||||
VersionFileDescription="Microsoft Directshow Editing Services SlideShowVB Sample Application"
|
||||
VersionLegalCopyright="Copyright (C) 1999-2001 Microsoft Corporation."
|
||||
CompilationType=0
|
||||
OptimizationType=0
|
||||
FavorPentiumPro(tm)=0
|
||||
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
|
||||
@@ -0,0 +1,5 @@
|
||||
modGlobalData = 35, 129, 757, 935, C
|
||||
modGeneral = 404, 182, 1132, 928, C
|
||||
SourceClip = 145, 220, 1049, 857, C, 44, 44, 212, 250, C
|
||||
frmMain = 22, 237, 1201, 846, C, 0, 0, 0, 0, C
|
||||
modDexter = 266, 313, 1196, 806, C
|
||||
@@ -0,0 +1,940 @@
|
||||
VERSION 5.00
|
||||
Begin VB.UserControl SourceClip
|
||||
BackColor = &H00FF0000&
|
||||
BorderStyle = 1 'Fixed Single
|
||||
ClientHeight = 2100
|
||||
ClientLeft = 0
|
||||
ClientTop = 0
|
||||
ClientWidth = 1860
|
||||
EditAtDesignTime= -1 'True
|
||||
KeyPreview = -1 'True
|
||||
LockControls = -1 'True
|
||||
OLEDropMode = 1 'Manual
|
||||
ScaleHeight = 2100
|
||||
ScaleWidth = 1860
|
||||
ToolboxBitmap = "SourceClip.ctx":0000
|
||||
Begin VB.Frame fraFixture
|
||||
BackColor = &H00000000&
|
||||
BorderStyle = 0 'None
|
||||
Height = 2115
|
||||
Left = 0
|
||||
OLEDropMode = 1 'Manual
|
||||
TabIndex = 0
|
||||
Top = 0
|
||||
Width = 1815
|
||||
Begin VB.Label lblClipName
|
||||
Alignment = 2 'Center
|
||||
Appearance = 0 'Flat
|
||||
BackColor = &H80000005&
|
||||
BackStyle = 0 'Transparent
|
||||
ForeColor = &H00FFFFFF&
|
||||
Height = 255
|
||||
Left = 0
|
||||
OLEDropMode = 1 'Manual
|
||||
TabIndex = 1
|
||||
Top = 1800
|
||||
Width = 1815
|
||||
End
|
||||
Begin VB.Image imgSourceClip
|
||||
Appearance = 0 'Flat
|
||||
BorderStyle = 1 'Fixed Single
|
||||
Height = 1695
|
||||
Left = 0
|
||||
OLEDropMode = 1 'Manual
|
||||
Picture = "SourceClip.ctx":0312
|
||||
Stretch = -1 'True
|
||||
Top = 0
|
||||
Width = 1815
|
||||
End
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "SourceClip"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = True
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
'*******************************************************************************
|
||||
'* This is a part of the Microsoft DXSDK 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.
|
||||
'* See these sources for detailed information regarding the
|
||||
'* Microsoft samples programs.
|
||||
'*******************************************************************************
|
||||
Option Explicit
|
||||
Option Base 0
|
||||
Option Compare Text
|
||||
|
||||
Private m_bstrFilter As String
|
||||
Private m_nBorderStyle As Long
|
||||
Private m_nBorderColor As Long
|
||||
Private m_bstrMediaFile As String
|
||||
Private m_sngBorderSize As Single
|
||||
Private m_boolShowMediaInfo As Boolean
|
||||
|
||||
'default application value(s)
|
||||
Private Const APP_SEPTUM_SIZE As Single = 60 'default septum size; in twips
|
||||
Private Const APP_DIVISIONAL_PERCENTAGE As Single = 0.75 'default divisional; in percent
|
||||
|
||||
'default design-time property value(s)
|
||||
Private Const DEFAULT_BORDERSIZE As Single = 5 'default border size, in pixels
|
||||
Private Const DEFAULT_BORDERSTYLE As Long = 1 'default border style
|
||||
Private Const DEFAULT_BORDERCOLOR As Long = vbBlack 'default border color, vbBlack
|
||||
Private Const DEFAULT_SHOWMEDIAINFO As Boolean = True 'default show info pane
|
||||
Private Const DEFAULT_MEDIAFILE As String = vbNullString 'default media file path/name
|
||||
Private Const DEFAULT_FILTER As String = ".avi;.mov;.mpg;.mpeg;.bmp;.jpg;.jpeg;.gif" 'default supported video media files
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PUBLIC INTERFACE- EVENTS
|
||||
' *
|
||||
' *
|
||||
Public Event Import(bstrFileName As String, Cancel As Boolean)
|
||||
Attribute Import.VB_Description = "Occurs when media is imported into the control by a user. Set 'Cancel' to true to inhibit the operation."
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PUBLIC INTERFACE- CONTROL ENUMERATIONS
|
||||
' *
|
||||
' *
|
||||
Public Enum SRCClipBorderStyleConstants
|
||||
None = 0
|
||||
FixedSingle = 1
|
||||
End Enum
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PUBLIC INTERFACE- CONTROL PROPERTIES
|
||||
' *
|
||||
' *
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: BorderColor
|
||||
' * procedure description: Returns either the elected or default border color.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Property Get BorderColor() As OLE_COLOR
|
||||
Attribute BorderColor.VB_Description = "Returns or assigns the controls border color."
|
||||
Attribute BorderColor.VB_ProcData.VB_Invoke_Property = ";Appearance"
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'obtain from module-level
|
||||
BorderColor = m_nBorderColor
|
||||
Exit Property
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Property
|
||||
End Property
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: BorderColor
|
||||
' * procedure description: Allows the client to assign a color to the controls border.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Property Let BorderColor(RHS As OLE_COLOR)
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'assign to module-level
|
||||
m_nBorderColor = RHS
|
||||
|
||||
'reset bordercolor
|
||||
If UserControl.BackColor <> RHS Then
|
||||
UserControl.BackColor = RHS
|
||||
End If
|
||||
Exit Property
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Property
|
||||
End Property
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: BorderStyle
|
||||
' * procedure description: Returns the style of the border around the control. Arguments are 0 - None or 1- Fixed Single
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Property Get BorderStyle() As SRCClipBorderStyleConstants
|
||||
Attribute BorderStyle.VB_Description = "Returns or assigns the style of the border around the control. Arguments are 0 - None or 1- Fixed Single"
|
||||
Attribute BorderStyle.VB_ProcData.VB_Invoke_Property = ";Appearance"
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'obtain from module-level
|
||||
BorderStyle = m_nBorderStyle
|
||||
Exit Property
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Property
|
||||
End Property
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: BorderStyle
|
||||
' * procedure description: Assigns the style of the border around the control. Arguments are 0 - None or 1- Fixed Single
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Property Let BorderStyle(RHS As SRCClipBorderStyleConstants)
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'assign to module-level
|
||||
m_nBorderStyle = RHS
|
||||
|
||||
'update borderstyle of the component
|
||||
If RHS = None Then
|
||||
Me.BorderSize = 0
|
||||
End If
|
||||
Exit Property
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Property
|
||||
End Property
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: BorderSize
|
||||
' * procedure description: Returns the width of the controls border, in pixels.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Property Get BorderSize() As Single
|
||||
Attribute BorderSize.VB_Description = "Returns or assigns the width of the controls border, in pixels."
|
||||
Attribute BorderSize.VB_ProcData.VB_Invoke_Property = ";Appearance"
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'obtain from module-level
|
||||
BorderSize = m_sngBorderSize
|
||||
Exit Property
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Property
|
||||
End Property
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: BorderSize
|
||||
' * procedure description: Assigns the width of the controls border, in pixels.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Property Let BorderSize(RHS As Single)
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'assign to module-level; convert to pixels
|
||||
m_sngBorderSize = CLng((RHS))
|
||||
|
||||
'if the bordersize is zero then reset the borderstyle to None
|
||||
If RHS = 0 Then
|
||||
Me.BorderStyle = None
|
||||
Call UserControl_Resize
|
||||
Else: Call UserControl_Resize
|
||||
End If
|
||||
Exit Property
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Property
|
||||
End Property
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Filter
|
||||
' * procedure description: Returns the semi colon delimited filter string for media MediaFile/export.
|
||||
' * Similar to the common dialog filter property. Valid Filter String Example: ".avi;.mpg;.bmp"
|
||||
' ******************************************************************************************************************************
|
||||
Public Property Get Filter() As String
|
||||
Attribute Filter.VB_Description = "Returns or assigns a semi colon delimited filter string for media MediaFile/export. Similar to the common dialog filter property. Valid Filter String Example: "".avi;.mpg;.bmp"""
|
||||
Attribute Filter.VB_ProcData.VB_Invoke_Property = ";Misc"
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'return the filter
|
||||
Filter = m_bstrFilter
|
||||
Exit Property
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Property
|
||||
End Property
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Filter
|
||||
' * procedure description: Assigns the semi colon delimited filter string for media MediaFile/export.
|
||||
' * Similar to the common dialog filter property. Valid Filter String Example: ".avi;.mpg;.bmp"
|
||||
' ******************************************************************************************************************************
|
||||
Public Property Let Filter(RHS As String)
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'assign the filter
|
||||
m_bstrFilter = RHS
|
||||
Exit Property
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Property
|
||||
End Property
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: MediaFile
|
||||
' * procedure description: Assigns the given media file to the control and maps it to the control for preview.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Property Let MediaFile(RHS As String)
|
||||
Dim nStreams As Long
|
||||
Dim boolCancel As Boolean
|
||||
Dim objMediaDet As MediaDet
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'raiseevent
|
||||
RaiseEvent Import(RHS, boolCancel)
|
||||
If boolCancel = True Then Exit Property
|
||||
|
||||
'assign to module-level
|
||||
m_bstrMediaFile = RHS
|
||||
|
||||
If HasVideoStream(RHS) Then
|
||||
'the media has been verified as having at least (1) valid video stream
|
||||
'so obtain a bitmap of the first frame of the first file dragged on to the usercontrol
|
||||
'or any of it's contingent controls and proceed to write out the bitmap to a temporary
|
||||
'file in the temp directory. From the temp file we can load the poster frame into the control.
|
||||
Set objMediaDet = New MediaDet
|
||||
objMediaDet.FileName = RHS
|
||||
Call objMediaDet.WriteBitmapBits(0, CLng(imgSourceClip.Width / Screen.TwipsPerPixelX), CLng(imgSourceClip.Height / Screen.TwipsPerPixelY), CStr(GetTempDirectory & App.EXEName & ".bmp"))
|
||||
'map the bitmap back to the temporary surface
|
||||
If Not LoadPicture(GetTempDirectory & App.EXEName & ".bmp") Is Nothing Then _
|
||||
Set imgSourceClip.Picture = LoadPicture(GetTempDirectory & App.EXEName & ".bmp")
|
||||
If InStrRev(RHS, "\") > 0 Then
|
||||
lblClipName.Caption = Trim(LCase(Mid(RHS, InStrRev(RHS, "\") + 1, Len(RHS))))
|
||||
lblClipName.ToolTipText = Trim(LCase(Mid(RHS, InStrRev(RHS, "\") + 1, Len(RHS))))
|
||||
imgSourceClip.ToolTipText = Trim(LCase(Mid(RHS, InStrRev(RHS, "\") + 1, Len(RHS))))
|
||||
Else
|
||||
lblClipName.Caption = vbNullString
|
||||
lblClipName.ToolTipText = vbNullString
|
||||
imgSourceClip.ToolTipText = vbNullString
|
||||
End If
|
||||
Else
|
||||
imgSourceClip.Picture = LoadPicture(vbNullString) 'disregard the picture
|
||||
If InStrRev(RHS, "\") > 0 Then
|
||||
lblClipName.Caption = Trim(LCase(Mid(RHS, InStrRev(RHS, "\") + 1, Len(RHS))))
|
||||
lblClipName.ToolTipText = Trim(LCase(Mid(RHS, InStrRev(RHS, "\") + 1, Len(RHS))))
|
||||
imgSourceClip.ToolTipText = Trim(LCase(Mid(RHS, InStrRev(RHS, "\") + 1, Len(RHS))))
|
||||
Else
|
||||
lblClipName.Caption = vbNullString
|
||||
lblClipName.ToolTipText = vbNullString
|
||||
imgSourceClip.ToolTipText = vbNullString
|
||||
End If
|
||||
End If
|
||||
|
||||
'clean-up & dereference
|
||||
If Not objMediaDet Is Nothing Then Set objMediaDet = Nothing
|
||||
Exit Property
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Property
|
||||
End Property
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: MediaFile
|
||||
' * procedure description: Returns the assigned media file for the control.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Property Get MediaFile() As String
|
||||
Attribute MediaFile.VB_Description = "Returns or assigns the given media file to the control and maps it to the control for preview."
|
||||
Attribute MediaFile.VB_ProcData.VB_Invoke_Property = ";Misc"
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'return the media file
|
||||
MediaFile = m_bstrMediaFile
|
||||
Exit Property
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Property
|
||||
End Property
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: BorderColor
|
||||
' * procedure description: Returns a boolean indicating if the media info is displayed for the given clip.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Property Get ShowMediaInfo() As OLE_CANCELBOOL
|
||||
Attribute ShowMediaInfo.VB_Description = "Returns or assigns a value indicating if the media info is displayed for the given clip."
|
||||
Attribute ShowMediaInfo.VB_ProcData.VB_Invoke_Property = ";Appearance"
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'obtain from module-level
|
||||
ShowMediaInfo = m_boolShowMediaInfo
|
||||
Exit Property
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Property
|
||||
End Property
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: ShowMediaInfo
|
||||
' * procedure description: Assigns a boolean indicating if the media info is displayed for the given clip.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Property Let ShowMediaInfo(RHS As OLE_CANCELBOOL)
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'assign to module-level
|
||||
m_boolShowMediaInfo = RHS
|
||||
|
||||
'resize component to reflect update
|
||||
lblClipName.Visible = RHS
|
||||
Call UserControl_Resize
|
||||
Exit Property
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Property
|
||||
End Property
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- USER CONTROL EVENTS
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: UserControl_AmbientChanged
|
||||
' * procedure description: Occurs when an ambient value was changed by the container of a user control
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub UserControl_AmbientChanged(PropertyName As String)
|
||||
On Local Error GoTo ErrLine
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: UserControl_AsyncReadComplete
|
||||
' * procedure description: Occurs when all of the data is available as a result of the AsyncRead method.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub UserControl_AsyncReadComplete(AsyncProp As AsyncProperty)
|
||||
On Local Error GoTo ErrLine
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: UserControl_AsyncReadProgress
|
||||
' * procedure description: Occurs when more data is available as a result of the AsyncReadProgress method.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub UserControl_AsyncReadProgress(AsyncProp As AsyncProperty)
|
||||
On Local Error GoTo ErrLine
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: UserControl_Click
|
||||
' * procedure description: Occurs when the user presses and then releases a mouse button over an object.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub UserControl_Click()
|
||||
On Local Error GoTo ErrLine
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: UserControl_DragDrop
|
||||
' * procedure description: Occurs when a drag-and-drop operation is completed.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub UserControl_DragDrop(Source As Control, X As Single, Y As Single)
|
||||
On Local Error GoTo ErrLine
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: UserControl_DragOver
|
||||
' * procedure description: Occurs when a drag-and-drop operation is in progress.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub UserControl_DragOver(Source As Control, X As Single, Y As Single, State As Integer)
|
||||
On Local Error GoTo ErrLine
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: UserControl_GotFocus
|
||||
' * procedure description: Occurs when an object receives the focus.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub UserControl_GotFocus()
|
||||
On Local Error GoTo ErrLine
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: UserControl_Hide
|
||||
' * procedure description: Occurs when the control's Visible property changes to False.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub UserControl_Hide()
|
||||
On Local Error GoTo ErrLine
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: UserControl_Initialize
|
||||
' * procedure description: Occurs when an application creates an instance of a Form, MDIForm, or class.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub UserControl_Initialize()
|
||||
On Local Error GoTo ErrLine
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: UserControl_InitProperties
|
||||
' * procedure description: Occurs the first time a user control or user document is created.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub UserControl_InitProperties()
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'set public property values for design time
|
||||
If UserControl.Ambient.UserMode = False Then
|
||||
Me.BorderColor = DEFAULT_BORDERCOLOR
|
||||
Me.BorderSize = DEFAULT_BORDERSIZE
|
||||
Me.BorderStyle = DEFAULT_BORDERSTYLE
|
||||
Me.Filter = DEFAULT_FILTER
|
||||
Me.MediaFile = DEFAULT_MEDIAFILE
|
||||
Me.ShowMediaInfo = DEFAULT_SHOWMEDIAINFO
|
||||
End If
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: UserControl_KeyDown
|
||||
' * procedure description: Occurs when the user presses a key while an object has the focus.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
|
||||
On Local Error GoTo ErrLine
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: UserControl_LostFocus
|
||||
' * procedure description: Occurs when an object loses the focus.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub UserControl_LostFocus()
|
||||
On Local Error GoTo ErrLine
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: UserControl_OLEDragDrop
|
||||
' * procedure description: Occurs when data is dropped onto the control via an OLE drag/drop operation,
|
||||
' * and OLEDropMode is set to manual.
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub UserControl_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
|
||||
On Local Error GoTo ErrLine
|
||||
Call AppOLEDragDrop(Data, Effect, Button, Shift, X, Y)
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: UserControl_OLEDragOver
|
||||
' * procedure description: Occurs when the mouse is moved over the control during an OLE drag/drop operation,
|
||||
' * if its OLEDropMode property is set to manual.
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub UserControl_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
|
||||
On Local Error GoTo ErrLine
|
||||
Call AppOLEDragOver(Data, Effect, Button, Shift, X, Y, State)
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: UserControl_Paint
|
||||
' * procedure description: Occurs when any part of a form or PictureBox control is moved, enlarged, or exposed.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub UserControl_Paint()
|
||||
On Local Error GoTo ErrLine
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: UserControl_ReadProperties
|
||||
' * procedure description: Occurs when a user control or user document is asked to read its data from a file.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'obtain design time value(s) from the property bag during run-time
|
||||
Me.MediaFile = PropBag.ReadProperty("MediaFile", DEFAULT_MEDIAFILE)
|
||||
Me.Filter = PropBag.ReadProperty("Filter", DEFAULT_FILTER)
|
||||
Me.BorderColor = PropBag.ReadProperty("BorderColor", DEFAULT_BORDERCOLOR)
|
||||
Me.BorderSize = PropBag.ReadProperty("BorderSize", DEFAULT_BORDERSIZE)
|
||||
Me.ShowMediaInfo = PropBag.ReadProperty("ShowMediaInfo", DEFAULT_SHOWMEDIAINFO)
|
||||
Me.BorderStyle = PropBag.ReadProperty("BorderStyle", DEFAULT_BORDERSTYLE)
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: UserControl_Resize
|
||||
' * procedure description: Occurs when a form is first displayed or the size of an object changes.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub UserControl_Resize()
|
||||
Dim sngBorderSize As Single
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'assign from module-level
|
||||
sngBorderSize = m_sngBorderSize * Screen.TwipsPerPixelX
|
||||
|
||||
'fixture frame absolute position
|
||||
If fraFixture.Top <> (UserControl.ScaleTop + sngBorderSize) Then fraFixture.Top = (UserControl.ScaleTop + sngBorderSize)
|
||||
If fraFixture.Left <> (UserControl.ScaleLeft + sngBorderSize) Then fraFixture.Left = (UserControl.ScaleLeft + sngBorderSize)
|
||||
If fraFixture.Width <> (UserControl.ScaleWidth - (sngBorderSize * 2)) Then fraFixture.Width = (UserControl.ScaleWidth - (sngBorderSize * 2))
|
||||
If fraFixture.Height <> (UserControl.ScaleHeight - (sngBorderSize * 2)) Then fraFixture.Height = (UserControl.ScaleHeight - (sngBorderSize * 2))
|
||||
|
||||
If lblClipName.Visible = False Then
|
||||
'source clip picturebox relative position
|
||||
If imgSourceClip.Top <> imgSourceClip.Parent.ScaleTop Then imgSourceClip.Top = imgSourceClip.Parent.ScaleTop
|
||||
If imgSourceClip.Left <> imgSourceClip.Parent.ScaleLeft Then imgSourceClip.Left = imgSourceClip.Parent.ScaleLeft
|
||||
If imgSourceClip.Width <> imgSourceClip.Parent.ScaleWidth Then imgSourceClip.Width = imgSourceClip.Parent.ScaleWidth
|
||||
If imgSourceClip.Height <> imgSourceClip.Parent.ScaleHeight Then imgSourceClip.Height = imgSourceClip.Parent.ScaleHeight
|
||||
|
||||
Else
|
||||
'source clip picturebox relative position
|
||||
If imgSourceClip.Top <> imgSourceClip.Parent.ScaleTop Then imgSourceClip.Top = imgSourceClip.Parent.ScaleTop
|
||||
If imgSourceClip.Left <> imgSourceClip.Parent.ScaleLeft Then imgSourceClip.Left = imgSourceClip.Parent.ScaleLeft
|
||||
If imgSourceClip.Width <> imgSourceClip.Parent.ScaleWidth Then imgSourceClip.Width = imgSourceClip.Parent.ScaleWidth
|
||||
If imgSourceClip.Height <> (imgSourceClip.Parent.ScaleHeight * APP_DIVISIONAL_PERCENTAGE) Then imgSourceClip.Height = (imgSourceClip.Parent.ScaleHeight * APP_DIVISIONAL_PERCENTAGE)
|
||||
|
||||
'source clip filename relative to source clip picturebox
|
||||
If lblClipName.Top <> (imgSourceClip.Top + imgSourceClip.Height) + APP_SEPTUM_SIZE Then lblClipName.Top = (imgSourceClip.Top + imgSourceClip.Height) + APP_SEPTUM_SIZE
|
||||
If lblClipName.Left <> lblClipName.Parent.ScaleLeft Then lblClipName.Left = lblClipName.Parent.ScaleLeft
|
||||
If lblClipName.Width <> lblClipName.Parent.ScaleWidth Then lblClipName.Width = lblClipName.Parent.ScaleWidth
|
||||
If lblClipName.Height <> lblClipName.Parent.ScaleHeight - (imgSourceClip.Height + APP_SEPTUM_SIZE) Then lblClipName.Height = lblClipName.Parent.ScaleHeight - (imgSourceClip.Height + APP_SEPTUM_SIZE)
|
||||
End If
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: UserControl_Show
|
||||
' * procedure description: Occurs when the control's Visible property changes to True.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub UserControl_Show()
|
||||
On Local Error GoTo ErrLine
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: UserControl_Terminate
|
||||
' * procedure description: Occurs when all references to an instance of a Form, MDIForm, or class are removed from memory.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub UserControl_Terminate()
|
||||
On Local Error GoTo ErrLine
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: UserControl_WriteProperties
|
||||
' * procedure description: Occurs when a user control or user document is asked to write its data to a file.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'persist design time value(s) to the property bag only after design-time
|
||||
If Ambient.UserMode = False Then
|
||||
Call PropBag.WriteProperty("Filter", Me.Filter, DEFAULT_FILTER)
|
||||
Call PropBag.WriteProperty("MediaFile", Me.MediaFile, DEFAULT_MEDIAFILE)
|
||||
Call PropBag.WriteProperty("BorderColor", Me.BorderColor, DEFAULT_BORDERCOLOR)
|
||||
Call PropBag.WriteProperty("BorderSize", Me.BorderSize, DEFAULT_BORDERSIZE)
|
||||
Call PropBag.WriteProperty("BorderStyle", Me.BorderStyle, DEFAULT_BORDERSTYLE)
|
||||
Call PropBag.WriteProperty("ShowMediaInfo", Me.ShowMediaInfo, DEFAULT_SHOWMEDIAINFO)
|
||||
End If
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- CONTROL EVENTS
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: imgSourceClip_OLEDragDrop
|
||||
' * procedure description: Occurs when a user control or user document is asked to write its data to a file.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub imgSourceClip_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
|
||||
On Local Error GoTo ErrLine
|
||||
Call AppOLEDragDrop(Data, Effect, Button, Shift, X, Y)
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: imgSourceClip_OLEDragOver
|
||||
' * procedure description: Occurs when a user control or user document is asked to write its data to a file.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub imgSourceClip_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
|
||||
On Local Error GoTo ErrLine
|
||||
Call AppOLEDragOver(Data, Effect, Button, Shift, X, Y, State)
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: lblClipName_OLEDragDrop
|
||||
' * procedure description: Occurs when the mouse is moved over the control during an OLE drag/drop operation,
|
||||
' * if its OLEDropMode property is set to manual.
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub lblClipName_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
|
||||
On Local Error GoTo ErrLine
|
||||
Call AppOLEDragDrop(Data, Effect, Button, Shift, X, Y)
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: lblClipName_OLEDragOver
|
||||
' * procedure description: Occurs when the mouse is moved over the control during an OLE drag/drop operation,
|
||||
' * if its OLEDropMode property is set to manual.
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub lblClipName_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
|
||||
On Local Error GoTo ErrLine
|
||||
Call AppOLEDragOver(Data, Effect, Button, Shift, X, Y, State)
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: fraFixture_OLEDragDrop
|
||||
' * procedure description: Occurs when the mouse is moved over the control during an OLE drag/drop operation,
|
||||
' * if its OLEDropMode property is set to manual.
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub fraFixture_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
|
||||
On Local Error GoTo ErrLine
|
||||
Call AppOLEDragDrop(Data, Effect, Button, Shift, X, Y)
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: fraFixture_OLEDragOver
|
||||
' * procedure description: Occurs when the mouse is moved over the control during an OLE drag/drop operation,
|
||||
' * if its OLEDropMode property is set to manual.
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub fraFixture_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
|
||||
On Local Error GoTo ErrLine
|
||||
Call AppOLEDragOver(Data, Effect, Button, Shift, X, Y, State)
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- PROCEDURES
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: AppOLEDragDrop
|
||||
' * procedure description: Occurs when the mouse is moved over the control during an OLE drag/drop operation,
|
||||
' * if its OLEDropMode property is set to manual.
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub AppOLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'load the media clip
|
||||
Me.MediaFile = Data.Files(1)
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: AppOLEDragOver
|
||||
' * procedure description: Occurs when the mouse is moved over the control during an OLE drag/drop operation,
|
||||
' * if its OLEDropMode property is set to manual.
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub AppOLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
|
||||
Dim nCount As Long
|
||||
Dim nCount2 As Long
|
||||
Dim varSupport() As String
|
||||
Dim bstrSupport As String
|
||||
Dim bstrFileName As String
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'set default(s)
|
||||
Effect = vbDropEffectNone
|
||||
If Me.Filter = vbNullString Then
|
||||
bstrSupport = DEFAULT_FILTER
|
||||
Else: bstrSupport = m_bstrFilter
|
||||
End If
|
||||
'split the supported files into an array, if this fails the effect will be vbDropEffectNone
|
||||
varSupport = Split(bstrSupport, ";")
|
||||
|
||||
For nCount = 1 To Data.Files.Count
|
||||
For nCount2 = LBound(varSupport) To UBound(varSupport)
|
||||
If LCase(varSupport(nCount2)) <> vbNullString Then
|
||||
If InStr(LCase(Data.Files(nCount)), LCase(varSupport(nCount2))) > 0 Then
|
||||
'match located, supported media file dropped..
|
||||
Effect = vbDropEffectCopy
|
||||
bstrFileName = Data.Files(nCount)
|
||||
Data.Files.Clear: Data.Files.Add bstrFileName
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
Next
|
||||
'reset effect
|
||||
Effect = vbDropEffectNone
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
|
||||
Err.Clear
|
||||
'reset effect
|
||||
Effect = vbDropEffectNone
|
||||
Exit Sub
|
||||
End Sub
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,376 @@
|
||||
Attribute VB_Name = "modGeneral"
|
||||
'*******************************************************************************
|
||||
'* This is a part of the Microsoft DXSDK 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.
|
||||
'* See these sources for detailed information regarding the
|
||||
'* Microsoft samples programs.
|
||||
'*******************************************************************************
|
||||
Option Explicit
|
||||
Option Base 0
|
||||
Option Compare Text
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PUBLIC INTERFACE- WIN32 API CONSTANTS
|
||||
' *
|
||||
' *
|
||||
Public Const FO_COPY = &H2
|
||||
Public Const FO_DELETE = &H3
|
||||
Public Const FO_MOVE = &H1
|
||||
Public Const FO_RENAME = &H4
|
||||
Public Const FOF_ALLOWUNDO = &H40
|
||||
Public Const FOF_CONFIRMMOUSE = &H2
|
||||
Public Const FOF_FILESONLY = &H80 ''"" on *.*, do only files
|
||||
Public Const FOF_MULTIDESTFILES = &H1
|
||||
Public Const FOF_NOCONFIRMATION = &H10 ''"" Don't prompt the user.
|
||||
Public Const FOF_NOCONFIRMMKDIR = &H200 ''"" don't confirm making any needed dirs
|
||||
Public Const FOF_NOCOPYSECURITYATTRIBS = &H800 ''"" dont copy NT file Security Attributes
|
||||
Public Const FOF_NOERRORUI = &H400 ''"" don't put up error UI
|
||||
Public Const FOF_NORECURSION = &H1000 ''"" don't recurse into directories.
|
||||
Public Const FOF_NO_CONNECTED_ELEMENTS = &H2000 ''"" don't operate on connected file elements.
|
||||
Public Const FOF_RENAMEONCOLLISION = &H8
|
||||
Public Const FOF_SILENT = &H4 ''"" don't create progress"report
|
||||
Public Const FOF_SIMPLEPROGRESS = &H100 ''"" means don't show names of files
|
||||
Public Const FOF_WANTMAPPINGHANDLE = &H20 ''"" Fill in SHFILEOPSTRUCT.hNameMappings
|
||||
Private Const MAX_PATH As Long = 255
|
||||
Private Const INVALID_HANDLE_VALUE = -1
|
||||
Private Const SEM_FAILCRITICALERRORS = &H1
|
||||
Private Const SEM_NOOPENFILEERRORBOX = &H8000
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PUBLIC INTERFACE- WIN32 API DATA STRUCTURES
|
||||
' *
|
||||
' *
|
||||
Private Type FILETIME
|
||||
dwLowDateTime As Long
|
||||
dwHighDateTime As Long
|
||||
End Type
|
||||
|
||||
Public Type WIN32_FIND_DATA
|
||||
dwFileAttributes As Long
|
||||
ftCreationTime As FILETIME
|
||||
ftLastAccessTime As FILETIME
|
||||
ftLastWriteTime As FILETIME
|
||||
nFileSizeHigh As Long
|
||||
nFileSizeLow As Long
|
||||
dwReserved0 As Long
|
||||
dwReserved1 As Long
|
||||
cFileName As String * MAX_PATH
|
||||
cAlternate As String * 14
|
||||
End Type
|
||||
|
||||
Private Type SHFILEOPSTRUCT
|
||||
hWnd As Long
|
||||
wFunc As Long
|
||||
pFrom As String
|
||||
pTo As String
|
||||
fFlags As Integer
|
||||
fAnyOperationsAborted As Long
|
||||
hNameMappings As Long
|
||||
lpszProgressTitle As String ' only used if FOF_SIMPLEPROGRESS
|
||||
End Type
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PUBLIC INTERFACE- WIN32 API DECLARATIONS
|
||||
' *
|
||||
' *
|
||||
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
|
||||
Private Declare Function SetErrorMode Lib "kernel32" (ByVal wMode As Long) As Long
|
||||
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
|
||||
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
|
||||
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PUBLIC INTERFACE- DEXTER PROCEDURES
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: GetPinInfo
|
||||
' * procedure description: Returns an IPinInfo interface given a filtergraph manager and IPin object.
|
||||
' * The derived IPinInfo interface can be utilized for gaining information on the elected pin.
|
||||
' ******************************************************************************************************************************
|
||||
Public Function GetPinInfo(objFilterGraphManager As FilgraphManager, objPin As IPin) As IPinInfo
|
||||
Dim objPin2 As IPin
|
||||
Dim objPinInfo As IPinInfo
|
||||
Dim objFilterInfo As IFilterInfo
|
||||
Dim objPinCollection As Object
|
||||
Dim objlFilterCollection As Object
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'derive a filter collection from the filtergraph manager
|
||||
Set objlFilterCollection = objFilterGraphManager.FilterCollection
|
||||
|
||||
'enumerate through the filter(s) in the collection
|
||||
For Each objFilterInfo In objlFilterCollection
|
||||
Set objPinCollection = objFilterInfo.Pins
|
||||
For Each objPinInfo In objPinCollection
|
||||
Set objPin2 = objPinInfo.Pin
|
||||
If objPin2 Is objPin Then
|
||||
Set GetPinInfo = objPinInfo
|
||||
Exit Function
|
||||
End If
|
||||
Next
|
||||
Next
|
||||
|
||||
'clean-up & dereference
|
||||
If Not objPin2 Is Nothing Then Set objPin2 = Nothing
|
||||
If Not objPinInfo Is Nothing Then Set objPinInfo = Nothing
|
||||
If Not objFilterInfo Is Nothing Then Set objFilterInfo = Nothing
|
||||
If Not objPinCollection Is Nothing Then Set objPinCollection = Nothing
|
||||
If Not objlFilterCollection Is Nothing Then Set objlFilterCollection = Nothing
|
||||
Exit Function
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Function
|
||||
End Function
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: AddFileWriterAndMux
|
||||
' * procedure description: Appends a filewriter and mux filter to the given filtergraph.
|
||||
' * The FileName as required for the filewriter and evaluates to the output file destination.
|
||||
' ******************************************************************************************************************************
|
||||
Public Sub AddFileWriterAndMux(objFilterGraphManager As FilgraphManager, bstrFileName As String)
|
||||
Dim objFilterInfo As IFilterInfo
|
||||
Dim objRegisteredFilters As Object
|
||||
Dim objAVIMuxFilterInfo As IFilterInfo
|
||||
Dim objRegFilterInfo As IRegFilterInfo
|
||||
Dim objFileSinkFilterVB As IFileSinkFilterForVB
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'derive a collection of registered filters from the filtergraph manager
|
||||
Set objRegisteredFilters = objFilterGraphManager.RegFilterCollection
|
||||
|
||||
'enumerate through the registered filters
|
||||
For Each objRegFilterInfo In objRegisteredFilters
|
||||
If Trim(LCase(objRegFilterInfo.Name)) = "file writer" Then
|
||||
objRegFilterInfo.Filter objFilterInfo
|
||||
ElseIf Trim(LCase(objRegFilterInfo.Name)) = "avi mux" Then
|
||||
objRegFilterInfo.Filter objAVIMuxFilterInfo
|
||||
End If
|
||||
Next
|
||||
|
||||
'derive the file sink filter tailored for vb
|
||||
Set objFileSinkFilterVB = objFilterInfo.Filter
|
||||
'assign the filename to the sink filter
|
||||
Call objFileSinkFilterVB.SetFileName(bstrFileName, Nothing)
|
||||
|
||||
'clean-up & dereference
|
||||
If Not objFilterInfo Is Nothing Then Set objFilterInfo = Nothing
|
||||
If Not objRegFilterInfo Is Nothing Then Set objRegFilterInfo = Nothing
|
||||
If Not objFileSinkFilterVB Is Nothing Then Set objFileSinkFilterVB = Nothing
|
||||
If Not objAVIMuxFilterInfo Is Nothing Then Set objAVIMuxFilterInfo = Nothing
|
||||
If Not objRegisteredFilters Is Nothing Then Set objRegisteredFilters = Nothing
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: RenderGroupPins
|
||||
' * procedure description: Renders the Pins out for the given timeline using the given render engine.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Sub RenderGroupPins(objRenderEngine As RenderEngine, objTimeline As AMTimeline)
|
||||
Dim objPin As IPin
|
||||
Dim nCount As Long
|
||||
Dim nGroupCount As Long
|
||||
Dim objPinInfo As IPinInfo
|
||||
Dim objFilterGraphManager As FilgraphManager
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
If Not objTimeline Is Nothing Then
|
||||
If Not objRenderEngine Is Nothing Then
|
||||
'obtain the group count
|
||||
objTimeline.GetGroupCount nGroupCount
|
||||
'exit the procedure if there are no group(s)
|
||||
If nGroupCount = 0 Then Exit Sub
|
||||
'obtain the filtergraph
|
||||
objRenderEngine.GetFilterGraph objFilterGraphManager
|
||||
'enumerate through the groups & render the pins
|
||||
For nCount = 0 To nGroupCount - 1
|
||||
objRenderEngine.GetGroupOutputPin nCount, objPin
|
||||
If Not objPin Is Nothing Then
|
||||
Set objPinInfo = GetPinInfo(objFilterGraphManager, objPin)
|
||||
If Not objPinInfo Is Nothing Then
|
||||
Call objPinInfo.Render
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
End If
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Resume Next
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: TransitionFriendlyNameToProgID
|
||||
' * procedure description: Returns the programmatic identifier for the given transition friendly name
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Function TransitionFriendlyNameToProgID(bstrTransitionFriendlyName As String) As String
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
Select Case LCase(Trim(bstrTransitionFriendlyName))
|
||||
Case "default"
|
||||
TransitionFriendlyNameToProgID = "DxtJpegDll.DxtJpeg"
|
||||
Case "slide"
|
||||
TransitionFriendlyNameToProgID = "DXImageTransform.Microsoft.CrSlide"
|
||||
Case "fade"
|
||||
TransitionFriendlyNameToProgID = "DXImageTransform.Microsoft.Fade"
|
||||
Case "ripple"
|
||||
TransitionFriendlyNameToProgID = "DXImageTransform.MetaCreations.Water"
|
||||
Case "circle"
|
||||
TransitionFriendlyNameToProgID = "DXImageTransform.MetaCreations.Grid"
|
||||
Case "burn film"
|
||||
TransitionFriendlyNameToProgID = "DXImageTransform.MetaCreations.BurnFilm"
|
||||
Case "barn doors"
|
||||
TransitionFriendlyNameToProgID = "DXImageTransform.Microsoft.CrBarn"
|
||||
End Select
|
||||
Exit Function
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Function
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PUBLIC INTERFACE- GENERAL PROCEDURES
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Buffer_ParseEx
|
||||
' * procedure description: Parse's a fixed length string buffer of all vbNullCharacters AND vbNullStrings.
|
||||
' * Argument bstrBuffer evaluates to either an ANSII or Unicode BSTR string buffer.
|
||||
' * (bstrBuffer is almost always the output from a windows api call which needs parsed)
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Function Buffer_ParseEx(bstrBuffer As String) As String
|
||||
Dim iCount As Long, bstrChar As String, bstrReturn As String
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
For iCount = 1 To Len(bstrBuffer) 'set up a loop to remove the vbNullChar's from the buffer.
|
||||
bstrChar = Strings.Mid(bstrBuffer, iCount, 1)
|
||||
If bstrChar <> vbNullChar And bstrChar <> vbNullString Then bstrReturn = (bstrReturn + bstrChar)
|
||||
Next
|
||||
Buffer_ParseEx = bstrReturn
|
||||
Exit Function
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Function
|
||||
End Function
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: GetTempDirectory
|
||||
' * procedure description: Returns a bstr String representing the fully qualified path to the system's temp directory
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Function GetTempDirectory() As String
|
||||
Dim bstrBuffer As String * MAX_PATH
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'call the win32api
|
||||
Call GetTempPath(MAX_PATH, bstrBuffer)
|
||||
'parse & return the value to the client
|
||||
GetTempDirectory = Buffer_ParseEx(bstrBuffer)
|
||||
Exit Function
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Function
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: File_Exists
|
||||
' * procedure description: Returns true if the specified file does in fact exist.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Function File_Exists(bstrFileName As String) As Boolean
|
||||
Dim WFD As WIN32_FIND_DATA, hFile As Long
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
WFD.cFileName = bstrFileName & vbNullChar
|
||||
hFile = FindFirstFile(bstrFileName, WFD)
|
||||
File_Exists = hFile <> INVALID_HANDLE_VALUE
|
||||
Call FindClose(hFile)
|
||||
Exit Function
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Function
|
||||
End Function
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: File_Delete
|
||||
' * procedure description: This will delete a File. Pass any of the specified optionals to invoke those particular features.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Function File_Delete(bstrFileName As String, Optional SendToRecycleBin As Boolean = True, Optional Confirm As Boolean = True, Optional ShowProgress As Boolean = True) As Long
|
||||
Dim fileop As SHFILEOPSTRUCT
|
||||
Dim WFD As WIN32_FIND_DATA, hFile As Long
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'check argument
|
||||
If Right(bstrFileName, 1) = "\" Then bstrFileName = Left(bstrFileName, (Len(bstrFileName) - 1))
|
||||
'ensure the file exists
|
||||
WFD.cFileName = bstrFileName & vbNullChar
|
||||
hFile = FindFirstFile(bstrFileName, WFD)
|
||||
If hFile = INVALID_HANDLE_VALUE Then
|
||||
Call FindClose(hFile)
|
||||
Exit Function
|
||||
Else: Call FindClose(hFile)
|
||||
End If
|
||||
'set the error mode
|
||||
Call SetErrorMode(SEM_NOOPENFILEERRORBOX + SEM_FAILCRITICALERRORS)
|
||||
'set up the file operation by the specified optionals
|
||||
With fileop
|
||||
.hWnd = 0: .wFunc = FO_DELETE
|
||||
.pFrom = UCase(bstrFileName) & vbNullChar & vbNullChar
|
||||
If SendToRecycleBin Then 'goes to recycle bin
|
||||
.fFlags = FOF_ALLOWUNDO
|
||||
If Confirm = False Then .fFlags = .fFlags + FOF_NOCONFIRMATION 'do not confirm
|
||||
If ShowProgress = False Then .fFlags = .fFlags + FOF_SILENT 'do not show progress
|
||||
Else 'just delete the file
|
||||
If Confirm = False Then .fFlags = .fFlags + FOF_NOCONFIRMATION 'do not confirm
|
||||
If ShowProgress = False Then .fFlags = .fFlags + FOF_SILENT 'do not show progress
|
||||
End If
|
||||
End With
|
||||
'execute the file operation, return any errors..
|
||||
File_Delete = SHFileOperation(fileop)
|
||||
Exit Function
|
||||
|
||||
ErrLine:
|
||||
File_Delete = Err.Number 'if there was a abend in the procedure, return that too..
|
||||
Err.Clear
|
||||
Exit Function
|
||||
End Function
|
||||
@@ -0,0 +1,56 @@
|
||||
Attribute VB_Name = "modGlobalData"
|
||||
'*******************************************************************************
|
||||
'* This is a part of the Microsoft DXSDK 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.
|
||||
'* See these sources for detailed information regarding the
|
||||
'* Microsoft samples programs.
|
||||
'*******************************************************************************
|
||||
Option Explicit
|
||||
Option Base 0
|
||||
Option Compare Text
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * GLOBAL INTERFACE- DATA
|
||||
' *
|
||||
' *
|
||||
Global gbl_objMediaControl As IMediaControl 'playback control
|
||||
Global gbl_objTimeline As AMTimeline 'application timeline object
|
||||
Global gbl_objRenderEngine As RenderEngine 'application render engine
|
||||
Global gbl_objVideoWindow As IVideoWindow 'application video window for playback
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * GLOBAL INTERFACE- CONSTANTS
|
||||
' *
|
||||
' *
|
||||
Global Const SLIDESHOWVB_CLIPLENGTH As Double = 4# 'how long each clip lasts on the timeline
|
||||
Global Const SLIDESHOWVB_VIDEOTYPE As String = "{73646976-0000-0010-8000-00AA00389B71}"
|
||||
Global Const SLIDESHOWVB_AUDIOTYPE As String = "{73647561-0000-0010-8000-00AA00389B71}"
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * GLOBAL INTERFACE- APPLICATION ENTRY POINT
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Main
|
||||
' * procedure description: Application Entry Point.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Sub Main()
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
Load frmMain
|
||||
frmMain.Move 0, 0
|
||||
frmMain.Visible = True
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
@@ -0,0 +1,52 @@
|
||||
DirectShow Sample -- SlideShow
|
||||
------------------------------
|
||||
|
||||
Description
|
||||
|
||||
Microsoft Visual Basic application that creates a slide show from a series
|
||||
of video clips or image files.
|
||||
|
||||
|
||||
User's Guide
|
||||
|
||||
This sample application demonstrates the following tasks:
|
||||
|
||||
- Using the MediaDet object to obtain a poster frame from a source clip.
|
||||
- Saving a timeline as an XTL file.
|
||||
- Writing a timeline to an AVI file.
|
||||
- Loading media clips.
|
||||
|
||||
To use this application, do the following:
|
||||
|
||||
- Drag video files or image files from Windows Explorer to the cells in the
|
||||
application window, starting from the cell in the upper-left corner.
|
||||
|
||||
- Enter the length of time that each clip should play, in seconds.
|
||||
|
||||
- Select a transition, using the combo box. The transitions have a
|
||||
fixed two-second duration.
|
||||
|
||||
- To preview the slide show, click Play.
|
||||
|
||||
- To save the slide show as an XTL project, click Write XTL. You can then
|
||||
play your new XTL file using the XTLTest, XTLTest VB, and DexterVB
|
||||
sample applications.
|
||||
|
||||
- To save the slide show as an AVI file, click Write AVI.
|
||||
|
||||
For more information about this sample, see the SlideShowVB.DOC documentation
|
||||
in the resources\doc subdirectory. This documentation contains screenshots
|
||||
that demonstrate how to create a simple slideshow.
|
||||
|
||||
|
||||
NOTE: The list of transitions is hard-coded into the application; consequently,
|
||||
some of the transitions in the combo box may not be present on your development
|
||||
machine. If you select a transition that is not installed on your machine,
|
||||
then the default "Slide" transition will be used instead.
|
||||
|
||||
The DirectX Media 6 SDK includes several third-party transitions in the form
|
||||
of DirectX Transforms. To enable these transitions, you can install the
|
||||
DirectX Media 6 SDK, which is available only on the DirectX 7.0a CD-ROM.
|
||||
You can order this CD-ROM by following the "DirectX 7.0a SDK CD-ROM" link on
|
||||
http://www.microsoft.com/directx/dxmedia.
|
||||
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 822 B |
Binary file not shown.
Binary file not shown.
|
After Width: | Height: | Size: 766 B |
@@ -0,0 +1,41 @@
|
||||
DirectShow Sample -- SlideShow
|
||||
------------------------------
|
||||
|
||||
Description
|
||||
|
||||
Microsoft Visual Basic application that creates a slide show from a series
|
||||
of video clips or image files.
|
||||
|
||||
|
||||
User's Guide
|
||||
|
||||
This sample application demonstrates the following tasks:
|
||||
|
||||
- Using the MediaDet object to obtain a poster frame from a source clip.
|
||||
- Saving a timeline as an XTL file.
|
||||
- Writing a timeline to an AVI file.
|
||||
- Loading media clips.
|
||||
|
||||
To use this application, do the following:
|
||||
|
||||
- Drag video files or image files from Windows Explorer to the cells in the
|
||||
application window, starting from the cell in the upper-left corner.
|
||||
|
||||
- Enter the length of time that each clip should play, in seconds.
|
||||
|
||||
- Select a transition, using the combo box. The transitions have a
|
||||
fixed two-second duration.
|
||||
|
||||
- To preview the slide show, click Play.
|
||||
|
||||
- To save the slide show as an XTL project, click Write XTL. You can then
|
||||
play your new XTL file using the XTLTest, XTLTest VB, and DexterVB
|
||||
sample applications.
|
||||
|
||||
- To save the slide show as an AVI file, click Write AVI.
|
||||
|
||||
|
||||
For more information about this sample, see the SlideShowVB.DOC documentation
|
||||
in the resources\doc subdirectory. This documentation contains screenshots
|
||||
that demonstrate how to create a simple slideshow.
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -0,0 +1,411 @@
|
||||
Attribute VB_Name = "modGeneral"
|
||||
'*******************************************************************************
|
||||
'* This is a part of the Microsoft DXSDK 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.
|
||||
'* See these sources for detailed information regarding the
|
||||
'* Microsoft samples programs.
|
||||
'*******************************************************************************
|
||||
Option Explicit
|
||||
Option Base 0
|
||||
Option Compare Text
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PUBLIC INTERFACE- WIN32 API CONSTANTS
|
||||
' *
|
||||
' *
|
||||
Public Const FO_COPY = &H2
|
||||
Public Const FO_DELETE = &H3
|
||||
Public Const FO_MOVE = &H1
|
||||
Public Const FO_RENAME = &H4
|
||||
Public Const FOF_ALLOWUNDO = &H40
|
||||
Public Const FOF_CONFIRMMOUSE = &H2
|
||||
Public Const FOF_FILESONLY = &H80 ''"" on *.*, do only files
|
||||
Public Const FOF_MULTIDESTFILES = &H1
|
||||
Public Const FOF_NOCONFIRMATION = &H10 ''"" Don't prompt the user.
|
||||
Public Const FOF_NOCONFIRMMKDIR = &H200 ''"" don't confirm making any needed dirs
|
||||
Public Const FOF_NOCOPYSECURITYATTRIBS = &H800 ''"" dont copy NT file Security Attributes
|
||||
Public Const FOF_NOERRORUI = &H400 ''"" don't put up error UI
|
||||
Public Const FOF_NORECURSION = &H1000 ''"" don't recurse into directories.
|
||||
Public Const FOF_NO_CONNECTED_ELEMENTS = &H2000 ''"" don't operate on connected file elements.
|
||||
Public Const FOF_RENAMEONCOLLISION = &H8
|
||||
Public Const FOF_SILENT = &H4 ''"" don't create progress"report
|
||||
Public Const FOF_SIMPLEPROGRESS = &H100 ''"" means don't show names of files
|
||||
Public Const FOF_WANTMAPPINGHANDLE = &H20 ''"" Fill in SHFILEOPSTRUCT.hNameMappings
|
||||
Private Const MAX_PATH As Long = 255
|
||||
Private Const INVALID_HANDLE_VALUE = -1
|
||||
Private Const SEM_FAILCRITICALERRORS = &H1
|
||||
Private Const SEM_NOOPENFILEERRORBOX = &H8000
|
||||
Private Const SEE_MASK_CLASSKEY = &H3
|
||||
Private Const SEE_MASK_CLASSNAME = &H1
|
||||
Private Const SEE_MASK_CONNECTNETDRV = &H80
|
||||
Private Const SEE_MASK_DOENVSUBST = &H200
|
||||
Private Const SEE_MASK_FLAG_DDEWAIT = &H100
|
||||
Private Const SEE_MASK_FLAG_NO_UI = &H400
|
||||
Private Const SEE_MASK_HOTKEY = &H20
|
||||
Private Const SEE_MASK_ICON = &H10
|
||||
Private Const SEE_MASK_IDLIST = &H4
|
||||
Private Const SEE_MASK_INVOKEIDLIST = &HC
|
||||
Private Const SEE_MASK_NOCLOSEPROCESS = &H40
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PUBLIC INTERFACE- WIN32 API DATA STRUCTURES
|
||||
' *
|
||||
' *
|
||||
Private Type FILETIME
|
||||
dwLowDateTime As Long
|
||||
dwHighDateTime As Long
|
||||
End Type
|
||||
|
||||
Public Type WIN32_FIND_DATA
|
||||
dwFileAttributes As Long
|
||||
ftCreationTime As FILETIME
|
||||
ftLastAccessTime As FILETIME
|
||||
ftLastWriteTime As FILETIME
|
||||
nFileSizeHigh As Long
|
||||
nFileSizeLow As Long
|
||||
dwReserved0 As Long
|
||||
dwReserved1 As Long
|
||||
cFileName As String * MAX_PATH
|
||||
cAlternate As String * 14
|
||||
End Type
|
||||
|
||||
Private Type SHFILEOPSTRUCT
|
||||
hWnd As Long
|
||||
wFunc As Long
|
||||
pFrom As String
|
||||
pTo As String
|
||||
fFlags As Integer
|
||||
fAnyOperationsAborted As Long
|
||||
hNameMappings As Long
|
||||
lpszProgressTitle As String ' only used if FOF_SIMPLEPROGRESS
|
||||
End Type
|
||||
|
||||
Private Type SHELLEXECUTEINFO
|
||||
cbSize As Long
|
||||
fMask As Long
|
||||
hWnd As Long
|
||||
lpVerb As String
|
||||
lpFile As String
|
||||
lpParameters As String
|
||||
lpDirectory As String
|
||||
nShow As Long
|
||||
hInstApp As Long
|
||||
' Optional fields
|
||||
lpIdList As Long
|
||||
lpClass As String
|
||||
hkeyClass As Long
|
||||
dwHotKey As Long
|
||||
hIcon As Long
|
||||
hProcess As Long
|
||||
End Type
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PUBLIC INTERFACE- WIN32 API DECLARATIONS
|
||||
' *
|
||||
' *
|
||||
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
|
||||
Private Declare Function SetErrorMode Lib "kernel32" (ByVal wMode As Long) As Long
|
||||
Private Declare Function ShellExecuteEx Lib "shell32" (lpExecInfo As SHELLEXECUTEINFO) As Long
|
||||
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
|
||||
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
|
||||
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PUBLIC INTERFACE- DEXTER PROCEDURES
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: GetPinInfo
|
||||
' * procedure description: Returns an IPinInfo interface given a filtergraph manager and IPin object.
|
||||
' * The derived IPinInfo interface can be utilized for gaining information on the elected pin.
|
||||
' ******************************************************************************************************************************
|
||||
Public Function GetPinInfo(objFilterGraphManager As FilgraphManager, objPin As IPin) As IPinInfo
|
||||
Dim objPin2 As IPin
|
||||
Dim objPinInfo As IPinInfo
|
||||
Dim objFilterInfo As IFilterInfo
|
||||
Dim objPinCollection As Object
|
||||
Dim objlFilterCollection As Object
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'derive a filter collection from the filtergraph manager
|
||||
Set objlFilterCollection = objFilterGraphManager.FilterCollection
|
||||
|
||||
'enumerate through the filter(s) in the collection
|
||||
For Each objFilterInfo In objlFilterCollection
|
||||
Set objPinCollection = objFilterInfo.Pins
|
||||
For Each objPinInfo In objPinCollection
|
||||
Set objPin2 = objPinInfo.Pin
|
||||
If objPin2 Is objPin Then
|
||||
Set GetPinInfo = objPinInfo
|
||||
Exit Function
|
||||
End If
|
||||
Next
|
||||
Next
|
||||
|
||||
'clean-up & dereference
|
||||
If Not objPin2 Is Nothing Then Set objPin2 = Nothing
|
||||
If Not objPinInfo Is Nothing Then Set objPinInfo = Nothing
|
||||
If Not objFilterInfo Is Nothing Then Set objFilterInfo = Nothing
|
||||
If Not objPinCollection Is Nothing Then Set objPinCollection = Nothing
|
||||
If Not objlFilterCollection Is Nothing Then Set objlFilterCollection = Nothing
|
||||
Exit Function
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Function
|
||||
End Function
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: AddFileWriterAndMux
|
||||
' * procedure description: Appends a filewriter and mux filter to the given filtergraph.
|
||||
' * The FileName as required for the filewriter and evaluates to the output file destination.
|
||||
' ******************************************************************************************************************************
|
||||
Public Sub AddFileWriterAndMux(objFilterGraphManager As FilgraphManager, bstrFileName As String)
|
||||
Dim objFilterInfo As IFilterInfo
|
||||
Dim objRegisteredFilters As Object
|
||||
Dim objAVIMuxFilterInfo As IFilterInfo
|
||||
Dim objRegFilterInfo As IRegFilterInfo
|
||||
Dim objFileSinkFilterVB As IFileSinkFilterForVB
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'derive a collection of registered filters from the filtergraph manager
|
||||
Set objRegisteredFilters = objFilterGraphManager.RegFilterCollection
|
||||
|
||||
'enumerate through the registered filters
|
||||
For Each objRegFilterInfo In objRegisteredFilters
|
||||
If Trim(LCase(objRegFilterInfo.Name)) = "file writer" Then
|
||||
objRegFilterInfo.Filter objFilterInfo
|
||||
ElseIf Trim(LCase(objRegFilterInfo.Name)) = "avi mux" Then
|
||||
objRegFilterInfo.Filter objAVIMuxFilterInfo
|
||||
End If
|
||||
Next
|
||||
|
||||
'derive the file sink filter tailored for vb
|
||||
Set objFileSinkFilterVB = objFilterInfo.Filter
|
||||
'assign the filename to the sink filter
|
||||
Call objFileSinkFilterVB.SetFileName(bstrFileName, Nothing)
|
||||
|
||||
'clean-up & dereference
|
||||
If Not objFilterInfo Is Nothing Then Set objFilterInfo = Nothing
|
||||
If Not objRegFilterInfo Is Nothing Then Set objRegFilterInfo = Nothing
|
||||
If Not objFileSinkFilterVB Is Nothing Then Set objFileSinkFilterVB = Nothing
|
||||
If Not objAVIMuxFilterInfo Is Nothing Then Set objAVIMuxFilterInfo = Nothing
|
||||
If Not objRegisteredFilters Is Nothing Then Set objRegisteredFilters = Nothing
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: RenderGroupPins
|
||||
' * procedure description: Renders the Pins out for the given timeline using the given render engine.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Sub RenderGroupPins(objRenderEngine As RenderEngine, objTimeline As AMTimeline)
|
||||
Dim objPin As IPin
|
||||
Dim nCount As Long
|
||||
Dim nGroupCount As Long
|
||||
Dim objPinInfo As IPinInfo
|
||||
Dim objFilterGraphManager As FilgraphManager
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
If Not objTimeline Is Nothing Then
|
||||
If Not objRenderEngine Is Nothing Then
|
||||
'obtain the group count
|
||||
objTimeline.GetGroupCount nGroupCount
|
||||
'exit the procedure if there are no group(s)
|
||||
If nGroupCount = 0 Then Exit Sub
|
||||
'obtain the filtergraph
|
||||
objRenderEngine.GetFilterGraph objFilterGraphManager
|
||||
'enumerate through the groups & render the pins
|
||||
For nCount = 0 To nGroupCount - 1
|
||||
objRenderEngine.GetGroupOutputPin nCount, objPin
|
||||
If Not objPin Is Nothing Then
|
||||
Set objPinInfo = GetPinInfo(objFilterGraphManager, objPin)
|
||||
If Not objPinInfo Is Nothing Then
|
||||
Call objPinInfo.Render
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
End If
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Resume Next
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PUBLIC INTERFACE- GENERAL PROCEDURES
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Buffer_ParseEx
|
||||
' * procedure description: Parse's a fixed length string buffer of all vbNullCharacters AND vbNullStrings.
|
||||
' * Argument bstrBuffer evaluates to either an ANSII or Unicode BSTR string buffer.
|
||||
' * (bstrBuffer is almost always the output from a windows api call which needs parsed)
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Function Buffer_ParseEx(bstrBuffer As String) As String
|
||||
Dim iCount As Long, bstrChar As String, bstrReturn As String
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
For iCount = 1 To Len(bstrBuffer) 'set up a loop to remove the vbNullChar's from the buffer.
|
||||
bstrChar = Strings.Mid(bstrBuffer, iCount, 1)
|
||||
If bstrChar <> vbNullChar And bstrChar <> vbNullString Then bstrReturn = (bstrReturn + bstrChar)
|
||||
Next
|
||||
Buffer_ParseEx = bstrReturn
|
||||
Exit Function
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Function
|
||||
End Function
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: GetTempDirectory
|
||||
' * procedure description: Returns a bstr String representing the fully qualified path to the system's temp directory
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Function GetTempDirectory() As String
|
||||
Dim bstrBuffer As String * MAX_PATH
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'call the win32api
|
||||
Call GetTempPath(MAX_PATH, bstrBuffer)
|
||||
'parse & return the value to the client
|
||||
GetTempDirectory = Buffer_ParseEx(bstrBuffer)
|
||||
Exit Function
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Function
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: File_Exists
|
||||
' * procedure description: Returns true if the specified file does in fact exist.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Function File_Exists(bstrFileName As String) As Boolean
|
||||
Dim WFD As WIN32_FIND_DATA, hFile As Long
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
hFile = FindFirstFile(bstrFileName, WFD)
|
||||
File_Exists = hFile <> INVALID_HANDLE_VALUE
|
||||
Call FindClose(hFile)
|
||||
Exit Function
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Function
|
||||
End Function
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: File_Delete
|
||||
' * procedure description: This will delete a File. Pass any of the specified optionals to invoke those particular features.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Function File_Delete(bstrFileName As String, Optional SendToRecycleBin As Boolean = True, Optional Confirm As Boolean = True, Optional ShowProgress As Boolean = True) As Long
|
||||
Dim fileop As SHFILEOPSTRUCT
|
||||
Dim WFD As WIN32_FIND_DATA, hFile As Long
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'check argument
|
||||
If Right(bstrFileName, 1) = "\" Then bstrFileName = Left(bstrFileName, (Len(bstrFileName) - 1))
|
||||
'ensure the file exists
|
||||
hFile = FindFirstFile(bstrFileName, WFD)
|
||||
If hFile = INVALID_HANDLE_VALUE Then
|
||||
Call FindClose(hFile)
|
||||
Exit Function
|
||||
Else: Call FindClose(hFile)
|
||||
End If
|
||||
'set the error mode
|
||||
Call SetErrorMode(SEM_NOOPENFILEERRORBOX + SEM_FAILCRITICALERRORS)
|
||||
'set up the file operation by the specified optionals
|
||||
With fileop
|
||||
.hWnd = 0: .wFunc = FO_DELETE
|
||||
.pFrom = UCase(bstrFileName) & vbNullChar & vbNullChar
|
||||
If SendToRecycleBin Then 'goes to recycle bin
|
||||
.fFlags = FOF_ALLOWUNDO
|
||||
If Confirm = False Then .fFlags = .fFlags + FOF_NOCONFIRMATION 'do not confirm
|
||||
If ShowProgress = False Then .fFlags = .fFlags + FOF_SILENT 'do not show progress
|
||||
Else 'just delete the file
|
||||
If Confirm = False Then .fFlags = .fFlags + FOF_NOCONFIRMATION 'do not confirm
|
||||
If ShowProgress = False Then .fFlags = .fFlags + FOF_SILENT 'do not show progress
|
||||
End If
|
||||
End With
|
||||
'execute the file operation, return any errors..
|
||||
File_Delete = SHFileOperation(fileop)
|
||||
Exit Function
|
||||
|
||||
ErrLine:
|
||||
File_Delete = Err.Number 'if there was a abend in the procedure, return that too..
|
||||
Err.Clear
|
||||
Exit Function
|
||||
End Function
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: File_Execute
|
||||
' * procedure description: Executes a file using it's default shell command and returns a handle to the new process.
|
||||
' * Function returns zero if the operation fails. Never displays any error dialogs for the user.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Public Function File_Execute(bstrDirectory As String, bstrFile As String, Optional bstrArguments As String, Optional Show As Long = 1) As Long
|
||||
Dim ExecInfo As SHELLEXECUTEINFO
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'verify argument(s)
|
||||
If Len(bstrDirectory) > 0 Then
|
||||
If Right(bstrDirectory, 1) = "\" Then
|
||||
bstrDirectory = Trim(LCase(Mid(bstrDirectory, 1, Len(bstrDirectory) - 1)))
|
||||
End If
|
||||
ElseIf Len(bstrFile) > 0 Then
|
||||
If Right(bstrFile, 1) = "\" Then
|
||||
bstrFile = Trim(LCase(Mid(bstrFile, 1, Len(bstrFile) - 1)))
|
||||
End If
|
||||
End If
|
||||
|
||||
'fill data struct
|
||||
With ExecInfo
|
||||
.nShow = 1
|
||||
.cbSize = Len(ExecInfo)
|
||||
.lpFile = bstrFile
|
||||
.lpDirectory = bstrDirectory
|
||||
.lpParameters = bstrArguments
|
||||
.fMask = SEE_MASK_FLAG_NO_UI + SEE_MASK_DOENVSUBST + SEE_MASK_NOCLOSEPROCESS '+ CREATE_NEW_CONSOLE
|
||||
End With
|
||||
|
||||
'execute the application
|
||||
Call ShellExecuteEx(ExecInfo)
|
||||
'return the process id to the client
|
||||
File_Execute = ExecInfo.hProcess
|
||||
Exit Function
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Function
|
||||
End Function
|
||||
@@ -0,0 +1,42 @@
|
||||
DirectShow Sample -- TrimmerVB
|
||||
------------------------------
|
||||
|
||||
Description
|
||||
|
||||
Microsoft Visual Basic application that trims a source clip and
|
||||
writes the trimmed clip to a new file using "smart recompression".
|
||||
|
||||
This example demonstrates:
|
||||
|
||||
- Using the MediaDet to grab poster frames from a file
|
||||
|
||||
- Quickly creating a timeline and using smart recompression to write a file
|
||||
|
||||
|
||||
User's Guide
|
||||
|
||||
This application enables the user to open a video source file,
|
||||
trim a desired amount from the front and the end of the clip,
|
||||
and then save the remaining portion to a new file.
|
||||
|
||||
To use this application, do the following:
|
||||
|
||||
- To choose a source file, click the Browse button.
|
||||
The first frame of the clip appears in all three preview areas.
|
||||
|
||||
- To select the start position, move the slider or click the frame step
|
||||
buttons. The preview frame in the Current Video Frame area is updated.
|
||||
|
||||
- To set the start position, click the Set Trim Preview Start Position button.
|
||||
The poster frame in Video Start Frame area is updated.
|
||||
|
||||
- To select the stop position, move the slider or click the frame step buttons.
|
||||
|
||||
- To set the stop position, click the Set Trim Preview Stop Position button.
|
||||
The poster frame in the Video Stop Frame area is updated.
|
||||
The stop position must be greater than the start position.
|
||||
|
||||
- To write the new file, click the Write button.
|
||||
Wait for the progress indicator to complete.
|
||||
|
||||
- To view the new file, click the Playback button.
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 766 B |
@@ -0,0 +1,42 @@
|
||||
DirectShow Sample -- TrimmerVB
|
||||
------------------------------
|
||||
|
||||
Description
|
||||
|
||||
Microsoft Visual Basic application that trims a source clip and
|
||||
writes the trimmed clip to a new file using "smart recompression".
|
||||
|
||||
This example demonstrates:
|
||||
|
||||
- Using the MediaDet to grab poster frames from a file
|
||||
|
||||
- Quickly creating a timeline and using smart recompression to write a file
|
||||
|
||||
|
||||
User's Guide
|
||||
|
||||
This application enables the user to open a video source file,
|
||||
trim a desired amount from the front and the end of the clip,
|
||||
and then save the remaining portion to a new file.
|
||||
|
||||
To use this application, do the following:
|
||||
|
||||
- To choose a source file, click the Browse button.
|
||||
The first frame of the clip appears in all three preview areas.
|
||||
|
||||
- To select the start position, move the slider or click the frame step
|
||||
buttons. The preview frame in the Current Video Frame area is updated.
|
||||
|
||||
- To set the start position, click the Set Trim Preview Start Position button.
|
||||
The poster frame in Video Start Frame area is updated.
|
||||
|
||||
- To select the stop position, move the slider or click the frame step buttons.
|
||||
|
||||
- To set the stop position, click the Set Trim Preview Stop Position button.
|
||||
The poster frame in the Video Stop Frame area is updated.
|
||||
The stop position must be greater than the start position.
|
||||
|
||||
- To write the new file, click the Write button.
|
||||
Wait for the progress indicator to complete.
|
||||
|
||||
- To view the new file, click the Playback button.
|
||||
@@ -0,0 +1,49 @@
|
||||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#c:\WINNT\System32\stdole2.tlb#OLE Automation
|
||||
Reference=*\G{78530B68-61F9-11D2-8CAD-00A024580902}#1.0#0#c:\WINNT\System32\qedit.dll#Dexter 1.0 Type Library
|
||||
Reference=*\G{56A868B0-0AD4-11CE-B03A-0020AF0BA770}#1.0#0#c:\WINNT\System32\quartz.dll#ActiveMovie control type library
|
||||
Reference=*\G{3D4B7DCD-B4FB-4469-ACD2-990F371F8460}#1.0#0#..\DShowVBLib\DshowVBLib.tlb#DshowForVBLib
|
||||
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; comdlg32.ocx
|
||||
Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; MSCOMCTL.OCX
|
||||
Form=frmMain.frm
|
||||
Module=modGeneral; modGeneral.bas
|
||||
RelatedDoc=resources\txt\readme.txt
|
||||
IconForm="frmMain"
|
||||
Startup="frmMain"
|
||||
HelpFile=""
|
||||
Title="Trimmer"
|
||||
ExeName32="VB_Trimmer.exe"
|
||||
Path32=""
|
||||
Command32=""
|
||||
Name="TrimmerVB"
|
||||
HelpContextID="0"
|
||||
Description="Microsoft Directshow Editing Services TrimmerVB Sample Application"
|
||||
CompatibleMode="0"
|
||||
MajorVer=8
|
||||
MinorVer=1
|
||||
RevisionVer=36
|
||||
AutoIncrementVer=1
|
||||
ServerSupportFiles=0
|
||||
VersionCompanyName="Microsoft Corporation"
|
||||
VersionFileDescription="Microsoft Directshow Editing Services TrimmerVB Sample Application"
|
||||
VersionLegalCopyright="Copyright (C) 1999-2001 Microsoft Corporation."
|
||||
VersionProductName="TrimmerVB"
|
||||
CompilationType=0
|
||||
OptimizationType=0
|
||||
FavorPentiumPro(tm)=0
|
||||
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
|
||||
@@ -0,0 +1,2 @@
|
||||
frmMain = 131, 176, 1146, 836, , 19, 19, 796, 524, C
|
||||
modGeneral = 157, 215, 1174, 870, C
|
||||
@@ -0,0 +1,45 @@
|
||||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINNT\System32\stdole2.tlb#OLE Automation
|
||||
Reference=*\G{78530B68-61F9-11D2-8CAD-00A024580902}#1.0#0#C:\WINNT\System32\qedit.dll#Dexter 1.0 Type Library
|
||||
Reference=*\G{56A868B0-0AD4-11CE-B03A-0020AF0BA770}#1.0#0#C:\WINNT\System32\quartz.dll#ActiveMovie control type library
|
||||
Form=frmMain.frm
|
||||
RelatedDoc=resources\txt\readme.txt
|
||||
IconForm="frmMain"
|
||||
Startup="frmMain"
|
||||
HelpFile=""
|
||||
Title="XtlTest"
|
||||
ExeName32="VB_XTLTest.exe"
|
||||
Path32=""
|
||||
Command32=""
|
||||
Name="XTLTestVB"
|
||||
HelpContextID="0"
|
||||
Description="Microsoft Directshow Editing Services XTLTestVB Sample Application"
|
||||
CompatibleMode="0"
|
||||
MajorVer=8
|
||||
MinorVer=1
|
||||
RevisionVer=19
|
||||
AutoIncrementVer=1
|
||||
ServerSupportFiles=0
|
||||
VersionCompanyName="Microsoft Corporation"
|
||||
VersionFileDescription="Microsoft Directshow Editing Services XTLTestVB Sample Application"
|
||||
VersionLegalCopyright="Copyright (C) 1999-2001 Microsoft Corporation."
|
||||
VersionProductName="XTLTestVB"
|
||||
CompilationType=0
|
||||
OptimizationType=0
|
||||
FavorPentiumPro(tm)=0
|
||||
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
|
||||
@@ -0,0 +1 @@
|
||||
frmMain = 180, 215, 1128, 893, C, 0, 0, 0, 0, C
|
||||
@@ -0,0 +1,443 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form frmMain
|
||||
BorderStyle = 1 'Fixed Single
|
||||
Caption = "XtlTest"
|
||||
ClientHeight = 1140
|
||||
ClientLeft = 60
|
||||
ClientTop = 345
|
||||
ClientWidth = 4470
|
||||
Icon = "frmMain.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
LockControls = -1 'True
|
||||
MaxButton = 0 'False
|
||||
ScaleHeight = 1140
|
||||
ScaleWidth = 4470
|
||||
StartUpPosition = 2 'CenterScreen
|
||||
Begin VB.CheckBox ChkDynamic
|
||||
Caption = "Dynamic Sources"
|
||||
Height = 255
|
||||
Left = 960
|
||||
TabIndex = 4
|
||||
Top = 720
|
||||
Value = 1 'Checked
|
||||
Width = 1935
|
||||
End
|
||||
Begin VB.CommandButton CmdReplay
|
||||
Caption = "&Replay"
|
||||
Enabled = 0 'False
|
||||
Height = 375
|
||||
Left = 120
|
||||
TabIndex = 2
|
||||
Top = 720
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.Timer tmrTimer
|
||||
Interval = 1000
|
||||
Left = 3900
|
||||
Top = 675
|
||||
End
|
||||
Begin VB.PictureBox picDropBox
|
||||
BackColor = &H00FFFFFF&
|
||||
Height = 495
|
||||
Left = 120
|
||||
OLEDropMode = 1 'Manual
|
||||
ScaleHeight = 435
|
||||
ScaleWidth = 4155
|
||||
TabIndex = 0
|
||||
Top = 120
|
||||
Width = 4215
|
||||
Begin VB.Label lblDragAndDrop
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Drag and Drop an XTL file in the box."
|
||||
Enabled = 0 'False
|
||||
Height = 255
|
||||
Left = 720
|
||||
TabIndex = 3
|
||||
Top = 120
|
||||
Width = 2775
|
||||
End
|
||||
Begin VB.Label lbPlaying
|
||||
Alignment = 2 'Center
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "P L A Y I N G"
|
||||
Enabled = 0 'False
|
||||
BeginProperty Font
|
||||
Name = "Comic Sans MS"
|
||||
Size = 9.75
|
||||
Charset = 0
|
||||
Weight = 700
|
||||
Underline = 0 'False
|
||||
Italic = 0 'False
|
||||
Strikethrough = 0 'False
|
||||
EndProperty
|
||||
Height = 255
|
||||
Left = 720
|
||||
TabIndex = 1
|
||||
Top = 120
|
||||
Visible = 0 'False
|
||||
Width = 2655
|
||||
End
|
||||
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 DXSDK 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.
|
||||
'* See these sources for detailed information regarding the
|
||||
'* Microsoft samples programs.
|
||||
'*******************************************************************************
|
||||
Option Explicit
|
||||
Option Base 0
|
||||
Option Compare Text
|
||||
|
||||
Private m_objTimeline As AMTimeline
|
||||
Private m_objMediaEvent As IMediaEvent
|
||||
Private m_objRenderEngine As RenderEngine
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- FORM EVENTS
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Form_Terminate
|
||||
' * procedure description: Occurs when all references to an instance of a Form, MDIForm, or class are removed from memory.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Form_Terminate()
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'ensure timer disabled
|
||||
tmrTimer.Enabled = False
|
||||
|
||||
'clean-up & dereference
|
||||
Call ClearTimeline(m_objTimeline)
|
||||
If Not m_objMediaEvent Is Nothing Then Set m_objMediaEvent = Nothing
|
||||
If Not m_objRenderEngine Is Nothing Then Set m_objRenderEngine = Nothing
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- CONTROL EVENTS
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: ChkDynamic_Click
|
||||
' * procedure description: Occurs when the 'Dynamic' checkbox is elected by the user.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub ChkDynamic_Click()
|
||||
On Local Error GoTo ErrLine
|
||||
Call SetDynamicLevel(m_objRenderEngine)
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: CmdReplay_Click
|
||||
' * procedure description: Occurs when the 'Replay' command button is clicked by the user.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub CmdReplay_Click()
|
||||
Dim objVideoWindow As IVideoWindow
|
||||
Dim objMediaPosition As IMediaPosition
|
||||
Dim objFilterGraphManager As FilgraphManager
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
' if there's no render engine, there's nothing to replay
|
||||
If m_objRenderEngine Is Nothing Then Exit Sub
|
||||
|
||||
' ask for the graph, so we can control it
|
||||
Call m_objRenderEngine.GetFilterGraph(objFilterGraphManager)
|
||||
|
||||
'if we have a valid instance of a filtergraph, run the graph
|
||||
If Not objFilterGraphManager Is Nothing Then
|
||||
Call objFilterGraphManager.Stop
|
||||
Set objMediaPosition = objFilterGraphManager
|
||||
If Not objMediaPosition Is Nothing Then objMediaPosition.CurrentPosition = 0
|
||||
Call objFilterGraphManager.Run
|
||||
Set m_objMediaEvent = objFilterGraphManager
|
||||
End If
|
||||
|
||||
'set the UI state
|
||||
lbPlaying.Visible = True
|
||||
tmrTimer.Enabled = True
|
||||
lblDragAndDrop.Visible = False
|
||||
picDropBox.BackColor = &HFF
|
||||
|
||||
If Not objFilterGraphManager Is Nothing Then
|
||||
'derive an interface for the video window
|
||||
Set objVideoWindow = objFilterGraphManager
|
||||
If Not objVideoWindow Is Nothing Then
|
||||
objVideoWindow.Visible = True
|
||||
objVideoWindow.Left = 0
|
||||
objVideoWindow.Top = 0
|
||||
End If
|
||||
End If
|
||||
|
||||
'clean-up & dereference
|
||||
If Not objVideoWindow Is Nothing Then Set objVideoWindow = Nothing
|
||||
If Not objMediaPosition Is Nothing Then Set objMediaPosition = Nothing
|
||||
If Not objFilterGraphManager Is Nothing Then Set objFilterGraphManager = Nothing
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: picDropBox_OLEDragDrop
|
||||
' * procedure description: Occurs when data is dropped onto the control via an OLE drag/drop operation,
|
||||
' * and OLEDropMode is set to manual.
|
||||
' * Here we dropped an XTL file on the timeline, so create a timeline, a render engine,
|
||||
' * an XML parser, and load them all up
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub picDropBox_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
|
||||
Dim nCount As Long
|
||||
Dim bstrFileName As String
|
||||
Dim objXMLParser As New Xml2Dex
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'ensure that among the files being dragged is an xtl file..
|
||||
For nCount = 1 To Data.Files.Count
|
||||
If Len(Data.Files.Item(nCount)) > 4 Then
|
||||
If LCase(Right(Data.Files.Item(nCount), 4)) = ".xtl" Then
|
||||
Effect = vbDropEffectCopy
|
||||
bstrFileName = Data.Files(nCount)
|
||||
Exit For
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
'otherwise do not allow the drag operation to continue
|
||||
If bstrFileName = vbNullString Then
|
||||
Effect = vbDropEffectNone: Exit Sub
|
||||
End If
|
||||
|
||||
'ensure timer is disabled
|
||||
tmrTimer.Enabled = False
|
||||
|
||||
'clean-up & dereference
|
||||
Call ClearTimeline(m_objTimeline)
|
||||
If Not m_objMediaEvent Is Nothing Then Set m_objMediaEvent = Nothing
|
||||
If Not m_objRenderEngine Is Nothing Then Set m_objRenderEngine = Nothing
|
||||
|
||||
|
||||
'reinstantiate the timeline & render engine
|
||||
Set m_objTimeline = New AMTimeline
|
||||
Set m_objRenderEngine = New RenderEngine
|
||||
|
||||
'Set the dynamic level on or off
|
||||
Call SetDynamicLevel(m_objRenderEngine)
|
||||
|
||||
'read in the file
|
||||
Call objXMLParser.ReadXMLFile(m_objTimeline, bstrFileName)
|
||||
|
||||
' make sure all the sources exist where they should
|
||||
' the 27 is a combination of flags from qedit.idl (c/c++ stuff)
|
||||
m_objTimeline.ValidateSourceNames 27, Nothing, vbNull
|
||||
|
||||
'set the timeline
|
||||
m_objRenderEngine.SetTimelineObject m_objTimeline
|
||||
|
||||
'connect the front
|
||||
m_objRenderEngine.ConnectFrontEnd
|
||||
|
||||
'render the output pins (e.g. 'backend')
|
||||
m_objRenderEngine.RenderOutputPins
|
||||
|
||||
'set the caption on the form & enable replay there after
|
||||
frmMain.CmdReplay.Enabled = True
|
||||
frmMain.Caption = "XtlTest -" + bstrFileName
|
||||
|
||||
'replay the timeline
|
||||
Call CmdReplay_Click
|
||||
|
||||
'clean-up & dereference
|
||||
If Not objXMLParser Is Nothing Then Set objXMLParser = Nothing
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: picDropBox_OLEDragOver
|
||||
' * procedure description: Occurs when the mouse is moved over the control during an OLE drag/drop operation, if its OLEDropMode property is set to manual.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub picDropBox_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
|
||||
Dim nCount As Long
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'ensure that among the files being dragged is an xtl file..
|
||||
For nCount = 1 To Data.Files.Count
|
||||
If Len(Data.Files.Item(nCount)) > 4 Then
|
||||
If LCase(Right(Data.Files.Item(nCount), 4)) = ".xtl" Then
|
||||
Effect = vbDropEffectCopy
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
|
||||
'otherwise do not allow the drag operation to continue
|
||||
Effect = vbDropEffectNone
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: picDropBox_OLEGiveFeedback
|
||||
' * procedure description: Occurs at the source control of an OLE drag/drop operation when the mouse cursor needs to be changed.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub picDropBox_OLEGiveFeedback(Effect As Long, DefaultCursors As Boolean)
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'setup the ole drop effect
|
||||
Effect = vbDropEffectCopy
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: tmrTimer_Timer
|
||||
' * procedure description: Occurs when a preset interval for a Timer control has elapsed.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub tmrTimer_Timer()
|
||||
Dim nResultant As Long
|
||||
Dim objVideoWindow As IVideoWindow
|
||||
Dim objMediaPosition As IMediaPosition
|
||||
Dim objFilterGraphManager As FilgraphManager
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
|
||||
If Not m_objMediaEvent Is Nothing Then
|
||||
'wait 10 ms to see if it's running or not
|
||||
Call m_objMediaEvent.WaitForCompletion(10, nResultant)
|
||||
|
||||
'derive an instance of the video window
|
||||
Set objVideoWindow = m_objMediaEvent
|
||||
|
||||
If objVideoWindow.Visible = False Then
|
||||
'the user closed the video window, hault playback
|
||||
If Not m_objRenderEngine Is Nothing Then
|
||||
Call m_objRenderEngine.GetFilterGraph(objFilterGraphManager)
|
||||
End If
|
||||
'the end of the media has been reached
|
||||
lbPlaying.Visible = False
|
||||
lblDragAndDrop.Visible = True
|
||||
objVideoWindow.Visible = False
|
||||
picDropBox.BackColor = &HFFFFFF
|
||||
|
||||
'if we have a valid instance of a filtergraph, run the graph
|
||||
If Not objFilterGraphManager Is Nothing Then
|
||||
Call objFilterGraphManager.Stop
|
||||
Set objMediaPosition = objFilterGraphManager
|
||||
If Not objMediaPosition Is Nothing Then objMediaPosition.CurrentPosition = 0
|
||||
Set m_objMediaEvent = objFilterGraphManager
|
||||
End If
|
||||
|
||||
ElseIf nResultant <> 1 Then ' 1 = EC_COMPLETE
|
||||
'the end of the media has not been reached, exit
|
||||
Exit Sub
|
||||
Else
|
||||
'the end of the media has been reached
|
||||
lbPlaying.Visible = False
|
||||
lblDragAndDrop.Visible = True
|
||||
objVideoWindow.Visible = False
|
||||
picDropBox.BackColor = &HFFFFFF
|
||||
End If
|
||||
End If
|
||||
|
||||
'clean-up & dereference
|
||||
If Not objVideoWindow Is Nothing Then Set objVideoWindow = Nothing
|
||||
If Not objMediaPosition Is Nothing Then Set objMediaPosition = Nothing
|
||||
If Not objFilterGraphManager Is Nothing Then Set objFilterGraphManager = Nothing
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- PROCEDURES
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: ClearTimeline
|
||||
' * procedure description: Clear everything out so we can start over or exit
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub ClearTimeline(objTimeline As AMTimeline)
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
' we need to call this manually, since groups
|
||||
' themselves can have a circular reference back to the timeline
|
||||
If Not objTimeline Is Nothing Then
|
||||
Call objTimeline.ClearAllGroups: Set objTimeline = Nothing
|
||||
End If
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: SetDynamicLevel
|
||||
' * procedure description: we can either make the sources load before the project runs, or let them load when needed.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub SetDynamicLevel(objRenderEngine As RenderEngine)
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'proceed to set the dynamic reconnection level on the given render engine
|
||||
If Not objRenderEngine Is Nothing Then
|
||||
If ChkDynamic.Value Then
|
||||
objRenderEngine.SetDynamicReconnectLevel 1
|
||||
Else: objRenderEngine.SetDynamicReconnectLevel 0
|
||||
End If
|
||||
End If
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
Binary file not shown.
@@ -0,0 +1,13 @@
|
||||
DirectShow Sample -- XTLTestVB
|
||||
------------------------------
|
||||
|
||||
Microsoft Visual Basic application that previews video editing project files.
|
||||
This is a Visual Basic version of the XTLTest C++ sample, but with
|
||||
limited functionality. It demonstrates how to quickly read an XTL file,
|
||||
create a render engine, and start playing the resultant DirectShow graph
|
||||
based on the XTL file.
|
||||
|
||||
To use this application, drag a Microsoft DirectShow Editing Services XTL file
|
||||
onto the application window. You can use this sample as a quick and easy
|
||||
player for your XTL files.
|
||||
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 766 B |
@@ -0,0 +1,13 @@
|
||||
DirectShow Sample -- XTLTestVB
|
||||
------------------------------
|
||||
|
||||
Microsoft Visual Basic application that previews video editing project files.
|
||||
This is a Visual Basic version of the XTLTest C++ sample, but with
|
||||
limited functionality. It demonstrates how to quickly read an XTL file,
|
||||
create a render engine, and start playing the resultant DirectShow graph
|
||||
based on the XTL file.
|
||||
|
||||
To use this application, drag a Microsoft DirectShow Editing Services XTL file
|
||||
onto the application window. You can use this sample as a quick and easy
|
||||
player for your XTL files.
|
||||
|
||||
@@ -0,0 +1,12 @@
|
||||
DirectShow Sample -- VBDemo
|
||||
---------------------------
|
||||
|
||||
This is a simple media player application for Microsoft Visual Basic.
|
||||
|
||||
Open a media file from the File menu, and it will begin playing automatically.
|
||||
You can control playback speed with the radio buttons at the bottom of the form.
|
||||
While the file plays, VBDemo displays information about the media file's
|
||||
duration and current position. You may also adjust volume and balance by
|
||||
adjusting the slider controls beneath the video window.
|
||||
|
||||
Note: Adjusting playback speed of .ASF files is not supported.
|
||||
@@ -0,0 +1,804 @@
|
||||
VERSION 5.00
|
||||
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
|
||||
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
|
||||
Begin VB.Form frmMain
|
||||
BorderStyle = 1 'Fixed Single
|
||||
Caption = "DirectShow VB Sample"
|
||||
ClientHeight = 8190
|
||||
ClientLeft = 75
|
||||
ClientTop = 600
|
||||
ClientWidth = 5625
|
||||
DrawMode = 1 'Blackness
|
||||
FillStyle = 0 'Solid
|
||||
HasDC = 0 'False
|
||||
Icon = "vbdemo.frx":0000
|
||||
LinkTopic = "frmMain"
|
||||
LockControls = -1 'True
|
||||
MaxButton = 0 'False
|
||||
PaletteMode = 1 'UseZOrder
|
||||
ScaleHeight = 8190
|
||||
ScaleWidth = 5625
|
||||
Begin MSComctlLib.Toolbar tbControlBar
|
||||
Align = 1 'Align Top
|
||||
Height = 540
|
||||
Left = 0
|
||||
TabIndex = 20
|
||||
Top = 0
|
||||
Width = 5625
|
||||
_ExtentX = 9922
|
||||
_ExtentY = 953
|
||||
ButtonWidth = 820
|
||||
ButtonHeight = 794
|
||||
Appearance = 1
|
||||
ImageList = "ctrlImageList"
|
||||
_Version = 393216
|
||||
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
|
||||
NumButtons = 3
|
||||
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
|
||||
Key = "play"
|
||||
Object.ToolTipText = "Play"
|
||||
ImageIndex = 1
|
||||
EndProperty
|
||||
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
|
||||
Key = "pause"
|
||||
Object.ToolTipText = "Pause"
|
||||
ImageIndex = 2
|
||||
EndProperty
|
||||
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
|
||||
Key = "stop"
|
||||
Object.ToolTipText = "Stop"
|
||||
ImageIndex = 3
|
||||
EndProperty
|
||||
EndProperty
|
||||
End
|
||||
Begin VB.PictureBox picVideoWindow
|
||||
Appearance = 0 'Flat
|
||||
BackColor = &H00000000&
|
||||
BorderStyle = 0 'None
|
||||
DrawMode = 1 'Blackness
|
||||
FillStyle = 0 'Solid
|
||||
ForeColor = &H80000008&
|
||||
HasDC = 0 'False
|
||||
Height = 4095
|
||||
Left = 60
|
||||
MouseIcon = "vbdemo.frx":0442
|
||||
MousePointer = 99 'Custom
|
||||
ScaleHeight = 4095
|
||||
ScaleWidth = 5475
|
||||
TabIndex = 16
|
||||
Top = 660
|
||||
Width = 5475
|
||||
End
|
||||
Begin VB.Frame fraInfo
|
||||
Caption = "Information:"
|
||||
Height = 2055
|
||||
Left = 60
|
||||
TabIndex = 9
|
||||
Top = 6060
|
||||
Width = 5475
|
||||
Begin VB.OptionButton optPlaybackRate
|
||||
Caption = "Double (200%)"
|
||||
Height = 195
|
||||
Index = 2
|
||||
Left = 3900
|
||||
TabIndex = 2
|
||||
ToolTipText = "Double Speed"
|
||||
Top = 1680
|
||||
Width = 1335
|
||||
End
|
||||
Begin VB.OptionButton optPlaybackRate
|
||||
Caption = "Normal (100%)"
|
||||
Height = 195
|
||||
Index = 1
|
||||
Left = 2460
|
||||
TabIndex = 1
|
||||
ToolTipText = "Normal Speed"
|
||||
Top = 1680
|
||||
Width = 1515
|
||||
End
|
||||
Begin VB.OptionButton optPlaybackRate
|
||||
Caption = "Half (50%)"
|
||||
Height = 195
|
||||
Index = 0
|
||||
Left = 1320
|
||||
TabIndex = 0
|
||||
ToolTipText = "Half Speed"
|
||||
Top = 1680
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.TextBox txtDuration
|
||||
BackColor = &H8000000F&
|
||||
ForeColor = &H80000012&
|
||||
Height = 270
|
||||
Left = 1920
|
||||
Locked = -1 'True
|
||||
TabIndex = 12
|
||||
TabStop = 0 'False
|
||||
Top = 360
|
||||
Width = 3315
|
||||
End
|
||||
Begin VB.TextBox txtElapsed
|
||||
BackColor = &H8000000F&
|
||||
ForeColor = &H80000012&
|
||||
Height = 270
|
||||
Left = 1920
|
||||
Locked = -1 'True
|
||||
TabIndex = 11
|
||||
TabStop = 0 'False
|
||||
Top = 720
|
||||
Width = 3315
|
||||
End
|
||||
Begin VB.TextBox txtRate
|
||||
BackColor = &H8000000F&
|
||||
ForeColor = &H80000012&
|
||||
Height = 270
|
||||
Left = 1920
|
||||
Locked = -1 'True
|
||||
TabIndex = 10
|
||||
TabStop = 0 'False
|
||||
Top = 1080
|
||||
Width = 3315
|
||||
End
|
||||
Begin VB.Label lblResetSpeed
|
||||
Caption = "Reset speed:"
|
||||
Height = 255
|
||||
Left = 240
|
||||
TabIndex = 17
|
||||
Top = 1680
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.Line Line1
|
||||
X1 = 240
|
||||
X2 = 5240
|
||||
Y1 = 1500
|
||||
Y2 = 1500
|
||||
End
|
||||
Begin VB.Label lblElapsed
|
||||
Caption = "Elapsed Time:"
|
||||
Height = 255
|
||||
Left = 240
|
||||
TabIndex = 15
|
||||
ToolTipText = "Elapsed Time (Seconds)"
|
||||
Top = 720
|
||||
Width = 1575
|
||||
End
|
||||
Begin VB.Label lblRate
|
||||
Caption = "Playback speed:"
|
||||
Height = 255
|
||||
Left = 240
|
||||
TabIndex = 14
|
||||
ToolTipText = "Playback Speed (Frames Per Second)"
|
||||
Top = 1080
|
||||
Width = 1335
|
||||
End
|
||||
Begin VB.Label lblDuration
|
||||
Caption = "Length:"
|
||||
Height = 255
|
||||
Left = 240
|
||||
TabIndex = 13
|
||||
ToolTipText = "Media Length (Seconds)"
|
||||
Top = 360
|
||||
Width = 1455
|
||||
End
|
||||
End
|
||||
Begin VB.Frame frameBalance
|
||||
Caption = "Balance"
|
||||
Height = 1215
|
||||
Left = 2820
|
||||
TabIndex = 6
|
||||
Top = 4800
|
||||
Width = 2715
|
||||
Begin MSComctlLib.Slider slBalance
|
||||
Height = 495
|
||||
Left = 340
|
||||
TabIndex = 19
|
||||
Top = 300
|
||||
Width = 2000
|
||||
_ExtentX = 3519
|
||||
_ExtentY = 873
|
||||
_Version = 393216
|
||||
LargeChange = 1000
|
||||
SmallChange = 500
|
||||
Min = -5000
|
||||
Max = 5000
|
||||
TickFrequency = 1000
|
||||
End
|
||||
Begin VB.Label lblRight
|
||||
Caption = "Right"
|
||||
Height = 255
|
||||
Left = 2160
|
||||
TabIndex = 8
|
||||
Top = 840
|
||||
Width = 435
|
||||
End
|
||||
Begin VB.Label lblLeft
|
||||
Caption = "Left"
|
||||
Height = 255
|
||||
Left = 120
|
||||
TabIndex = 7
|
||||
Top = 840
|
||||
Width = 495
|
||||
End
|
||||
End
|
||||
Begin VB.Timer tmrTimer
|
||||
Left = 1080
|
||||
Top = 8640
|
||||
End
|
||||
Begin VB.Frame frameVolume
|
||||
Caption = "Volume"
|
||||
Height = 1215
|
||||
Left = 60
|
||||
TabIndex = 3
|
||||
Top = 4800
|
||||
Width = 2595
|
||||
Begin MSComctlLib.Slider slVolume
|
||||
Height = 495
|
||||
Left = 340
|
||||
TabIndex = 18
|
||||
Top = 300
|
||||
Width = 2000
|
||||
_ExtentX = 3519
|
||||
_ExtentY = 873
|
||||
_Version = 393216
|
||||
LargeChange = 400
|
||||
SmallChange = 100
|
||||
Min = -4000
|
||||
Max = 0
|
||||
TickFrequency = 400
|
||||
End
|
||||
Begin VB.Label lblMax
|
||||
Caption = "Max"
|
||||
Height = 255
|
||||
Left = 2100
|
||||
TabIndex = 5
|
||||
Top = 840
|
||||
Width = 375
|
||||
End
|
||||
Begin VB.Label lblMin
|
||||
Caption = "Min"
|
||||
Height = 255
|
||||
Left = 120
|
||||
TabIndex = 4
|
||||
Top = 840
|
||||
Width = 495
|
||||
End
|
||||
End
|
||||
Begin MSComDlg.CommonDialog ctrlCommonDialog
|
||||
Left = 600
|
||||
Top = 8580
|
||||
_ExtentX = 847
|
||||
_ExtentY = 847
|
||||
_Version = 393216
|
||||
End
|
||||
Begin MSComctlLib.ImageList ctrlImageList
|
||||
Left = 0
|
||||
Top = 8580
|
||||
_ExtentX = 1005
|
||||
_ExtentY = 1005
|
||||
BackColor = -2147483643
|
||||
ImageWidth = 24
|
||||
ImageHeight = 24
|
||||
MaskColor = 12632256
|
||||
_Version = 393216
|
||||
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
|
||||
NumListImages = 3
|
||||
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
|
||||
Picture = "vbdemo.frx":0594
|
||||
Key = ""
|
||||
EndProperty
|
||||
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
|
||||
Picture = "vbdemo.frx":06A6
|
||||
Key = ""
|
||||
EndProperty
|
||||
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
|
||||
Picture = "vbdemo.frx":07B8
|
||||
Key = ""
|
||||
EndProperty
|
||||
EndProperty
|
||||
End
|
||||
Begin VB.Menu mnu_File
|
||||
Caption = "&File"
|
||||
Begin VB.Menu mnu_FileOpen
|
||||
Caption = "&Open"
|
||||
Shortcut = ^O
|
||||
End
|
||||
Begin VB.Menu mnuFileSeptum
|
||||
Caption = "-"
|
||||
End
|
||||
Begin VB.Menu mnu_FileExit
|
||||
Caption = "E&xit"
|
||||
End
|
||||
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 DXSDK 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.
|
||||
'* See these sources for detailed information regarding the
|
||||
'* Microsoft samples programs.
|
||||
'*******************************************************************************
|
||||
Option Explicit
|
||||
Option Base 0
|
||||
Option Compare Text
|
||||
|
||||
Private m_dblRate As Double 'Rate in Frames Per Second
|
||||
Private m_bstrFileName As String 'Loaded Filename
|
||||
Private m_dblRunLength As Double 'Duration in seconds
|
||||
Private m_dblStartPosition As Double 'Start position in seconds
|
||||
Private m_boolVideoRunning As Boolean 'Flag used to trigger clock
|
||||
|
||||
Private m_objBasicAudio As IBasicAudio 'Basic Audio Object
|
||||
Private m_objBasicVideo As IBasicVideo 'Basic Video Object
|
||||
Private m_objMediaEvent As IMediaEvent 'MediaEvent Object
|
||||
Private m_objVideoWindow As IVideoWindow 'VideoWindow Object
|
||||
Private m_objMediaControl As IMediaControl 'MediaControl Object
|
||||
Private m_objMediaPosition As IMediaPosition 'MediaPosition Object
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- FORM EVENT HANDLERS
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Form_Load
|
||||
' * procedure description: Occurs when a form is loaded.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Form_Load()
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'reset the rate to 1 (normal)
|
||||
optPlaybackRate(1).Value = True
|
||||
|
||||
'Alter the coordinate system so that we work
|
||||
'in pixels (instead of the default twips)
|
||||
frmMain.ScaleMode = 3 ' pixels
|
||||
|
||||
'Set the granularity for the timer control
|
||||
'so that we can display the duration for
|
||||
'given video sequence.
|
||||
tmrTimer.Interval = 250 '1/4 second intervals
|
||||
|
||||
'disable all the control buttons by default
|
||||
tbControlBar.Buttons("play").Enabled = False
|
||||
tbControlBar.Buttons("stop").Enabled = False
|
||||
tbControlBar.Buttons("pause").Enabled = False
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Form_Unload
|
||||
' * procedure description: Occurs when a form is about to be removed from the screen.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Form_Unload(Cancel As Integer)
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'stop playback
|
||||
m_boolVideoRunning = False
|
||||
DoEvents
|
||||
'cleanup media control
|
||||
If Not m_objMediaControl Is Nothing Then
|
||||
m_objMediaControl.Stop
|
||||
End If
|
||||
'clean-up video window
|
||||
If Not m_objVideoWindow Is Nothing Then
|
||||
m_objVideoWindow.Left = Screen.Width * 8
|
||||
m_objVideoWindow.Height = Screen.Height * 8
|
||||
m_objVideoWindow.Owner = 0 'sets the Owner to NULL
|
||||
End If
|
||||
|
||||
'clean-up & dereference
|
||||
If Not m_objBasicAudio Is Nothing Then Set m_objBasicAudio = Nothing
|
||||
If Not m_objBasicVideo Is Nothing Then Set m_objBasicVideo = Nothing
|
||||
If Not m_objMediaControl Is Nothing Then Set m_objMediaControl = Nothing
|
||||
If Not m_objVideoWindow Is Nothing Then Set m_objVideoWindow = Nothing
|
||||
If Not m_objMediaPosition Is Nothing Then Set m_objMediaPosition = Nothing
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: mnuFileExit_Click
|
||||
' * procedure description: Occurs when the "Exit" option is invoked from the "File" option on the main menubar.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub mnuFileExit_Click()
|
||||
Dim frm As Form
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'unload each loaded form
|
||||
For Each frm In Forms
|
||||
frm.Move Screen.Width * 8, Screen.Height * 8
|
||||
Unload frm
|
||||
Set frm = Nothing
|
||||
Next
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: mnu_FileExit_Click
|
||||
' * procedure description: Occurs when the user elects the 'Exit' option via the main 'File' menu.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub mnu_FileExit_Click()
|
||||
Dim frm As Form
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
For Each frm In Forms
|
||||
frm.Move Screen.Width * 8, Screen.Height * 8
|
||||
frm.Visible = False: Unload frm
|
||||
Next
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: mnu_FileOpen_Click
|
||||
' * procedure description: Occurs when the user elects the 'Open' option via the main 'File' menu.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub mnu_FileOpen_Click()
|
||||
Dim nCount As Long
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
' Use the common file dialog to select a media file
|
||||
' (has the extension .AVI or .MPG.)
|
||||
' Initialize global variables based on the
|
||||
' contents of the file:
|
||||
' m_bstrFileName - name of file name selected by the user
|
||||
' m_dblRunLength = length of the file; duration
|
||||
' m_dblStartPosition - point at which to start playing clip
|
||||
' m_objMediaControl, m_objMediaEvent, m_objMediaPosition,
|
||||
' m_objBasicAudio, m_objVideoWindow - programmable objects
|
||||
|
||||
'clean up memory (in case a file is already open)
|
||||
Call Form_Unload(True)
|
||||
|
||||
'Retrieve the name of an .avi or an .mpg
|
||||
'file that the user wishes to view.
|
||||
ctrlCommonDialog.Filter = "Media Files (*.mpg;*.avi;*.mov;*.wav;*.mp2;*.mp3)|*.mpg;*.avi;*.mov;*.wav;*.mp2;*.mp3"
|
||||
ctrlCommonDialog.ShowOpen
|
||||
m_bstrFileName = ctrlCommonDialog.FileName
|
||||
|
||||
'Instantiate a filter graph for the requested
|
||||
'file format.
|
||||
Set m_objMediaControl = New FilgraphManager
|
||||
Call m_objMediaControl.RenderFile(m_bstrFileName)
|
||||
|
||||
'Setup the IBasicAudio object (this
|
||||
'is equivalent to calling QueryInterface()
|
||||
'on IFilterGraphManager). Initialize the volume
|
||||
'to the maximum value.
|
||||
|
||||
' Some filter graphs don't render audio
|
||||
' In this sample, skip setting volume property
|
||||
Set m_objBasicAudio = m_objMediaControl
|
||||
m_objBasicAudio.Volume = slVolume.Value
|
||||
m_objBasicAudio.Balance = slBalance.Value
|
||||
|
||||
'Setup the IVideoWindow object. Remove the
|
||||
'caption, border, dialog frame, and scrollbars
|
||||
'from the default window. Position the window.
|
||||
'Set the parent to the app's form.
|
||||
Set m_objVideoWindow = m_objMediaControl
|
||||
m_objVideoWindow.WindowStyle = CLng(&H6000000)
|
||||
m_objVideoWindow.Top = 0
|
||||
m_objVideoWindow.Left = 0
|
||||
m_objVideoWindow.Width = picVideoWindow.Width
|
||||
m_objVideoWindow.Height = picVideoWindow.Height
|
||||
'reset the video window owner
|
||||
m_objVideoWindow.Owner = picVideoWindow.hWnd
|
||||
|
||||
'Setup the IMediaEvent object for the
|
||||
'sample toolbar (run, pause, play).
|
||||
Set m_objMediaEvent = m_objMediaControl
|
||||
|
||||
'Setup the IMediaPosition object so that we
|
||||
'can display the duration of the selected
|
||||
'video as well as the elapsed time.
|
||||
Set m_objMediaPosition = m_objMediaControl
|
||||
|
||||
'set the playback rate given the desired optional
|
||||
For nCount = optPlaybackRate.LBound To optPlaybackRate.UBound
|
||||
If optPlaybackRate(nCount).Value = True Then
|
||||
Select Case nCount
|
||||
Case 0
|
||||
If Not m_objMediaPosition Is Nothing Then _
|
||||
m_objMediaPosition.Rate = 0.5
|
||||
Case 1
|
||||
If Not m_objMediaPosition Is Nothing Then _
|
||||
m_objMediaPosition.Rate = 1
|
||||
Case 2
|
||||
If Not m_objMediaPosition Is Nothing Then _
|
||||
m_objMediaPosition.Rate = 2
|
||||
End Select
|
||||
Exit For
|
||||
End If
|
||||
Next
|
||||
|
||||
m_dblRunLength = Round(m_objMediaPosition.Duration, 2)
|
||||
txtDuration.Text = CStr(m_dblRunLength)
|
||||
|
||||
' Reset start position to 0
|
||||
m_dblStartPosition = 0
|
||||
|
||||
' Use user-established playback rate
|
||||
m_dblRate = m_objMediaPosition.Rate
|
||||
txtRate.Text = CStr(m_dblRate)
|
||||
|
||||
'enable run buttons by default
|
||||
tbControlBar.Buttons("play").Enabled = True
|
||||
tbControlBar.Buttons("stop").Enabled = False
|
||||
tbControlBar.Buttons("pause").Enabled = False
|
||||
|
||||
'run the media file
|
||||
Call tbControlBar_ButtonClick(tbControlBar.Buttons(1))
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Resume Next
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: optPlaybackRate_Click
|
||||
' * procedure description: Indicates that the contents of a control have changed.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub optPlaybackRate_Click(Index As Integer)
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'reset textbox
|
||||
Select Case Index
|
||||
Case 0
|
||||
If Not m_objMediaPosition Is Nothing Then _
|
||||
txtRate.Text = 0.5
|
||||
Case 1
|
||||
If Not m_objMediaPosition Is Nothing Then _
|
||||
txtRate.Text = 1
|
||||
Case 2
|
||||
If Not m_objMediaPosition Is Nothing Then _
|
||||
txtRate.Text = 2
|
||||
End Select
|
||||
|
||||
'reset media playback rate
|
||||
If Not m_objMediaPosition Is Nothing Then
|
||||
Select Case Index
|
||||
Case 0
|
||||
If Not m_objMediaPosition Is Nothing Then _
|
||||
m_objMediaPosition.Rate = 0.5
|
||||
Case 1
|
||||
If Not m_objMediaPosition Is Nothing Then _
|
||||
m_objMediaPosition.Rate = 1
|
||||
Case 2
|
||||
If Not m_objMediaPosition Is Nothing Then _
|
||||
m_objMediaPosition.Rate = 2
|
||||
End Select
|
||||
End If
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: slBalance_Change
|
||||
' * procedure description: Indicates that the contents of a control have changed.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub slBalance_Change()
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'Set the balance using the slider
|
||||
If Not m_objMediaControl Is Nothing Then _
|
||||
m_objBasicAudio.Balance = slBalance.Value
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: slVolume_Change
|
||||
' * procedure description: Indicates that the contents of a control have changed.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub slVolume_Change()
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'Set the volume using the slider
|
||||
If Not m_objMediaControl Is Nothing Then _
|
||||
m_objBasicAudio.Volume = slVolume.Value
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: slBalance_MouseMove
|
||||
' * procedure description: Occurs when the user moves the mouse.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub slBalance_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'Set the balance using the slider
|
||||
If Not m_objMediaControl Is Nothing Then _
|
||||
m_objBasicAudio.Balance = slBalance.Value
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: slVolume_MouseMove
|
||||
' * procedure description: Occurs when the user moves the mouse.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub slVolume_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'Set the volume using the slider
|
||||
If Not m_objMediaControl Is Nothing Then _
|
||||
m_objBasicAudio.Volume = slVolume.Value
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: tbControlBar_ButtonClick
|
||||
' * procedure description: Occurs when the user clicks on a Button object in a Toolbar control.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub tbControlBar_ButtonClick(ByVal Button As Button)
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
' handle buttons on the toolbar
|
||||
' buttons 1, 3 and 5 are defined; 2 and 4 are separators
|
||||
' all DirectShow objects are defined only if the user
|
||||
' has already selected a filename and initialized the objects
|
||||
|
||||
' if the objects aren't defined, avoid errors
|
||||
If Not m_objMediaControl Is Nothing Then
|
||||
If Button.Key = "play" Then 'PLAY
|
||||
'Invoke the MediaControl Run() method
|
||||
'and pause the video that is being
|
||||
'displayed through the predefined
|
||||
'filter graph.
|
||||
|
||||
'Assign specified starting position dependent on state
|
||||
If CLng(m_objMediaPosition.CurrentPosition) < CLng(m_dblStartPosition) Then
|
||||
m_objMediaPosition.CurrentPosition = m_dblStartPosition
|
||||
ElseIf CLng(m_objMediaPosition.CurrentPosition) = CLng(m_dblRunLength) Then
|
||||
m_objMediaPosition.CurrentPosition = m_dblStartPosition
|
||||
End If
|
||||
Call m_objMediaControl.Run
|
||||
m_boolVideoRunning = True
|
||||
'enable/disable control buttons
|
||||
tbControlBar.Buttons("play").Enabled = False
|
||||
tbControlBar.Buttons("stop").Enabled = True
|
||||
tbControlBar.Buttons("pause").Enabled = True
|
||||
|
||||
ElseIf Button.Key = "pause" Then 'PAUSE
|
||||
'Invoke the MediaControl Pause() method
|
||||
'and pause the video that is being
|
||||
'displayed through the predefined
|
||||
'filter graph.
|
||||
Call m_objMediaControl.Pause
|
||||
m_boolVideoRunning = False
|
||||
'enable/disable control buttons
|
||||
tbControlBar.Buttons("play").Enabled = True
|
||||
tbControlBar.Buttons("stop").Enabled = True
|
||||
tbControlBar.Buttons("pause").Enabled = False
|
||||
|
||||
ElseIf Button.Key = "stop" Then 'STOP
|
||||
'Invoke the MediaControl Stop() method
|
||||
'and stop the video that is being
|
||||
'displayed through the predefined
|
||||
'filter graph.
|
||||
|
||||
Call m_objMediaControl.Stop
|
||||
m_boolVideoRunning = False
|
||||
' reset to the beginning of the video
|
||||
m_objMediaPosition.CurrentPosition = 0
|
||||
txtElapsed.Text = "0.0"
|
||||
'enable/disable control buttons
|
||||
tbControlBar.Buttons("play").Enabled = True
|
||||
tbControlBar.Buttons("stop").Enabled = False
|
||||
tbControlBar.Buttons("pause").Enabled = False
|
||||
End If
|
||||
End If
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: tmrTimer_Timer
|
||||
' * procedure description: Occurs when a preset interval for a Timer control has elapsed.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub tmrTimer_Timer()
|
||||
Dim nReturnCode As Long
|
||||
Dim dblPosition As Double
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'Retrieve the Elapsed Time and
|
||||
'display it in the corresponding
|
||||
'textbox.
|
||||
|
||||
If m_boolVideoRunning = True Then
|
||||
|
||||
'obtain return code
|
||||
Call m_objMediaEvent.WaitForCompletion(100, nReturnCode)
|
||||
|
||||
|
||||
If nReturnCode = 0 Then
|
||||
'get the current position for display
|
||||
dblPosition = m_objMediaPosition.CurrentPosition
|
||||
txtElapsed.Text = CStr(Round(dblPosition, 2))
|
||||
Else
|
||||
txtElapsed.Text = CStr(Round(m_dblRunLength, 2))
|
||||
'enable/disable control buttons
|
||||
tbControlBar.Buttons("play").Enabled = True
|
||||
tbControlBar.Buttons("stop").Enabled = False
|
||||
tbControlBar.Buttons("pause").Enabled = False
|
||||
m_boolVideoRunning = False
|
||||
End If
|
||||
End If
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Resume Next
|
||||
Exit Sub
|
||||
End Sub
|
||||
Binary file not shown.
@@ -0,0 +1,43 @@
|
||||
Type=Exe
|
||||
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; comdlg32.ocx
|
||||
Reference=*\G{56A868B0-0AD4-11CE-B03A-0020AF0BA770}#1.0#0#C:\WINNT\system32\quartz.dll#Quartz control type library
|
||||
Form=vbdemo.frm
|
||||
Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; MSCOMCTL.OCX
|
||||
IconForm="frmMain"
|
||||
Startup="frmMain"
|
||||
HelpFile=""
|
||||
Title="DShowDemo"
|
||||
ExeName32="VB_Demo.exe"
|
||||
Command32=""
|
||||
Name="DShowDemo"
|
||||
HelpContextID="0"
|
||||
Description="Microsoft Directshow Video Player Sample Application"
|
||||
CompatibleMode="0"
|
||||
MajorVer=8
|
||||
MinorVer=1
|
||||
RevisionVer=0
|
||||
AutoIncrementVer=0
|
||||
ServerSupportFiles=0
|
||||
VersionCompanyName="Microsoft Corporation"
|
||||
VersionFileDescription="Microsoft Directshow Video Player Sample Application"
|
||||
VersionLegalCopyright="Copyright (C) 1999-2001 Microsoft Corporation."
|
||||
VersionProductName="DShow VB Demo"
|
||||
CompilationType=0
|
||||
OptimizationType=0
|
||||
FavorPentiumPro(tm)=0
|
||||
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
|
||||
@@ -0,0 +1,446 @@
|
||||
VERSION 5.00
|
||||
Object = "{38EE5CE1-4B62-11D3-854F-00A0C9C898E7}#1.0#0"; "mswebdvd.dll"
|
||||
Begin VB.Form frmWebDVDSample
|
||||
BorderStyle = 1 'Fixed Single
|
||||
Caption = "WebDVD Sample"
|
||||
ClientHeight = 3930
|
||||
ClientLeft = -19140
|
||||
ClientTop = 345
|
||||
ClientWidth = 6255
|
||||
Icon = "WebDVDSample.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
LockControls = -1 'True
|
||||
MaxButton = 0 'False
|
||||
ScaleHeight = 3930
|
||||
ScaleWidth = 6255
|
||||
StartUpPosition = 2 'CenterScreen
|
||||
Begin VB.Frame fraMenus
|
||||
Height = 3855
|
||||
Left = 60
|
||||
TabIndex = 10
|
||||
Top = 0
|
||||
Width = 6135
|
||||
Begin VB.CommandButton cmdResume
|
||||
Caption = "Resume"
|
||||
Height = 315
|
||||
Left = 4545
|
||||
TabIndex = 9
|
||||
ToolTipText = "Resume Playback"
|
||||
Top = 3420
|
||||
Width = 1470
|
||||
End
|
||||
Begin VB.CommandButton cmdShowMenu
|
||||
Caption = "Show Menu"
|
||||
Height = 315
|
||||
Left = 4545
|
||||
TabIndex = 8
|
||||
ToolTipText = "Show Menu"
|
||||
Top = 3120
|
||||
Width = 1470
|
||||
End
|
||||
Begin VB.ListBox lstMenus
|
||||
Height = 1230
|
||||
ItemData = "WebDVDSample.frx":0442
|
||||
Left = 3840
|
||||
List = "WebDVDSample.frx":0444
|
||||
TabIndex = 0
|
||||
ToolTipText = "Select a Menu"
|
||||
Top = 1440
|
||||
Width = 2175
|
||||
End
|
||||
Begin VB.CommandButton cmdPlay
|
||||
Caption = "Play"
|
||||
Height = 315
|
||||
Left = 120
|
||||
TabIndex = 1
|
||||
ToolTipText = "Play"
|
||||
Top = 3120
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.CommandButton cmdStop
|
||||
Caption = "Stop"
|
||||
Height = 315
|
||||
Left = 1080
|
||||
TabIndex = 2
|
||||
ToolTipText = "Stop"
|
||||
Top = 3120
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.CommandButton cmdPause
|
||||
Caption = "Pause"
|
||||
Height = 315
|
||||
Left = 2040
|
||||
TabIndex = 3
|
||||
ToolTipText = "Pause"
|
||||
Top = 3120
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.CommandButton cmdEject
|
||||
Caption = "Eject"
|
||||
Height = 315
|
||||
Left = 3000
|
||||
TabIndex = 4
|
||||
ToolTipText = "Eject"
|
||||
Top = 3120
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.CommandButton cmdActivateButton
|
||||
Caption = "Activate Button"
|
||||
Height = 315
|
||||
Left = 120
|
||||
TabIndex = 5
|
||||
ToolTipText = "Activate button"
|
||||
Top = 3420
|
||||
Width = 1335
|
||||
End
|
||||
Begin VB.CommandButton cmdPlayPrevChapter
|
||||
Caption = "Last Chapter"
|
||||
Height = 315
|
||||
Left = 1425
|
||||
TabIndex = 6
|
||||
ToolTipText = "Play previous chapter"
|
||||
Top = 3420
|
||||
Width = 1345
|
||||
End
|
||||
Begin VB.CommandButton cmdPlayNextChapter
|
||||
Caption = "Next Chapter"
|
||||
Height = 315
|
||||
Left = 2775
|
||||
TabIndex = 7
|
||||
ToolTipText = "Play next chapter"
|
||||
Top = 3420
|
||||
Width = 1325
|
||||
End
|
||||
Begin MSWEBDVDLibCtl.MSWebDVD MSWebDVD1
|
||||
Height = 2495
|
||||
Left = 120
|
||||
TabIndex = 11
|
||||
Top = 180
|
||||
Width = 3615
|
||||
_cx = 6376
|
||||
_cy = 4401
|
||||
DisableAutoMouseProcessing= 0 'False
|
||||
BackColor = 1048592
|
||||
EnableResetOnStop= 0 'False
|
||||
ColorKey = 1048592
|
||||
WindowlessActivation= 0 'False
|
||||
End
|
||||
Begin VB.Line Line1
|
||||
X1 = 3840
|
||||
X2 = 6000
|
||||
Y1 = 1080
|
||||
Y2 = 1080
|
||||
End
|
||||
Begin VB.Label lblDescriptor
|
||||
Caption = "This sample demonstrates the use of the Microsoft WebDVD control within a Visual Basic playback application."
|
||||
Height = 795
|
||||
Left = 3840
|
||||
TabIndex = 15
|
||||
Top = 180
|
||||
Width = 2175
|
||||
End
|
||||
Begin VB.Label lblChoices
|
||||
Caption = "Menu Choices:"
|
||||
Height = 195
|
||||
Left = 3840
|
||||
TabIndex = 14
|
||||
Top = 1200
|
||||
Width = 2115
|
||||
End
|
||||
Begin VB.Label lblTimeTracker
|
||||
Caption = "Time Tracker:"
|
||||
Height = 195
|
||||
Left = 120
|
||||
TabIndex = 13
|
||||
Top = 2820
|
||||
Width = 1335
|
||||
End
|
||||
Begin VB.Label lblTimeTrackerValue
|
||||
Height = 195
|
||||
Left = 1560
|
||||
TabIndex = 12
|
||||
Top = 2820
|
||||
Width = 2160
|
||||
End
|
||||
End
|
||||
End
|
||||
|
||||
Attribute VB_Name = "frmWebDVDSample"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
|
||||
|
||||
'*******************************************************************************
|
||||
'* This is a part of the Microsoft DXSDK 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.
|
||||
'* See these sources for detailed information regarding the
|
||||
'* Microsoft samples programs.
|
||||
'*******************************************************************************
|
||||
Option Explicit
|
||||
Option Base 0
|
||||
Option Compare Text
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- FORM EVENT HANDLERS
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Form_Load
|
||||
' * procedure description: Occurs when a form is loaded.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Form_Load()
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
With lstMenus
|
||||
.AddItem "RootMenu", 0
|
||||
.AddItem "TitleMenu", 1
|
||||
.AddItem "AudioMenu", 2
|
||||
.AddItem "AngleMenu", 3
|
||||
.AddItem "ChapterMenu", 4
|
||||
.AddItem "SubpictureMenu", 5
|
||||
End With
|
||||
|
||||
'set the root menu selected
|
||||
lstMenus.Selected(0) = True
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: Form_QueryUnload
|
||||
' * procedure description: Occurs before a form or application closes.
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
Select Case UnloadMode
|
||||
Case 0 'vbFormControlMenu
|
||||
Me.Move Screen.Width * 8, Screen.Height * 8
|
||||
Me.Visible = False: Call MSWebDVD1.Stop
|
||||
Case 1 'vbFormCode
|
||||
Me.Move Screen.Width * 8, Screen.Height * 8
|
||||
Me.Visible = False: Call MSWebDVD1.Stop
|
||||
Case 2 'vbAppWindows
|
||||
Me.Move Screen.Width * 8, Screen.Height * 8
|
||||
Me.Visible = False: Call MSWebDVD1.Stop
|
||||
Case 3 'vbAppTaskManager
|
||||
Me.Move Screen.Width * 8, Screen.Height * 8
|
||||
Me.Visible = False: Call MSWebDVD1.Stop
|
||||
Case 4 'vbFormMDIForm
|
||||
Exit Sub
|
||||
Case 5 'vbFormOwner
|
||||
Exit Sub
|
||||
End Select
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
' **************************************************************************************************************************************
|
||||
' * PRIVATE INTERFACE- CONTROL EVENT HANDLERS
|
||||
' *
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: cmdPlay_Click
|
||||
' * procedure description: Occurs when the user clicks the "Play" command button
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub cmdPlay_Click()
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'Start playback
|
||||
Call MSWebDVD1.Play
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Call MsgBox(Err.Description, vbOKOnly + vbExclamation + vbApplicationModal, App.Title): Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: cmdStop_Click
|
||||
' * procedure description: Occurs when the user clicks the "Stop" command button
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub cmdStop_Click()
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'stop playback
|
||||
Call MSWebDVD1.Stop
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Call MsgBox(Err.Description, vbOKOnly + vbExclamation + vbApplicationModal, App.Title): Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: cmdPause_Click
|
||||
' * procedure description: Occurs when the user clicks the "Pause" command button
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub cmdPause_Click()
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'pause playback
|
||||
Call MSWebDVD1.Pause
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Call MsgBox(Err.Description, vbOKOnly + vbExclamation + vbApplicationModal, App.Title): Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: cmdEject_Click
|
||||
' * procedure description: Occurs when the user clicks the "Eject" command button
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub cmdEject_Click()
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'Eject disc from the drive
|
||||
Call MSWebDVD1.Eject
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Call MsgBox(Err.Description, vbOKOnly + vbExclamation + vbApplicationModal, App.Title): Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: cmdActivateButton_Click
|
||||
' * procedure description: Occurs when the user clicks the "ActivateButton" command button
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub cmdActivateButton_Click()
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'activates the currently selected button (selected button is highlighted)
|
||||
Call MSWebDVD1.ActivateButton
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Call MsgBox(Err.Description, vbOKOnly + vbExclamation + vbApplicationModal, App.Title): Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: cmdPlayNextChapter_Click
|
||||
' * procedure description: Occurs when the user clicks the "PlayNextChapter" command button
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub cmdPlayNextChapter_Click()
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'takes playback to next chapter within current title
|
||||
Call MSWebDVD1.PlayNextChapter
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Call MsgBox(Err.Description, vbOKOnly + vbExclamation + vbApplicationModal, App.Title): Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: cmdPlayPrevChapter_Click
|
||||
' * procedure description: Occurs when the user clicks the "PlayPrevChapter" command button
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub cmdPlayPrevChapter_Click()
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
'takes playback to previous chapter within current title
|
||||
Call MSWebDVD1.PlayPrevChapter
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Call MsgBox(Err.Description, vbOKOnly + vbExclamation + vbApplicationModal, App.Title): Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: cmdShowMenu_Click
|
||||
' * procedure description: Occurs when the user clicks the "ShowMenu" command button
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub cmdShowMenu_Click()
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
Select Case lstMenus.ListIndex
|
||||
Case 0: Call MSWebDVD1.ShowMenu(3) 'Root
|
||||
Case 1: Call MSWebDVD1.ShowMenu(2) 'Title
|
||||
Case 2: Call MSWebDVD1.ShowMenu(5) 'Audio
|
||||
Case 3: Call MSWebDVD1.ShowMenu(6) 'Angle
|
||||
Case 4: Call MSWebDVD1.ShowMenu(7) 'Chapter
|
||||
Case 5: Call MSWebDVD1.ShowMenu(4) 'Subpicture
|
||||
End Select
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Call MsgBox(Err.Description, vbOKOnly + vbExclamation + vbApplicationModal, App.Title): Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: cmdResume_Click
|
||||
' * procedure description: Occurs when the user clicks the "Resume" command button
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub cmdResume_Click()
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
' Resume playback
|
||||
Call MSWebDVD1.Resume
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Call MsgBox(Err.Description, vbOKOnly + vbExclamation + vbApplicationModal, App.Title): Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
' ******************************************************************************************************************************
|
||||
' * procedure name: MSWebDVD1_DVDNotify
|
||||
' * procedure description: DVD notification event- occurs when a notification arrives from the dvd control
|
||||
' *
|
||||
' ******************************************************************************************************************************
|
||||
Private Sub MSWebDVD1_DVDNotify(ByVal lEventCode As Long, ByVal lParam1 As Variant, ByVal lParam2 As Variant)
|
||||
On Local Error GoTo ErrLine
|
||||
|
||||
If 282 = lEventCode Then '282 is the event code for the time event
|
||||
'pass in param1 to get you the current time-convert to hh:mm:ss:ff format with DVDTimeCode2BSTR API
|
||||
If lblTimeTrackerValue.Caption <> CStr(MSWebDVD1.DVDTimeCode2bstr(lParam1)) Then _
|
||||
lblTimeTrackerValue.Caption = CStr(MSWebDVD1.DVDTimeCode2bstr(lParam1))
|
||||
End If
|
||||
Exit Sub
|
||||
|
||||
ErrLine:
|
||||
Err.Clear
|
||||
Exit Sub
|
||||
End Sub
|
||||
Binary file not shown.
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user