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,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.
|
||||
|
||||
Reference in New Issue
Block a user