LGram16
e067522598
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>
1287 lines
58 KiB
Plaintext
1287 lines
58 KiB
Plaintext
VERSION 5.00
|
|
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
|
|
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
|
|
Begin VB.Form frmMain
|
|
BorderStyle = 1 'Fixed Single
|
|
Caption = "SlideshowVB"
|
|
ClientHeight = 6480
|
|
ClientLeft = 60
|
|
ClientTop = 345
|
|
ClientWidth = 9045
|
|
Icon = "frmMain.frx":0000
|
|
LinkTopic = "frmMain"
|
|
MaxButton = 0 'False
|
|
ScaleHeight = 6480
|
|
ScaleWidth = 9045
|
|
Visible = 0 'False
|
|
Begin MSComDlg.CommonDialog ctrlCommonDialog
|
|
Left = 60
|
|
Top = 6000
|
|
_ExtentX = 847
|
|
_ExtentY = 847
|
|
_Version = 393216
|
|
End
|
|
Begin SlideshowVB.SourceClip ctrlSourceClip
|
|
DragMode = 1 'Automatic
|
|
Height = 1965
|
|
Index = 0
|
|
Left = 60
|
|
TabIndex = 12
|
|
TabStop = 0 'False
|
|
ToolTipText = "Source Clip"
|
|
Top = 75
|
|
Width = 2190
|
|
_ExtentX = 3863
|
|
_ExtentY = 3466
|
|
BorderColor = 4210752
|
|
BorderSize = 3
|
|
End
|
|
Begin VB.Frame fraOptions
|
|
Height = 1890
|
|
Left = 60
|
|
TabIndex = 6
|
|
Top = 4050
|
|
Width = 4420
|
|
Begin VB.TextBox txtMaxMediaLength
|
|
Height = 375
|
|
Left = 140
|
|
OLEDropMode = 1 'Manual
|
|
TabIndex = 0
|
|
ToolTipText = "Maximum playback time per source clip."
|
|
Top = 480
|
|
Width = 4150
|
|
End
|
|
Begin VB.ComboBox cmbTransitions
|
|
Height = 315
|
|
Left = 140
|
|
TabIndex = 1
|
|
ToolTipText = "Default Transition"
|
|
Top = 1440
|
|
Width = 4150
|
|
End
|
|
Begin VB.Label lblTransitionDescription
|
|
Caption = "Select a transition to use. If the transition is not installed on your system, the default transition will be used."
|
|
Height = 375
|
|
Index = 0
|
|
Left = 140
|
|
TabIndex = 7
|
|
Top = 930
|
|
Width = 4155
|
|
End
|
|
Begin VB.Label lbltxtMaxMediaLength
|
|
Caption = "Set the maximum time for each clip in the slideshow:"
|
|
Height = 255
|
|
Index = 0
|
|
Left = 140
|
|
TabIndex = 8
|
|
Top = 225
|
|
Width = 4155
|
|
End
|
|
End
|
|
Begin VB.Frame fraCommandFixture
|
|
Height = 1890
|
|
Left = 4560
|
|
TabIndex = 9
|
|
Top = 4050
|
|
Width = 4420
|
|
Begin MSComctlLib.ProgressBar ctrlProgress
|
|
Height = 405
|
|
Left = 140
|
|
TabIndex = 10
|
|
ToolTipText = "Current Progress"
|
|
Top = 1350
|
|
Visible = 0 'False
|
|
Width = 4140
|
|
_ExtentX = 7303
|
|
_ExtentY = 714
|
|
_Version = 393216
|
|
Appearance = 1
|
|
End
|
|
Begin VB.Label lblInstructions
|
|
Caption = "This interface supports drag-and-drop editing. Drag your media files into the poster frames to preview, then select a transition."
|
|
BeginProperty Font
|
|
Name = "Comic Sans MS"
|
|
Size = 9.75
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 990
|
|
Left = 150
|
|
TabIndex = 11
|
|
ToolTipText = "This interface supports drag-and-drop editing. Drag your media files into the poster frames to preview, then select a transition."
|
|
Top = 225
|
|
Width = 4140
|
|
End
|
|
End
|
|
Begin VB.CommandButton cmdWriteXTL
|
|
Caption = "Write &XTL"
|
|
Height = 350
|
|
Left = 5220
|
|
TabIndex = 3
|
|
ToolTipText = "Export using XTL Format"
|
|
Top = 6075
|
|
Width = 1215
|
|
End
|
|
Begin VB.CommandButton cmdWriteAVI
|
|
Caption = "&Write AVI"
|
|
Height = 350
|
|
Left = 6510
|
|
TabIndex = 4
|
|
ToolTipText = "Export using AVI Format"
|
|
Top = 6075
|
|
Width = 1215
|
|
End
|
|
Begin VB.CommandButton cmdPlay
|
|
Caption = "&Play"
|
|
Height = 350
|
|
Left = 3960
|
|
TabIndex = 2
|
|
ToolTipText = "Play"
|
|
Top = 6075
|
|
Width = 1215
|
|
End
|
|
Begin VB.CommandButton cmdExit
|
|
Caption = "&Exit"
|
|
Default = -1 'True
|
|
Height = 350
|
|
Left = 7785
|
|
TabIndex = 5
|
|
ToolTipText = "Exit"
|
|
Top = 6075
|
|
Width = 1215
|
|
End
|
|
Begin SlideshowVB.SourceClip ctrlSourceClip
|
|
DragMode = 1 'Automatic
|
|
Height = 1965
|
|
Index = 1
|
|
Left = 2310
|
|
TabIndex = 13
|
|
TabStop = 0 'False
|
|
ToolTipText = "Source Clip"
|
|
Top = 75
|
|
Width = 2190
|
|
_ExtentX = 3863
|
|
_ExtentY = 3466
|
|
BorderColor = 4210752
|
|
BorderSize = 3
|
|
End
|
|
Begin SlideshowVB.SourceClip ctrlSourceClip
|
|
DragMode = 1 'Automatic
|
|
Height = 1965
|
|
Index = 2
|
|
Left = 4560
|
|
TabIndex = 14
|
|
TabStop = 0 'False
|
|
ToolTipText = "Source Clip"
|
|
Top = 75
|
|
Width = 2190
|
|
_ExtentX = 3863
|
|
_ExtentY = 3466
|
|
BorderColor = 4210752
|
|
BorderSize = 3
|
|
End
|
|
Begin SlideshowVB.SourceClip ctrlSourceClip
|
|
DragMode = 1 'Automatic
|
|
Height = 1965
|
|
Index = 3
|
|
Left = 6810
|
|
TabIndex = 15
|
|
TabStop = 0 'False
|
|
ToolTipText = "Source Clip"
|
|
Top = 75
|
|
Width = 2190
|
|
_ExtentX = 3863
|
|
_ExtentY = 3466
|
|
BorderColor = 4210752
|
|
BorderSize = 3
|
|
End
|
|
Begin SlideshowVB.SourceClip ctrlSourceClip
|
|
DragMode = 1 'Automatic
|
|
Height = 1965
|
|
Index = 4
|
|
Left = 60
|
|
TabIndex = 16
|
|
TabStop = 0 'False
|
|
ToolTipText = "Source Clip"
|
|
Top = 2100
|
|
Width = 2190
|
|
_ExtentX = 3863
|
|
_ExtentY = 3466
|
|
BorderColor = 4210752
|
|
BorderSize = 3
|
|
End
|
|
Begin SlideshowVB.SourceClip ctrlSourceClip
|
|
DragMode = 1 'Automatic
|
|
Height = 1965
|
|
Index = 5
|
|
Left = 2310
|
|
TabIndex = 17
|
|
TabStop = 0 'False
|
|
ToolTipText = "Source Clip"
|
|
Top = 2100
|
|
Width = 2190
|
|
_ExtentX = 3863
|
|
_ExtentY = 3466
|
|
BorderColor = 4210752
|
|
BorderSize = 3
|
|
End
|
|
Begin SlideshowVB.SourceClip ctrlSourceClip
|
|
DragMode = 1 'Automatic
|
|
Height = 1965
|
|
Index = 6
|
|
Left = 4560
|
|
TabIndex = 18
|
|
TabStop = 0 'False
|
|
ToolTipText = "Source Clip"
|
|
Top = 2100
|
|
Width = 2190
|
|
_ExtentX = 3863
|
|
_ExtentY = 3466
|
|
BorderColor = 4210752
|
|
BorderSize = 3
|
|
End
|
|
Begin SlideshowVB.SourceClip ctrlSourceClip
|
|
DragMode = 1 'Automatic
|
|
Height = 1965
|
|
Index = 7
|
|
Left = 6810
|
|
TabIndex = 19
|
|
TabStop = 0 'False
|
|
ToolTipText = "Source Clip"
|
|
Top = 2100
|
|
Width = 2190
|
|
_ExtentX = 3863
|
|
_ExtentY = 3466
|
|
BorderColor = 4210752
|
|
BorderSize = 3
|
|
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
|
|
|
|
'enable/disable clipsource dragdrop operations
|
|
Private m_boolEnableDragDrop As Boolean
|
|
'default/highlight border color on clip controls
|
|
Private Const HIGHLIGHT_CLIPBORDERCOLOR As Long = vbBlue
|
|
Private Const DEFAULT_CLIPBORDERCOLOR As Long = &H404040
|
|
'temporary filename for writing out poster frames
|
|
Private Const TEMPORARY_XTLFILENAME As String = "SlideshowVB.xtl"
|
|
'maximum preview per clip in the slideshow presentation, in seconds
|
|
Private m_nMaximumClipLength As Long
|
|
|
|
|
|
' **************************************************************************************************************************************
|
|
' * PRIVATE INTERFACE- FORM EVENT HANDLERS
|
|
' *
|
|
' *
|
|
' ******************************************************************************************************************************
|
|
' * procedure name: Form_Initialize
|
|
' * procedure description: Occurs when an application creates an instance of a Form, MDIForm, or class.
|
|
' *
|
|
' ******************************************************************************************************************************
|
|
Private Sub Form_Initialize()
|
|
On Local Error GoTo ErrLine
|
|
|
|
'instantiate global data
|
|
Set gbl_objTimeline = New AMTimeline
|
|
Set gbl_objRenderEngine = New RenderEngine
|
|
Set gbl_objMediaControl = New FilgraphManager
|
|
Exit Sub
|
|
|
|
ErrLine:
|
|
Err.Clear
|
|
Exit Sub
|
|
End Sub
|
|
|
|
|
|
|
|
' ******************************************************************************************************************************
|
|
' * procedure name: Form_Load
|
|
' * procedure description: Occurs when a form is loaded.
|
|
' *
|
|
' ******************************************************************************************************************************
|
|
Private Sub Form_Load()
|
|
On Local Error GoTo ErrLine
|
|
|
|
'enable/disable application
|
|
Call AppEnable(False, True, True)
|
|
|
|
'assign default value(s)
|
|
m_nMaximumClipLength = 8
|
|
|
|
'setup default control(s)
|
|
txtMaxMediaLength.Text = 8
|
|
cmbTransitions.Text = vbNullString
|
|
Call ViewTransitionFriendlyNamesDirect(cmbTransitions)
|
|
|
|
'assign the default transition
|
|
If TransitionCLSIDToFriendlyName(gbl_objTimeline.GetDefaultTransitionB) <> vbNullString Then _
|
|
cmbTransitions.Text = TransitionCLSIDToFriendlyName(gbl_objTimeline.GetDefaultTransitionB)
|
|
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)
|
|
Dim frm As Form
|
|
On Local Error GoTo ErrLine
|
|
|
|
Call RenderTimelineQuasiAsync(Nothing)
|
|
|
|
Select Case UnloadMode
|
|
Case vbFormControlMenu
|
|
'0 The user chose the Close command from the Control menu on the form.
|
|
For Each frm In Forms
|
|
frm.Move Screen.Width * -8, Screen.Height * -8
|
|
frm.Visible = False: Unload frm
|
|
Next
|
|
|
|
Case vbFormCode
|
|
'1 The Unload statement is invoked from code.
|
|
Exit Sub
|
|
|
|
Case vbAppWindows
|
|
'2 The current Microsoft Windows operating environment session is ending.
|
|
For Each frm In Forms
|
|
frm.Move Screen.Width * -8, Screen.Height * -8
|
|
frm.Visible = False: Unload frm
|
|
Next
|
|
|
|
Case vbAppTaskManager
|
|
'3 The Microsoft Windows Task Manager is closing the application.
|
|
For Each frm In Forms
|
|
frm.Move Screen.Width * -8, Screen.Height * -8
|
|
frm.Visible = False: Unload frm
|
|
Next
|
|
End
|
|
|
|
Case vbFormMDIForm
|
|
'4 An MDI child form is closing because the MDI form is closing.
|
|
Exit Sub
|
|
|
|
Case vbFormOwner
|
|
'5 A form is closing because its owner is closing
|
|
For Each frm In Forms
|
|
frm.Move Screen.Width * -8, Screen.Height * -8
|
|
frm.Visible = False: Unload frm
|
|
Next
|
|
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
|
|
|
|
'clean-up & dereference global data
|
|
If Not gbl_objTimeline Is Nothing Then Set gbl_objTimeline = Nothing
|
|
If Not gbl_objMediaControl Is Nothing Then Set gbl_objMediaControl = Nothing
|
|
If Not gbl_objVideoWindow Is Nothing Then Set gbl_objVideoWindow = Nothing
|
|
If Not gbl_objRenderEngine Is Nothing Then Set gbl_objRenderEngine = Nothing
|
|
Exit Sub
|
|
|
|
ErrLine:
|
|
Err.Clear
|
|
Exit Sub
|
|
End Sub
|
|
|
|
|
|
|
|
' **************************************************************************************************************************************
|
|
' * PRIVATE INTERFACE- CONTROL EVENT HANDLERS
|
|
' *
|
|
' *
|
|
' ******************************************************************************************************************************
|
|
' * procedure name: cmdExit_Click
|
|
' * procedure description: Occurs when the user presses and then releases a mouse button over an object.
|
|
' *
|
|
' ******************************************************************************************************************************
|
|
Private Sub cmdExit_Click()
|
|
Dim frm As Form
|
|
On Local Error GoTo ErrLine
|
|
|
|
'Invoke the Unload statement on 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: cmdPlay_Click
|
|
' * procedure description: Occurs when the user presses and then releases a mouse button over an object.
|
|
' *
|
|
' ******************************************************************************************************************************
|
|
Private Sub cmdPlay_Click()
|
|
On Local Error GoTo ErrLine
|
|
|
|
'assign the maximum media length per clip
|
|
If IsNumeric(txtMaxMediaLength.Text) Then _
|
|
m_nMaximumClipLength = CLng(txtMaxMediaLength.Text)
|
|
|
|
'splice the video clip(s)
|
|
Set gbl_objTimeline = _
|
|
SpliceVideo(TransitionFriendlyNameToCLSID _
|
|
( _
|
|
cmbTransitions.Text), _
|
|
ctrlSourceClip(0).MediaFile, _
|
|
ctrlSourceClip(1).MediaFile, _
|
|
ctrlSourceClip(2).MediaFile, _
|
|
ctrlSourceClip(3).MediaFile, _
|
|
ctrlSourceClip(4).MediaFile, _
|
|
ctrlSourceClip(5).MediaFile, _
|
|
ctrlSourceClip(6).MediaFile, _
|
|
ctrlSourceClip(7).MediaFile _
|
|
)
|
|
|
|
'disable the ui
|
|
Call AppEnable(False, False)
|
|
|
|
'obtain a reference to the filtergraph manager
|
|
If Not gbl_objTimeline Is Nothing Then
|
|
If Not gbl_objRenderEngine Is Nothing Then
|
|
'set the timeline object
|
|
Call gbl_objRenderEngine.SetTimelineObject(gbl_objTimeline)
|
|
'playback the timeline
|
|
Call RenderTimelineQuasiAsync(gbl_objTimeline)
|
|
End If
|
|
End If
|
|
|
|
'enable the ui
|
|
If Not gbl_objTimeline Is Nothing Then
|
|
Call AppEnable(True, True)
|
|
End If
|
|
Exit Sub
|
|
|
|
ErrLine:
|
|
Err.Clear
|
|
Resume Next
|
|
Exit Sub
|
|
End Sub
|
|
|
|
|
|
' ******************************************************************************************************************************
|
|
' * procedure name: cmdWriteAVI_Click
|
|
' * procedure description: Occurs when the user presses and then releases a mouse button over an object.
|
|
' *
|
|
' ******************************************************************************************************************************
|
|
Private Sub cmdWriteAVI_Click()
|
|
Dim nState As Long
|
|
Dim nReturnCode As Long
|
|
Dim dblPosition As Double
|
|
Dim dblDuration As Double
|
|
Dim bstrFileName As String
|
|
Dim objMediaEvent As IMediaEvent
|
|
Dim objMediaPosition As IMediaPosition
|
|
Dim objFilterGraphManager As FilgraphManager
|
|
Dim objSmartRenderEngine As SmartRenderEngine
|
|
On Error GoTo ErrLine
|
|
|
|
'assign the maximum media length per clip
|
|
If IsNumeric(txtMaxMediaLength.Text) Then _
|
|
m_nMaximumClipLength = CLng(txtMaxMediaLength.Text)
|
|
|
|
'splice the video clip(s)
|
|
Set gbl_objTimeline = _
|
|
SpliceVideo(TransitionFriendlyNameToCLSID _
|
|
( _
|
|
cmbTransitions.Text), _
|
|
ctrlSourceClip(0).MediaFile, _
|
|
ctrlSourceClip(1).MediaFile, _
|
|
ctrlSourceClip(2).MediaFile, _
|
|
ctrlSourceClip(3).MediaFile, _
|
|
ctrlSourceClip(4).MediaFile, _
|
|
ctrlSourceClip(5).MediaFile, _
|
|
ctrlSourceClip(6).MediaFile, _
|
|
ctrlSourceClip(7).MediaFile _
|
|
)
|
|
|
|
|
|
'disable the ui
|
|
Call AppEnable(False, False, False)
|
|
|
|
'query the user for a media file
|
|
ctrlCommonDialog.DefaultExt = "AVI"
|
|
ctrlCommonDialog.InitDir = vbNullString
|
|
ctrlCommonDialog.Filter = "*.avi|*.avi"
|
|
Call ctrlCommonDialog.ShowSave
|
|
bstrFileName = ctrlCommonDialog.FileName
|
|
|
|
If bstrFileName = vbNullString Then
|
|
'enable the ui / user cancel
|
|
Call AppEnable(True, True, True)
|
|
Exit Sub
|
|
End If
|
|
|
|
|
|
'instantiate a smart render engine
|
|
Set objSmartRenderEngine = New SmartRenderEngine
|
|
'set the timeline object to the render engine
|
|
objSmartRenderEngine.SetTimelineObject gbl_objTimeline
|
|
'connect-up the render engine's frontend
|
|
objSmartRenderEngine.ConnectFrontEnd
|
|
'obtain an instance of the filtergraph manager
|
|
objSmartRenderEngine.GetFilterGraph objFilterGraphManager
|
|
'append a filewriter and av mux filter to the graph
|
|
AddFileWriterAndMux objFilterGraphManager, bstrFileName
|
|
'render the output pins on the smart render engine
|
|
RenderGroupPins objSmartRenderEngine, gbl_objTimeline
|
|
'render the filtergraph
|
|
objFilterGraphManager.Run
|
|
'derive the media event interface from the filtergraph manager
|
|
Set objMediaEvent = objFilterGraphManager
|
|
Set objMediaPosition = objMediaEvent
|
|
|
|
'display the progress during render
|
|
ctrlProgress.Value = 0
|
|
ctrlProgress.Visible = True
|
|
dblDuration = objMediaPosition.Duration
|
|
If dblDuration > 0 Then
|
|
Do Until ctrlProgress.Value = 100: DoEvents
|
|
'query current position
|
|
dblPosition = objMediaPosition.CurrentPosition
|
|
'set the progress bar's current position
|
|
If dblPosition <> 0 Then
|
|
If dblDuration > 0 Then
|
|
ctrlProgress.Value = dblPosition * 100 / dblDuration
|
|
Else: ctrlProgress.Value = 100: Exit Do
|
|
End If
|
|
Else: ctrlProgress.Value = 100: Exit Do
|
|
End If
|
|
Loop
|
|
End If
|
|
ctrlProgress.Value = 100
|
|
ctrlProgress.Visible = False
|
|
|
|
'enable the ui
|
|
Call AppEnable(True, True, True)
|
|
|
|
'clean-up & dereference
|
|
If Not objMediaEvent Is Nothing Then Set objMediaEvent = Nothing
|
|
If Not objMediaPosition Is Nothing Then Set objMediaPosition = Nothing
|
|
If Not objFilterGraphManager Is Nothing Then Set objFilterGraphManager = Nothing
|
|
If Not objSmartRenderEngine Is Nothing Then Set objSmartRenderEngine = Nothing
|
|
Exit Sub
|
|
|
|
ErrLine:
|
|
Err.Clear
|
|
Resume Next
|
|
Exit Sub
|
|
End Sub
|
|
|
|
|
|
' ******************************************************************************************************************************
|
|
' * procedure name: cmdWriteXTL_Click
|
|
' * procedure description: Occurs when the user presses and then releases a mouse button over an object.
|
|
' *
|
|
' ******************************************************************************************************************************
|
|
Private Sub cmdWriteXTL_Click()
|
|
Dim bstrFileName As String
|
|
Dim objXml2Dex As Xml2Dex
|
|
On Local Error GoTo ErrLine
|
|
|
|
'assign the maximum media length per clip
|
|
If IsNumeric(txtMaxMediaLength.Text) Then _
|
|
m_nMaximumClipLength = CLng(txtMaxMediaLength.Text)
|
|
|
|
'splice the video clip(s)
|
|
Set gbl_objTimeline = _
|
|
SpliceVideo(TransitionFriendlyNameToCLSID _
|
|
( _
|
|
cmbTransitions.Text), _
|
|
ctrlSourceClip(0).MediaFile, _
|
|
ctrlSourceClip(1).MediaFile, _
|
|
ctrlSourceClip(2).MediaFile, _
|
|
ctrlSourceClip(3).MediaFile, _
|
|
ctrlSourceClip(4).MediaFile, _
|
|
ctrlSourceClip(5).MediaFile, _
|
|
ctrlSourceClip(6).MediaFile, _
|
|
ctrlSourceClip(7).MediaFile _
|
|
)
|
|
|
|
'disable the ui
|
|
Call AppEnable(False, False, False)
|
|
|
|
'query the user for a media file
|
|
ctrlCommonDialog.DefaultExt = "XTL"
|
|
ctrlCommonDialog.InitDir = vbNullString
|
|
ctrlCommonDialog.Filter = "*.xtl|*.xtl"
|
|
Call ctrlCommonDialog.ShowSave
|
|
bstrFileName = ctrlCommonDialog.FileName
|
|
|
|
If bstrFileName = vbNullString Then
|
|
'enable the ui
|
|
Call AppEnable(True, True, True)
|
|
Exit Sub
|
|
Else
|
|
'if the file already exists, then delete it
|
|
If File_Exists(bstrFileName) Then _
|
|
Call File_Delete(bstrFileName, False, False, False)
|
|
End If
|
|
|
|
'obtain a reference to the filtergraph manager
|
|
If Not gbl_objTimeline Is Nothing Then
|
|
If Not gbl_objRenderEngine Is Nothing Then
|
|
'set the timeline object
|
|
Call gbl_objRenderEngine.SetTimelineObject(gbl_objTimeline)
|
|
'render the timeline
|
|
Call SaveTimeline(gbl_objTimeline, bstrFileName, DEXExportXTL)
|
|
End If
|
|
End If
|
|
|
|
'enable the ui
|
|
Call AppEnable(True, True, True)
|
|
Exit Sub
|
|
|
|
ErrLine:
|
|
Err.Clear
|
|
Resume Next
|
|
Exit Sub
|
|
End Sub
|
|
|
|
|
|
' ******************************************************************************************************************************
|
|
' * procedure name: ctrlSourceClip_Import
|
|
' * procedure description: Occurs whenever an import of a media file into the clipsource control is attempted.
|
|
' * Set the second argument, 'Cancel' to true to cancel the operation and prevent the import.
|
|
' ******************************************************************************************************************************
|
|
Private Sub ctrlSourceClip_Import(Index As Integer, bstrFileName As String, Cancel As Boolean)
|
|
On Local Error GoTo ErrLine
|
|
|
|
'enable/disable drag/drop
|
|
If m_boolEnableDragDrop = False Then
|
|
Cancel = True
|
|
Exit Sub
|
|
End If
|
|
|
|
'otherwise enable everything
|
|
Call AppEnable(True, True, True)
|
|
Exit Sub
|
|
|
|
ErrLine:
|
|
Err.Clear
|
|
Exit Sub
|
|
End Sub
|
|
|
|
|
|
' ******************************************************************************************************************************
|
|
' * procedure name: ctrlSourceClip_DragDrop
|
|
' * procedure description: Occurs when a drag-and-drop operation is completed.
|
|
' *
|
|
' ******************************************************************************************************************************
|
|
Private Sub ctrlSourceClip_DragDrop(Index As Integer, Source As Control, X As Single, Y As Single)
|
|
Dim nCount As Long
|
|
On Local Error GoTo ErrLine
|
|
|
|
For nCount = ctrlSourceClip.LBound To ctrlSourceClip.UBound
|
|
If nCount <> Index Then
|
|
If ctrlSourceClip(nCount).BorderColor <> DEFAULT_CLIPBORDERCOLOR Then _
|
|
ctrlSourceClip(nCount).BorderColor = DEFAULT_CLIPBORDERCOLOR
|
|
Else
|
|
If ctrlSourceClip(nCount).BorderColor <> HIGHLIGHT_CLIPBORDERCOLOR Then _
|
|
ctrlSourceClip(nCount).BorderColor = HIGHLIGHT_CLIPBORDERCOLOR
|
|
End If
|
|
Next
|
|
'reset default media file
|
|
ctrlSourceClip(Index).MediaFile = Source.MediaFile
|
|
'reset the default color to the clip control
|
|
For nCount = ctrlSourceClip.LBound To ctrlSourceClip.UBound
|
|
If ctrlSourceClip(nCount).BorderColor <> DEFAULT_CLIPBORDERCOLOR Then _
|
|
ctrlSourceClip(nCount).BorderColor = DEFAULT_CLIPBORDERCOLOR
|
|
Next
|
|
Exit Sub
|
|
|
|
ErrLine:
|
|
Err.Clear
|
|
Exit Sub
|
|
End Sub
|
|
|
|
|
|
' ******************************************************************************************************************************
|
|
' * procedure name: ctrlSourceClip_DragOver
|
|
' * procedure description: Occurs when a drag-and-drop operation is in progress.
|
|
' *
|
|
' ******************************************************************************************************************************
|
|
Private Sub ctrlSourceClip_DragOver(Index As Integer, Source As Control, X As Single, Y As Single, State As Integer)
|
|
Dim nCount As Long
|
|
On Local Error GoTo ErrLine
|
|
|
|
For nCount = ctrlSourceClip.LBound To ctrlSourceClip.UBound
|
|
If nCount <> Index Then
|
|
If ctrlSourceClip(nCount).BorderColor <> DEFAULT_CLIPBORDERCOLOR Then _
|
|
ctrlSourceClip(nCount).BorderColor = DEFAULT_CLIPBORDERCOLOR
|
|
Else
|
|
If ctrlSourceClip(nCount).BorderColor <> HIGHLIGHT_CLIPBORDERCOLOR Then _
|
|
ctrlSourceClip(nCount).BorderColor = HIGHLIGHT_CLIPBORDERCOLOR
|
|
End If
|
|
Next
|
|
Exit Sub
|
|
|
|
ErrLine:
|
|
Err.Clear
|
|
Exit Sub
|
|
End Sub
|
|
|
|
|
|
|
|
|
|
' **************************************************************************************************************************************
|
|
' * PRIVATE INTERFACE- CONTROL EVENT HANDLERS
|
|
' *
|
|
' *
|
|
' ******************************************************************************************************************************
|
|
' * procedure name: cmdPlay_MouseMove
|
|
' * procedure description: Occurs when the user moves the mouse.
|
|
' * Reset control parameter(s) to default setting(s)
|
|
' ******************************************************************************************************************************
|
|
Private Sub cmdPlay_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
|
|
Dim nCount As Long
|
|
On Local Error GoTo ErrLine
|
|
|
|
For nCount = ctrlSourceClip.LBound To ctrlSourceClip.UBound
|
|
If ctrlSourceClip(nCount).BorderColor <> DEFAULT_CLIPBORDERCOLOR Then _
|
|
ctrlSourceClip(nCount).BorderColor = DEFAULT_CLIPBORDERCOLOR
|
|
Next
|
|
Exit Sub
|
|
|
|
ErrLine:
|
|
Err.Clear
|
|
Exit Sub
|
|
End Sub
|
|
|
|
|
|
' ******************************************************************************************************************************
|
|
' * procedure name: cmdWriteAVI_MouseMove
|
|
' * procedure description: Occurs when the user moves the mouse.
|
|
' * Reset control parameter(s) to default setting(s)
|
|
' ******************************************************************************************************************************
|
|
Private Sub cmdWriteAVI_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
|
|
Dim nCount As Long
|
|
On Local Error GoTo ErrLine
|
|
|
|
For nCount = ctrlSourceClip.LBound To ctrlSourceClip.UBound
|
|
If ctrlSourceClip(nCount).BorderColor <> DEFAULT_CLIPBORDERCOLOR Then _
|
|
ctrlSourceClip(nCount).BorderColor = DEFAULT_CLIPBORDERCOLOR
|
|
Next
|
|
Exit Sub
|
|
|
|
ErrLine:
|
|
Err.Clear
|
|
Exit Sub
|
|
End Sub
|
|
|
|
|
|
' ******************************************************************************************************************************
|
|
' * procedure name: cmdWriteXTL_MouseMove
|
|
' * procedure description: Occurs when the user moves the mouse.
|
|
' * Reset control parameter(s) to default setting(s)
|
|
' ******************************************************************************************************************************
|
|
Private Sub cmdWriteXTL_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
|
|
Dim nCount As Long
|
|
On Local Error GoTo ErrLine
|
|
|
|
For nCount = ctrlSourceClip.LBound To ctrlSourceClip.UBound
|
|
If ctrlSourceClip(nCount).BorderColor <> DEFAULT_CLIPBORDERCOLOR Then _
|
|
ctrlSourceClip(nCount).BorderColor = DEFAULT_CLIPBORDERCOLOR
|
|
Next
|
|
Exit Sub
|
|
|
|
ErrLine:
|
|
Err.Clear
|
|
Exit Sub
|
|
End Sub
|
|
|
|
|
|
' ******************************************************************************************************************************
|
|
' * procedure name: cmdExit_MouseMove
|
|
' * procedure description: Occurs when the user moves the mouse.
|
|
' * Reset control parameter(s) to default setting(s)
|
|
' ******************************************************************************************************************************
|
|
Private Sub cmdExit_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
|
|
Dim nCount As Long
|
|
On Local Error GoTo ErrLine
|
|
|
|
For nCount = ctrlSourceClip.LBound To ctrlSourceClip.UBound
|
|
If ctrlSourceClip(nCount).BorderColor <> DEFAULT_CLIPBORDERCOLOR Then _
|
|
ctrlSourceClip(nCount).BorderColor = DEFAULT_CLIPBORDERCOLOR
|
|
Next
|
|
Exit Sub
|
|
|
|
ErrLine:
|
|
Err.Clear
|
|
Exit Sub
|
|
End Sub
|
|
|
|
|
|
' ******************************************************************************************************************************
|
|
' * procedure name: ctrlProgress_MouseMove
|
|
' * procedure description: Occurs when the user moves the mouse.
|
|
' * Reset control parameter(s) to default setting(s)
|
|
' ******************************************************************************************************************************
|
|
Private Sub ctrlProgress_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
|
|
Dim nCount As Long
|
|
On Local Error GoTo ErrLine
|
|
|
|
For nCount = ctrlSourceClip.LBound To ctrlSourceClip.UBound
|
|
If ctrlSourceClip(nCount).BorderColor <> DEFAULT_CLIPBORDERCOLOR Then _
|
|
ctrlSourceClip(nCount).BorderColor = DEFAULT_CLIPBORDERCOLOR
|
|
Next
|
|
Exit Sub
|
|
|
|
ErrLine:
|
|
Err.Clear
|
|
Exit Sub
|
|
End Sub
|
|
|
|
|
|
' ******************************************************************************************************************************
|
|
' * procedure name: Form_MouseMove
|
|
' * procedure description: Occurs when the user moves the mouse.
|
|
' * Reset control parameter(s) to default setting(s)
|
|
' ******************************************************************************************************************************
|
|
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
|
|
Dim nCount As Long
|
|
On Local Error GoTo ErrLine
|
|
|
|
For nCount = ctrlSourceClip.LBound To ctrlSourceClip.UBound
|
|
If ctrlSourceClip(nCount).BorderColor <> DEFAULT_CLIPBORDERCOLOR Then _
|
|
ctrlSourceClip(nCount).BorderColor = DEFAULT_CLIPBORDERCOLOR
|
|
Next
|
|
Exit Sub
|
|
|
|
ErrLine:
|
|
Err.Clear
|
|
Exit Sub
|
|
End Sub
|
|
|
|
|
|
' ******************************************************************************************************************************
|
|
' * procedure name: fraCommandFixture_MouseMove
|
|
' * procedure description: Occurs when the user moves the mouse.
|
|
' * Reset control parameter(s) to default setting(s)
|
|
' ******************************************************************************************************************************
|
|
Private Sub fraCommandFixture_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
|
|
Dim nCount As Long
|
|
On Local Error GoTo ErrLine
|
|
|
|
For nCount = ctrlSourceClip.LBound To ctrlSourceClip.UBound
|
|
If ctrlSourceClip(nCount).BorderColor <> DEFAULT_CLIPBORDERCOLOR Then _
|
|
ctrlSourceClip(nCount).BorderColor = DEFAULT_CLIPBORDERCOLOR
|
|
Next
|
|
Exit Sub
|
|
|
|
ErrLine:
|
|
Err.Clear
|
|
Exit Sub
|
|
End Sub
|
|
|
|
|
|
' ******************************************************************************************************************************
|
|
' * procedure name: fraOptions_MouseMove
|
|
' * procedure description: Occurs when the user moves the mouse.
|
|
' * Reset control parameter(s) to default setting(s)
|
|
' ******************************************************************************************************************************
|
|
Private Sub fraOptions_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
|
|
Dim nCount As Long
|
|
On Local Error GoTo ErrLine
|
|
|
|
For nCount = ctrlSourceClip.LBound To ctrlSourceClip.UBound
|
|
If ctrlSourceClip(nCount).BorderColor <> DEFAULT_CLIPBORDERCOLOR Then _
|
|
ctrlSourceClip(nCount).BorderColor = DEFAULT_CLIPBORDERCOLOR
|
|
Next
|
|
Exit Sub
|
|
|
|
ErrLine:
|
|
Err.Clear
|
|
Exit Sub
|
|
End Sub
|
|
|
|
|
|
' ******************************************************************************************************************************
|
|
' * procedure name: lblInstructions_MouseMove
|
|
' * procedure description: Occurs when the user moves the mouse.
|
|
' * Reset control parameter(s) to default setting(s)
|
|
' ******************************************************************************************************************************
|
|
Private Sub lblInstructions_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
|
|
Dim nCount As Long
|
|
On Local Error GoTo ErrLine
|
|
|
|
For nCount = ctrlSourceClip.LBound To ctrlSourceClip.UBound
|
|
If ctrlSourceClip(nCount).BorderColor <> DEFAULT_CLIPBORDERCOLOR Then _
|
|
ctrlSourceClip(nCount).BorderColor = DEFAULT_CLIPBORDERCOLOR
|
|
Next
|
|
Exit Sub
|
|
|
|
ErrLine:
|
|
Err.Clear
|
|
Exit Sub
|
|
End Sub
|
|
|
|
|
|
' ******************************************************************************************************************************
|
|
' * procedure name: lblTransitionDescription_MouseMove
|
|
' * procedure description: Occurs when the user moves the mouse.
|
|
' * Reset control parameter(s) to default setting(s)
|
|
' ******************************************************************************************************************************
|
|
Private Sub lblTransitionDescription_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
|
|
Dim nCount As Long
|
|
On Local Error GoTo ErrLine
|
|
|
|
For nCount = ctrlSourceClip.LBound To ctrlSourceClip.UBound
|
|
If ctrlSourceClip(nCount).BorderColor <> DEFAULT_CLIPBORDERCOLOR Then _
|
|
ctrlSourceClip(nCount).BorderColor = DEFAULT_CLIPBORDERCOLOR
|
|
Next
|
|
Exit Sub
|
|
|
|
ErrLine:
|
|
Err.Clear
|
|
Exit Sub
|
|
End Sub
|
|
|
|
|
|
' ******************************************************************************************************************************
|
|
' * procedure name: lbltxtMaxMediaLength_MouseMove
|
|
' * procedure description: Occurs when the user moves the mouse.
|
|
' * Reset control parameter(s) to default setting(s)
|
|
' ******************************************************************************************************************************
|
|
Private Sub lbltxtMaxMediaLength_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
|
|
Dim nCount As Long
|
|
On Local Error GoTo ErrLine
|
|
|
|
For nCount = ctrlSourceClip.LBound To ctrlSourceClip.UBound
|
|
If ctrlSourceClip(nCount).BorderColor <> DEFAULT_CLIPBORDERCOLOR Then _
|
|
ctrlSourceClip(nCount).BorderColor = DEFAULT_CLIPBORDERCOLOR
|
|
Next
|
|
Exit Sub
|
|
|
|
ErrLine:
|
|
Err.Clear
|
|
Exit Sub
|
|
End Sub
|
|
|
|
|
|
' ******************************************************************************************************************************
|
|
' * procedure name: txtMaxMediaLength_MouseMove
|
|
' * procedure description: Occurs when the user moves the mouse.
|
|
' * Reset control parameter(s) to default setting(s)
|
|
' ******************************************************************************************************************************
|
|
Private Sub txtMaxMediaLength_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
|
|
Dim nCount As Long
|
|
On Local Error GoTo ErrLine
|
|
|
|
For nCount = ctrlSourceClip.LBound To ctrlSourceClip.UBound
|
|
If ctrlSourceClip(nCount).BorderColor <> DEFAULT_CLIPBORDERCOLOR Then _
|
|
ctrlSourceClip(nCount).BorderColor = DEFAULT_CLIPBORDERCOLOR
|
|
Next
|
|
Exit Sub
|
|
|
|
ErrLine:
|
|
Err.Clear
|
|
Exit Sub
|
|
End Sub
|
|
|
|
|
|
' **************************************************************************************************************************************
|
|
' * PRIVATE INTERFACE- PROCEDURES
|
|
' *
|
|
' *
|
|
' ******************************************************************************************************************************
|
|
' * procedure name: SpliceVideo
|
|
' * procedure description: Splices a variable number of video files together using the given transition.
|
|
' * DefaultTransitionCLSID evaluates to the CLSID of the desired transition to use.
|
|
' * Files evaluates to a variable number of BSTR String arguments containing the filename(s)
|
|
' ******************************************************************************************************************************
|
|
Private Function SpliceVideo(DefaultTransitionCLSID As String, ParamArray Files()) As AMTimeline
|
|
Dim nCount As Long
|
|
Dim nCount2 As Long
|
|
Dim bstrCurrentFile As String
|
|
Dim boolAudioGroup As Boolean
|
|
Dim boolVideoGroup As Boolean
|
|
Dim dblAudioStartTime As Double
|
|
Dim dblAudioStopTime As Double
|
|
Dim dblVideoStartTime As Double
|
|
Dim dblVideoStopTime As Double
|
|
Dim objTimeline As AMTimeline
|
|
Dim objNewSource As AMTimelineSrc
|
|
Dim objNewTrack As AMTimelineTrack
|
|
Dim objTransition As AMTimelineTrans
|
|
Dim objAudioGroup As AMTimelineGroup
|
|
Dim objVideoGroup As AMTimelineGroup
|
|
Dim objTimelineTrackObject As AMTimelineObj
|
|
Dim objTimelineSourceObject As AMTimelineObj
|
|
Dim objTimelineAudioGroupObject As AMTimelineObj
|
|
Dim objTimelineVideoGroupObject As AMTimelineObj
|
|
On Local Error GoTo ErrLine
|
|
|
|
'instantiate new timeline
|
|
Set objTimeline = CreateTimeline
|
|
|
|
'enable transitions on the timeline
|
|
Call objTimeline.EnableTransitions(1)
|
|
|
|
'enumerate the files and place the group(s) on the timeline
|
|
For nCount = LBound(Files) To UBound(Files)
|
|
If TypeName(Files(nCount)) = "String" Then
|
|
If Files(nCount) <> vbNullString Then
|
|
bstrCurrentFile = Files(nCount)
|
|
If HasStreams(bstrCurrentFile) Then
|
|
If HasAudioStream(bstrCurrentFile) Then
|
|
'enumerate all the groups in the timeline to ensure audio has not yet been added
|
|
If GetGroupCount(objTimeline) > 0 Then
|
|
For nCount2 = 0 To GetGroupCount(objTimeline) - 1
|
|
If Not GroupFromTimeline(objTimeline, nCount2) Is Nothing Then
|
|
If GroupFromTimeline(objTimeline, nCount2).GetGroupName = "AUDIO" Then
|
|
boolAudioGroup = True
|
|
End If
|
|
End If
|
|
Next
|
|
If boolAudioGroup = False Then
|
|
'insert an audio group into the timeline
|
|
Set objAudioGroup = CreateGroup(objTimeline, "AUDIO", DEXMediaTypeAudio)
|
|
Call InsertGroup(objTimeline, objAudioGroup)
|
|
Set objTimelineAudioGroupObject = objAudioGroup
|
|
boolAudioGroup = True
|
|
End If
|
|
Else:
|
|
'insert an audio group into the timeline
|
|
Set objAudioGroup = CreateGroup(objTimeline, "AUDIO", DEXMediaTypeAudio)
|
|
Call InsertGroup(objTimeline, objAudioGroup)
|
|
Set objTimelineAudioGroupObject = objAudioGroup
|
|
boolAudioGroup = True
|
|
End If
|
|
End If
|
|
|
|
If HasVideoStream(bstrCurrentFile) Then
|
|
'enumerate all the groups in the timeline to ensure audio has not yet been added
|
|
If GetGroupCount(objTimeline) > 0 Then
|
|
For nCount2 = 0 To GetGroupCount(objTimeline) - 1
|
|
If Not GroupFromTimeline(objTimeline, nCount2) Is Nothing Then
|
|
If GroupFromTimeline(objTimeline, nCount2).GetGroupName = "VIDEO" Then
|
|
boolVideoGroup = True
|
|
End If
|
|
End If
|
|
Next
|
|
If boolVideoGroup = False Then
|
|
'insert a video group into the timeline
|
|
Set objVideoGroup = CreateGroup(objTimeline, "VIDEO", DEXMediaTypeVideo)
|
|
Call InsertGroup(objTimeline, objVideoGroup)
|
|
Set objTimelineVideoGroupObject = objVideoGroup
|
|
boolVideoGroup = True
|
|
End If
|
|
Else:
|
|
'insert a video group into the timeline
|
|
Set objVideoGroup = CreateGroup(objTimeline, "VIDEO", DEXMediaTypeVideo)
|
|
Call InsertGroup(objTimeline, objVideoGroup)
|
|
Set objTimelineVideoGroupObject = objVideoGroup
|
|
boolVideoGroup = True
|
|
End If
|
|
End If
|
|
End If
|
|
End If
|
|
End If
|
|
Next
|
|
|
|
'enumerate the files and place the tracks/source(s) on the timeline
|
|
For nCount = LBound(Files) To UBound(Files)
|
|
If TypeName(Files(nCount)) = "String" Then
|
|
If Files(nCount) <> vbNullString Then
|
|
bstrCurrentFile = Files(nCount)
|
|
If HasVideoStream(bstrCurrentFile) Then
|
|
'insert a new video track for the clip in the timeline
|
|
Set objNewTrack = CreateTrack(objTimeline)
|
|
Set objTimelineTrackObject = objNewTrack
|
|
Call InsertTrack(objNewTrack, objTimelineVideoGroupObject)
|
|
'inset a new sourceclip into the timeline
|
|
Set objNewSource = CreateSource(objTimeline)
|
|
'insert the new source clip into the new track
|
|
If dblVideoStopTime = 0 Then
|
|
dblVideoStartTime = m_nMaximumClipLength * (nCount): dblVideoStopTime = (m_nMaximumClipLength * (nCount + 1)) + 1
|
|
Else: dblVideoStartTime = (m_nMaximumClipLength * (nCount)) - 1: dblVideoStopTime = (m_nMaximumClipLength * (nCount + 1)) + 1
|
|
End If
|
|
Call InsertSource(objNewTrack, objNewSource, bstrCurrentFile, dblVideoStartTime, dblVideoStopTime)
|
|
'insert a new transition into each track on the timeline
|
|
If DefaultTransitionCLSID <> vbNullString Then
|
|
Set objTransition = CreateTransition(objTimeline)
|
|
dblVideoStartTime = ((m_nMaximumClipLength * (nCount))) - 1: dblVideoStopTime = (m_nMaximumClipLength * nCount + 1)
|
|
If dblVideoStartTime < 0 Then dblVideoStartTime = 0
|
|
Call InsertTransition(objTransition, objTimelineTrackObject, DefaultTransitionCLSID, dblVideoStartTime, dblVideoStopTime)
|
|
End If
|
|
End If
|
|
|
|
If HasAudioStream(bstrCurrentFile) Then
|
|
'insert a new audio track for the clip in the timeline
|
|
Set objNewTrack = CreateTrack(objTimeline)
|
|
Set objTimelineTrackObject = objNewTrack
|
|
Call InsertTrack(objNewTrack, objTimelineAudioGroupObject)
|
|
'inset a new sourceclip into the timeline
|
|
Set objNewSource = CreateSource(objTimeline)
|
|
'insert the new source clip into the new track
|
|
If dblAudioStopTime = 0 Then
|
|
dblAudioStartTime = m_nMaximumClipLength * (nCount): dblAudioStopTime = (m_nMaximumClipLength * (nCount + 1)) + 1
|
|
Else: dblAudioStartTime = (m_nMaximumClipLength * (nCount)) - 1: dblAudioStopTime = (m_nMaximumClipLength * (nCount + 1)) + 1
|
|
End If
|
|
Call InsertSource(objNewTrack, objNewSource, bstrCurrentFile, dblAudioStartTime, dblAudioStopTime)
|
|
End If
|
|
End If
|
|
End If
|
|
Next
|
|
|
|
'return the timeline
|
|
If Not objTimeline Is Nothing Then Set SpliceVideo = objTimeline
|
|
|
|
'clean-up & dereference
|
|
If Not objTimeline Is Nothing Then Set objTimeline = Nothing ' AMTimeline
|
|
If Not objNewSource Is Nothing Then Set objNewSource = Nothing ' AMTimelineSrc
|
|
If Not objNewTrack Is Nothing Then Set objNewTrack = Nothing ' AMTimelineTrack
|
|
If Not objTransition Is Nothing Then Set objTransition = Nothing ' AMTimelineTrans
|
|
If Not objAudioGroup Is Nothing Then Set objAudioGroup = Nothing ' AMTimelineGroup
|
|
If Not objVideoGroup Is Nothing Then Set objVideoGroup = Nothing ' AMTimelineGroup
|
|
If Not objTimelineTrackObject Is Nothing Then Set objTimelineTrackObject = Nothing ' AMTimelineObj
|
|
If Not objTimelineSourceObject Is Nothing Then Set objTimelineSourceObject = Nothing ' AMTimelineObj
|
|
If Not objTimelineAudioGroupObject Is Nothing Then Set objTimelineAudioGroupObject = Nothing ' AMTimelineObj
|
|
If Not objTimelineVideoGroupObject Is Nothing Then Set objTimelineVideoGroupObject = Nothing ' AMTimelineObj
|
|
Exit Function
|
|
|
|
ErrLine:
|
|
Err.Clear
|
|
Exit Function
|
|
End Function
|
|
|
|
|
|
|
|
' ******************************************************************************************************************************
|
|
' * procedure name: ViewTransitionFriendlyNamesDirect
|
|
' * procedure description: Maps transition friendly names to a combobox for easy viewing.
|
|
' *
|
|
' ******************************************************************************************************************************
|
|
Private Sub ViewTransitionFriendlyNamesDirect(cmbComboBox As Control)
|
|
On Local Error GoTo ErrLine
|
|
|
|
If Not cmbComboBox Is Nothing Then
|
|
If TypeName(cmbComboBox) = "ComboBox" Then
|
|
With cmbComboBox
|
|
.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
|
|
End If
|
|
End If
|
|
Exit Sub
|
|
|
|
ErrLine:
|
|
Err.Clear
|
|
Exit Sub
|
|
End Sub
|
|
|
|
|
|
' ******************************************************************************************************************************
|
|
' * procedure name: AppEnable
|
|
' * procedure description: Enabled/Disables the application's controls.
|
|
' *
|
|
' ******************************************************************************************************************************
|
|
Private Sub AppEnable(EnableControls As Boolean, Optional EnableDragDrop As Boolean = True, Optional EnableExit As Boolean = True)
|
|
On Local Error GoTo ErrLine
|
|
|
|
'enable/disable controls
|
|
If EnableControls Then
|
|
cmdPlay.Enabled = True
|
|
cmdWriteAVI.Enabled = True
|
|
cmdWriteXTL.Enabled = True
|
|
Else
|
|
cmdPlay.Enabled = False
|
|
cmdWriteAVI.Enabled = False
|
|
cmdWriteXTL.Enabled = False
|
|
End If
|
|
|
|
'enable/disable drag/drop
|
|
If EnableDragDrop Then
|
|
m_boolEnableDragDrop = True
|
|
Else: m_boolEnableDragDrop = False
|
|
End If
|
|
|
|
'enable/disable exit
|
|
If EnableExit Then
|
|
cmdExit.Enabled = True
|
|
Else: cmdExit.Enabled = False
|
|
End If
|
|
Exit Sub
|
|
|
|
ErrLine:
|
|
Err.Clear
|
|
Exit Sub
|
|
End Sub
|