GFInfoTrailer/GFInfoTrailer_Layercls.cls
VERSION 1.0 CLASS
BEGIN
MultiUse = ‑1 'True
END
Attribute VB_Name = "GFInfoTrailer_Layercls"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'(c)2001, 2002 by Louis.
'Draw
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
'GFPlayWaveFile
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
'GFPlayWaveFile
Const SND_SYNC = &H0 'play synchronously (default)
Const SND_ASYNC = &H1 'play asynchronously
Const SND_NODEFAULT = &H2 'silence not default, if sound not found
'GFPlayWaveFile
Const SND_ABORT As String = "" 'self‑made
Const SND_SILENCE As String = SND_ABORT 'self‑made
'CollectingPictureStruct ‑ information about the GFInfoTrailerCollectingPicture (where trailer will be shown)
Private Type CollectingPictureStruct
CollectingPicture As PictureBox
CollectingPictureQuakeEnabledFlag As Boolean
CollectingPictureXSize As Long
CollectingPictureYSize As Long
End Type
Private CollectingPictureStructVar As CollectingPictureStruct
'CreationPictureStruct
Private Type CreationPictureStruct
YDrawSpeed As Single 'number of new frames in every loop (number of pixels moved)
YDrawSpeedOld As Single 'used by the DRAWSPEED[SAVE/RECOVER] objects
YDrawStartPos As Single 'use Single to allow pauses
YDrawStartPosOld As Single 'use Single to allow pauses
YDrawStartPosMax As Single 'DrawLoop() will be quit when this value is reached
TopSizeExtension As Long 'not visible y size 'over' visible area
BottomSizeExtension As Long 'not visible y size 'below' visible area
LayerIndex As Integer
End Type
Private CreationPictureStructVar As CreationPictureStruct
'ObjectStruct
Private Type ObjectStruct
ObjectName As String
ObjectType As Integer
wParam As String
lParam As String
ObjectXPos As Long
ObjectYPos As Long 'absolute position
ObjectXSize As Long
ObjectYSize As Long
End Type
Private ObjectStructNumber As Integer
Private ObjectStructArray() As ObjectStruct
'ObjectAddStruct ‑ contains information needed to add an object to the struct array
Private Type ObjectAddStruct
ObjectYPosNext As Long
ObjectAVIAvailableFlag As Boolean 'only True if this layer is layer #1
End Type
Dim ObjectAddStructVar As ObjectAddStruct
'ObjectImageStruct ‑ contains data related to ObjectCreationPicture()
Private Type ObjectImageStruct
LayerIndex As Integer
End Type
Private ObjectImageStructVar As ObjectImageStruct
'FontStruct
'
'NOTE: The lParam of a text object contains the
'name of the related font object.
'
Private Type FontStruct
FontDescription As String 'NOTE: as FontName is already existing, FontDescription is used.
FontName As String '(Font.Name)
FontSize As Single
FontBoldFlag As Boolean
FontItalicFlag As Boolean
FontUnderlineFlag As Boolean
FontStrikeThroughFlag As Boolean
FontColor As Long
FontBlockXSizeMax As Long
End Type
Dim FontStructNumber As Integer
Dim FontStructArray() As FontStruct
'Draw
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'*****************************************LAYER*****************************************
Public Sub Layer_Initialize(ByRef CollectingPicture As PictureBox, ByRef TargetPicture As PictureBox, ByVal LayerIndex As Integer)
'On Error Resume Next
'CollectingPicture
Set CollectingPictureStructVar.CollectingPicture = CollectingPicture
CollectingPictureStructVar.CollectingPicture.AutoRedraw = True
CollectingPictureStructVar.CollectingPicture.ScaleMode = vbPixels
CollectingPictureStructVar.CollectingPictureXSize = CollectingPicture.ScaleWidth
CollectingPictureStructVar.CollectingPictureYSize = CollectingPicture.ScaleHeight
CollectingPictureStructVar.CollectingPictureQuakeEnabledFlag = False 'reset
With GFInfoTrailerfrm
'CreationPicture
CreationPictureStructVar.LayerIndex = LayerIndex
If .CreationPicture.UBound < LayerIndex Then 'verify (important)
Load .CreationPicture(CreationPictureStructVar.LayerIndex)
End If
.CreationPicture(CreationPictureStructVar.LayerIndex).AutoRedraw = True
.CreationPicture(CreationPictureStructVar.LayerIndex).ScaleMode = vbPixels
.CreationPicture(CreationPictureStructVar.LayerIndex).BackColor = CollectingPictureStructVar.CollectingPicture.BackColor
.CreationPicture(CreationPictureStructVar.LayerIndex).Width = CollectingPictureStructVar.CollectingPicture.Width
.CreationPicture(CreationPictureStructVar.LayerIndex).Height = 3 * CollectingPictureStructVar.CollectingPicture.Height
CreationPictureStructVar.TopSizeExtension = CollectingPictureStructVar.CollectingPicture.ScaleHeight
CreationPictureStructVar.BottomSizeExtension = CollectingPictureStructVar.CollectingPicture.ScaleHeight
CreationPictureStructVar.YDrawSpeed = 1 'preset
CreationPictureStructVar.YDrawStartPosOld = 0 'important or very first objects will be at false position (see (*))
'ObjectPicture
ObjectImageStructVar.LayerIndex = LayerIndex
If .ObjectImagePicture.UBound < LayerIndex Then 'verify (important)
Load .ObjectImagePicture(ObjectImageStructVar.LayerIndex)
End If
.ObjectImagePicture(ObjectImageStructVar.LayerIndex).AutoRedraw = True
.ObjectImagePicture(ObjectImageStructVar.LayerIndex).AutoSize = True 'important
.ObjectImagePicture(ObjectImageStructVar.LayerIndex).ScaleMode = vbPixels
.ObjectImagePicture(ObjectImageStructVar.LayerIndex).BackColor = CollectingPictureStructVar.CollectingPicture.BackColor
End With
'other
If LayerIndex = 1 Then
ObjectAddStructVar.ObjectAVIAvailableFlag = True
'NOTE: the Animation Control code does not work properly at the moment.
'Call AnimationControl_Create(GFINFOTRAILER_ANIMATIONCONTROL, 0, 0, TargetPicture)
'Call AnimationControl_Hide(GFINFOTRAILER_ANIMATIONCONTROL)
Else
ObjectAddStructVar.ObjectAVIAvailableFlag = False
End If
End Sub
Public Sub Layer_AddObject(ByVal ObjectType As Integer, ByVal wParam As String, ByVal lParam As String, Optional ByVal ObjectXPos As Long = OBJECTXPOS_CENTERED, Optional ByVal ObjectNamePassed As String = "")
'On Error Resume Next
Dim ObjectName As String
'verify
If ObjectNamePassed = "" Then
ObjectName = GetDefaultObjectName()
Else
ObjectName = ObjectNamePassed
End If
'begin
Select Case ObjectType
Case OBJECTTYPE_AVI
If ObjectAddStructVar.ObjectAVIAvailableFlag = True Then
Call Object_Add(ObjectName, ObjectType, wParam, lParam, ObjectXPos)
End If
Case OBJECTTYPE_PAUSE
If Val(wParam) < 0 Then wParam = "0" 'verify
If Val(wParam) > 3600 Then wParam = "3600" 'verify
Call Object_Add(GetDefaultObjectName(), OBJECTTYPE_SAVEDRAWSPEED, "", "", CONST_CENTERED)
Call Me.Layer_MoveYPos(0)
Call Object_Add(GetDefaultObjectName(), OBJECTTYPE_SPEEDCONTROL, CStr(1! / CSng(Val(wParam))), "", CONST_CENTERED)
Call Me.Layer_MoveYPos(1)
Call Object_Add(GetDefaultObjectName(), OBJECTTYPE_RECOVERDRAWSPEED, "", "", CONST_CENTERED)
Case OBJECTTYPE_QUAKE
'
'NOTE: a quake lasts for 0.5 seconds. As the collecting picture is redrawn
'with 25 frames per second also in pauses shaking the collecting picture image
'is no problem.
'
Call Object_Add(GetDefaultObjectName(), OBJECTTYPE_SAVEDRAWSPEED, "", "", CONST_CENTERED)
Call Object_Add(GetDefaultObjectName(), OBJECTTYPE_QUAKEENABLE, "", "", CONST_CENTERED)
Call Me.Layer_MoveYPos(0)
Call Object_Add(GetDefaultObjectName(), OBJECTTYPE_SPEEDCONTROL, LTrim$(Str$(1! / CSng(0.5))), "", CONST_CENTERED)
Call Me.Layer_MoveYPos(1)
Call Object_Add(GetDefaultObjectName(), OBJECTTYPE_QUAKEDISABLE, "", "", CONST_CENTERED)
Call Object_Add(GetDefaultObjectName(), OBJECTTYPE_RECOVERDRAWSPEED, "", "", CONST_CENTERED)
Case Else
Call Object_Add(ObjectName, ObjectType, wParam, lParam, ObjectXPos)
End Select
End Sub
Public Sub Layer_AddFont(ByVal FontName As String, ByVal FontSize As Single, ByVal FontBoldFlag As Boolean, ByVal FontItalicFlag As Boolean, ByVal FontUnderlineFlag As Boolean, ByVal FontStrikeThroughFlag As Boolean, ByVal FontColor As Long, ByVal FontBlockXSizeMax As Long, Optional ByVal FontDescriptionPassed As String = "")
'On Error Resume Next
Dim FontDescription As String
'preset
If FontDescriptionPassed = "" Then 'verify
FontDescription = GetDefaultFontName()
Else
FontDescription = FontDescriptionPassed
End If
'begin
Call Font_Add(FontDescription, FontName, FontSize, FontBoldFlag, FontItalicFlag, FontUnderlineFlag, FontStrikeThroughFlag, FontColor, FontBlockXSizeMax)
End Sub
Public Sub Layer_MoveYPos(ByVal MoveAmount As Long)
'On Error Resume Next 'call to influence the next object's y position
ObjectAddStructVar.ObjectYPosNext = ObjectAddStructVar.ObjectYPosNext + MoveAmount
End Sub
Public Sub Layer_MoveToYPos(ByVal MovePosition As Long)
'On Error Resume Next 'call to influence the next object's y position
ObjectAddStructVar.ObjectYPosNext = MovePosition
End Sub
Public Sub Layer_MoveYPosToNextObject()
'On Error Resume Next
Call Layer_MoveYPos(Me.GETLASTADDEDSIZEOBJECTHEIGHT)
End Sub
Public Sub Layer_Reset()
'On Error Resume Next 'call to create a new 'show'
ObjectStructNumber = 0 'reset
ReDim ObjectStructArray(1 To 1) As ObjectStruct
FontStructNumber = 0 'reset
ReDim FontStructArray(1 To 1) As FontStruct
ObjectAddStructVar.ObjectYPosNext = 0 'reset
'NOTE: Layer_Initialize() needn't to be called again.
End Sub
Public Sub Layer_Destroy()
'On Error Resume Next 'call when unloading target project
'reset
Call Layer_Reset
'begin
If ObjectAddStructVar.ObjectAVIAvailableFlag = True Then
'NOTE: the Animation Control code does not work properly at the moment.
'Call AnimationControl_Destroy(GFINFOTRAILER_ANIMATIONCONTROL)
End If
'NOTE: verifying UBound did not work, make sure layer to destroy was intialized.
If Not (GFInfoTrailerfrm.CreationPicture.UBound < CreationPictureStructVar.LayerIndex) Then 'verify
Unload GFInfoTrailerfrm.CreationPicture(CreationPictureStructVar.LayerIndex)
End If
If Not (GFInfoTrailerfrm.ObjectImagePicture.UBound < ObjectImageStructVar.LayerIndex) Then 'verify
Unload GFInfoTrailerfrm.ObjectImagePicture(ObjectImageStructVar.LayerIndex)
End If
End Sub
'*************************************END OF LAYER**************************************
'*****************************************FONT******************************************
Private Sub Font_Add(ByVal FontDescription As String, ByVal FontName As String, ByVal FontSize As Single, ByVal FontBoldFlag As Boolean, ByVal FontItalicFlag As Boolean, ByVal FontUnderlineFlag As Boolean, ByVal FontStrikeThroughFlag As Boolean, ByVal FontColor As Long, ByVal FontBlockXSizeMax As Long)
'On Error Resume Next
Dim FontLoop As Integer
'verify
For FontLoop = 1 To Screen.FontCount
If UCase$(Screen.Fonts(FontLoop)) = UCase$(FontName) Then GoTo Jump:
Next FontLoop
FontName = "Arial"
Jump:
'begin
If Not (FontStructNumber = 32766) Then 'Verify
FontStructNumber = FontStructNumber + 1
Else
MsgBox "internal error in Font_Add() (Layer): overflow !", vbOKOnly + vbExclamation
Exit Sub 'error
End If
ReDim Preserve FontStructArray(1 To FontStructNumber) As FontStruct
FontStructArray(FontStructNumber).FontDescription = FontDescription
FontStructArray(FontStructNumber).FontName = FontName
FontStructArray(FontStructNumber).FontSize = FontSize
FontStructArray(FontStructNumber).FontBoldFlag = FontBoldFlag
FontStructArray(FontStructNumber).FontItalicFlag = FontItalicFlag
FontStructArray(FontStructNumber).FontUnderlineFlag = FontUnderlineFlag
FontStructArray(FontStructNumber).FontStrikeThroughFlag = FontStrikeThroughFlag
FontStructArray(FontStructNumber).FontColor = FontColor
FontStructArray(FontStructNumber).FontBlockXSizeMax = FontBlockXSizeMax
End Sub
'**************************************END OF FONT**************************************
'****************************************OBJECT*****************************************
Private Sub Object_Add(ByVal ObjectName As String, ByVal ObjectType As Integer, ByVal wParam As String, ByVal lParam As String, ByVal ObjectXPos As Long)
'On Error Resume Next 'adds an object to be displayed during trailer show
'
'NOTE: the following object types are currently available:
'OBJECTTYPE_TEXT: wParam: text, lParam: name of related FontStructArray() element
'OBJECTTYPE_PICTURE: wParam: picture file path, lParam: [unused]
'OBEJCTTYPE_AVI: wParam: avi file path, lParam: repeat rate (‑1: endless repeat)
'OBJECTTYPE_WAVE: wParam: wave file path, lParam: [unused]
'OBJECTTYPE_SPEEDCONTROL: wParam: number of new frames per second, lParam: [unused]
'OBJECTTYPE_PAUSE: wParam: pause time in seconds, lParam: [unused]
'OBJECTTYPE_QUAKE: [w/l]Param: [unused]
'
If Not (ObjectStructNumber = 32766) Then 'verify
ObjectStructNumber = ObjectStructNumber + 1
Else
MsgBox "internal error in Object_Add() (Layer): overflow !", vbOKOnly + vbExclamation
Exit Sub 'error
End If
ReDim Preserve ObjectStructArray(1 To ObjectStructNumber) As ObjectStruct
ObjectStructArray(ObjectStructNumber).ObjectName = ObjectName
ObjectStructArray(ObjectStructNumber).ObjectType = ObjectType
ObjectStructArray(ObjectStructNumber).wParam = wParam
ObjectStructArray(ObjectStructNumber).lParam = lParam
ObjectStructArray(ObjectStructNumber).ObjectXPos = ObjectXPos
ObjectStructArray(ObjectStructNumber).ObjectYPos = ObjectAddStructVar.ObjectYPosNext
Call ObjectImage_Create(ObjectName) 'important
ObjectStructArray(ObjectStructNumber).ObjectXSize = ObjectImage_GetWidth()
ObjectStructArray(ObjectStructNumber).ObjectYSize = ObjectImage_GetHeight()
End Sub
'NOTE: the following object size functions must all accept
'LASTADDEDOBJECT and LASTADDEDSIZEOBJECT
'as object name.
Public Function GetObjectXPos(ByVal ObjectName As String) As Long
'On Error Resume Next 'returns object x pos or True for error (object x pos may be 0)
Dim ObjectStructPointer As Integer
Dim ObjectLoop As Integer
'preset
Select Case ObjectName
Case LASTADDEDOBJECT
ObjectStructPointer = ObjectStructNumber
Case LASTADDEDSIZEOBJECT
ObjectStructPointer = 0 'preset
For ObjectLoop = ObjectStructNumber To 1 Step (‑1)
Select Case ObjectStructArray(ObjectLoop).ObjectType
Case OBJECTTYPE_TEXT, OBJECTTYPE_PICTURE
ObjectStructPointer = ObjectLoop
Exit For
End Select
Next ObjectLoop
Case Else
ObjectStructPointer = GetObjectStructPointer(ObjectName)
End Select
'begin
If Not (ObjectStructPointer < 1) Then 'verify
GetObjectXPos = ObjectStructArray(ObjectStructPointer).ObjectXPos
Exit Function 'ok
End If
GetObjectXPos = True
Exit Function 'error
End Function
Public Function GetObjectYPos(ByVal ObjectName As String) As Long
'On Error Resume Next 'returns object y pos or True for error (object x pos may be 0)
Dim ObjectStructPointer As Integer
Dim ObjectLoop As Integer
'preset
Select Case ObjectName
Case LASTADDEDOBJECT
ObjectStructPointer = ObjectStructNumber
Case LASTADDEDSIZEOBJECT
ObjectStructPointer = 0 'preset
For ObjectLoop = ObjectStructNumber To 1 Step (‑1)
Select Case ObjectStructArray(ObjectLoop).ObjectType
Case OBJECTTYPE_TEXT, OBJECTTYPE_PICTURE
ObjectStructPointer = ObjectLoop
Exit For
End Select
Next ObjectLoop
Case Else
ObjectStructPointer = GetObjectStructPointer(ObjectName)
End Select
'begin
If Not (ObjectStructPointer < 1) Then 'verify
GetObjectYPos = ObjectStructArray(ObjectStructPointer).ObjectYPos
Exit Function 'ok
End If
GetObjectYPos = True
Exit Function 'error
End Function
Public Function GetObjectWidth(ByVal ObjectName As String) As Long
'On Error Resume Next
GetObjectWidth = GetObjectXSize(ObjectName)
End Function
Public Function GetObjectXSize(ByVal ObjectName As String) As Long
'On Error Resume Next 'returns object x pos or True for error (object x pos may be 0)
Dim ObjectStructPointer As Integer
Dim ObjectLoop As Integer
'preset
Select Case ObjectName
Case LASTADDEDOBJECT
ObjectStructPointer = ObjectStructNumber
Case LASTADDEDSIZEOBJECT
ObjectStructPointer = 0 'preset
For ObjectLoop = ObjectStructNumber To 1 Step (‑1)
Select Case ObjectStructArray(ObjectLoop).ObjectType
Case OBJECTTYPE_TEXT, OBJECTTYPE_PICTURE
ObjectStructPointer = ObjectLoop
Exit For
End Select
Next ObjectLoop
Case Else
ObjectStructPointer = GetObjectStructPointer(ObjectName)
End Select
'begin
If Not (ObjectStructPointer < 1) Then 'verify
GetObjectXSize = ObjectStructArray(ObjectStructPointer).ObjectXSize
Exit Function 'ok
End If
GetObjectXSize = True
Exit Function 'error
End Function
Public Function GetObjectHeight(ByVal ObjectName As String) As Long
'On Error Resume Next
GetObjectHeight = GetObjectYSize(ObjectName)
End Function
Public Function GetObjectYSize(ByVal ObjectName As String) As Long
'On Error Resume Next 'returns object y pos or True for error (object x pos may be 0)
Dim ObjectStructPointer As Integer
Dim ObjectLoop As Integer
'preset
Select Case ObjectName
Case LASTADDEDOBJECT
ObjectStructPointer = ObjectStructNumber
Case LASTADDEDSIZEOBJECT
ObjectStructPointer = 0 'preset
For ObjectLoop = ObjectStructNumber To 1 Step (‑1)
Select Case ObjectStructArray(ObjectLoop).ObjectType
Case OBJECTTYPE_TEXT, OBJECTTYPE_PICTURE
ObjectStructPointer = ObjectLoop
Exit For
End Select
Next ObjectLoop
Case Else
ObjectStructPointer = GetObjectStructPointer(ObjectName)
End Select
'begin
If Not (ObjectStructPointer < 1) Then 'verify
GetObjectYSize = ObjectStructArray(ObjectStructPointer).ObjectYSize
Exit Function 'ok
End If
GetObjectYSize = True
Exit Function 'error
End Function
Public Function SetObjectXSize(ByVal ObjectName As String, ByVal ObjectXSizeNew As Long) As Long
'On Error Resume Next 'use to set an AVI object's width manually (cannot be determined by the system)
Dim ObjectStructPointer As Integer
Dim ObjectLoop As Integer
'preset
Select Case ObjectName
Case LASTADDEDOBJECT
ObjectStructPointer = ObjectStructNumber
Case LASTADDEDSIZEOBJECT
ObjectStructPointer = 0 'preset
For ObjectLoop = ObjectStructNumber To 1 Step (‑1)
Select Case ObjectStructArray(ObjectLoop).ObjectType
Case OBJECTTYPE_TEXT, OBJECTTYPE_PICTURE
ObjectStructPointer = ObjectLoop
Exit For
End Select
Next ObjectLoop
Case Else
ObjectStructPointer = GetObjectStructPointer(ObjectName)
End Select
'begin
If Not (ObjectStructPointer < 1) Then 'verify
ObjectStructArray(ObjectStructPointer).ObjectXSize = ObjectXSizeNew
End If
End Function
Public Sub SetObjectYSize(ByVal ObjectName As String, ByVal ObjectYSizeNew As Long)
'On Error Resume Next 'use to set an AVI object's width manually (cannot be determined by the system)
Dim ObjectStructPointer As Integer
Dim ObjectLoop As Integer
'preset
Select Case ObjectName
Case LASTADDEDOBJECT
ObjectStructPointer = ObjectStructNumber
Case LASTADDEDSIZEOBJECT
ObjectStructPointer = 0 'preset
For ObjectLoop = ObjectStructNumber To 1 Step (‑1)
Select Case ObjectStructArray(ObjectLoop).ObjectType
Case OBJECTTYPE_TEXT, OBJECTTYPE_PICTURE
ObjectStructPointer = ObjectLoop
Exit For
End Select
Next ObjectLoop
Case Else
ObjectStructPointer = GetObjectStructPointer(ObjectName)
End Select
'begin
If Not (ObjectStructPointer < 1) Then 'verify
ObjectStructArray(ObjectStructPointer).ObjectYSize = ObjectYSizeNew
End If
End Sub
'*************************************END OF OBJECT*************************************
'*****************************************OTHER*****************************************
Public Function GETLASTADDEDOBJECTHEIGHT() As Long
'On Error Resume Next 'returns y size of last added object or True for no object found
GETLASTADDEDOBJECTHEIGHT = GetObjectYSize(LASTADDEDOBJECT)
End Function
Public Function GETLASTADDEDSIZEOBJECTHEIGHT() As Long
'On Error Resume Next 'returns y size of last added object that has an y size (text, picture) or True for no object found
GETLASTADDEDSIZEOBJECTHEIGHT = GetObjectYSize(LASTADDEDSIZEOBJECT)
End Function
Public Function GetTrailerWidth() As Long
'On Error Resume Next
GetTrailerWidth = GetTrailerXSize
End Function
Public Function GetTrailerHeight() As Long
'On Error Resume Next
GetTrailerHeight = GetTrailerYSize
End Function
Public Function GetTrailerXSize() As Long
'On Error Resume Next 'returns maximum size an object may have to be completely visible
GetTrailerXSize = CollectingPictureStructVar.CollectingPictureXSize
End Function
Public Function GetTrailerYSize() As Long
'On Error Resume Next 'returns maximum size an object may have to be completely visible
GetTrailerYSize = CollectingPictureStructVar.CollectingPictureYSize
End Function
Public Function GetTextBlock(ByVal TextPassed As String, ByVal FontDescription As String, ByVal TextBlockWidthMax As Long) As String
'On Error Resume Next 'use when creating a text object
Dim FontStructPointer As Integer
'font settings
FontStructPointer = GetFontStructPointer(FontDescription)
If FontStructPointer = 0 Then
'
'NOTE: if "" was passed as font name, the system uses
'the font added at first.
'
If Not (FontStructNumber = 0) Then
FontStructPointer = 1
Else
GoTo Error: 'verify
End If
End If
With GFInfoTrailerfrm
.ObjectImagePicture(ObjectImageStructVar.LayerIndex).Font.Name = FontStructArray(FontStructPointer).FontName
.ObjectImagePicture(ObjectImageStructVar.LayerIndex).Font.Size = FontStructArray(FontStructPointer).FontSize
.ObjectImagePicture(ObjectImageStructVar.LayerIndex).Font.Bold = FontStructArray(FontStructPointer).FontBoldFlag
.ObjectImagePicture(ObjectImageStructVar.LayerIndex).Font.Italic = FontStructArray(FontStructPointer).FontItalicFlag
.ObjectImagePicture(ObjectImageStructVar.LayerIndex).Font.Underline = FontStructArray(FontStructPointer).FontUnderlineFlag
.ObjectImagePicture(ObjectImageStructVar.LayerIndex).Font.StrikeThrough = FontStructArray(FontStructPointer).FontStrikeThroughFlag
End With
'end of font settings
GetTextBlock = ObjectImage_GetPharsedText(TextPassed, TextBlockWidthMax)
Exit Function
Error:
GetTextBlock = "" 'reset (error)
Exit Function
End Function
Private Function GetObjectStructPointer(ByVal ObjectName As String) As Integer
'On Error Resume Next
Dim StructLoop As Integer
For StructLoop = 1 To ObjectStructNumber
If ObjectStructArray(StructLoop).ObjectName = ObjectName Then
GetObjectStructPointer = StructLoop
Exit Function 'ok
End If
Next StructLoop
GetObjectStructPointer = 0
Exit Function 'error
End Function
Private Function GetFontStructPointer(ByVal FontDescription As String) As Integer
'On Error Resume Next
Dim StructLoop As Integer
For StructLoop = 1 To FontStructNumber
If FontStructArray(StructLoop).FontDescription = FontDescription Then
GetFontStructPointer = StructLoop
Exit Function 'ok
End If
Next StructLoop
GetFontStructPointer = 0
Exit Function 'error
End Function
Private Function GetDefaultObjectName() As String
'On Error Resume Next
GetDefaultObjectName = "object #" + LTrim$(Str$(ObjectStructNumber))
End Function
Private Function GetDefaultFontName() As String
'On Error Resume Next
GetDefaultFontName = "font #" + LTrim$(Str$(FontStructNumber))
End Function
'*************************************END OF OTHER**************************************
'*****************************************DRAW******************************************
'NOTE: the Draw sub system creates the rectangular area that will be visible in
'the collecting picture, and transfers it to the collecting picture.
'
'The visible area is created in the CreationPicture.
'All objects that are partially visible in the visible area are drawn.
'***INTERFACE SUBS***
Public Sub Draw(ByVal ForceCreationPictureRedrawFlag As Boolean)
'On Error Resume Next
Dim VisibleArea As RECT 'border coordinates are still visible
Dim VisibleAreaOld As RECT 'border coordinates are still visible
Dim ObjectXPos As Long
Dim ObjectYPos As Long
Dim ObjectVisibleFlag As Boolean
Dim ObjectVisibleFlagOld As Boolean
Dim TargetXPos As Long
Dim TargetYPos As Long
Dim StructLoop As Integer
'preset
'
'NOTE: through using Int() on the value of current draw position it is possible to create
'pauses as the current position value is still increaed, but the visible area does not move.
'
VisibleArea.Top = Int(CreationPictureStructVar.YDrawStartPos)
VisibleArea.Bottom = VisibleArea.Top + CollectingPictureStructVar.CollectingPictureYSize ‑ 1
VisibleArea.Left = 0
VisibleArea.Right = 0 + CollectingPictureStructVar.CollectingPictureXSize
If ForceCreationPictureRedrawFlag = False Then
VisibleAreaOld.Top = Int(CreationPictureStructVar.YDrawStartPosOld)
VisibleAreaOld.Bottom = VisibleAreaOld.Top + CollectingPictureStructVar.CollectingPictureYSize ‑ 1
VisibleAreaOld.Left = 0
VisibleAreaOld.Right = 0 + CollectingPictureStructVar.CollectingPictureXSize
Else
VisibleAreaOld.Top = ‑32767
VisibleAreaOld.Bottom = ‑32767
VisibleAreaOld.Left = ‑32767
VisibleAreaOld.Right = ‑32767
End If
'begin
With GFInfoTrailerfrm
'
'BUG: object must move 'into' the visible area. If a pause is completely 'visible'
'at the very beginning of the show it will not work as the pause's
'OBJECTTYPE_SAVEDRAWSPEED and OBJECTTYPE_RECOVERDRAWSPEED
'is processed in the same loop, Draw() is not left and Me.DrawY[Pos/Speed]
'is not refreshed (see GFInfoTrailermod.DrawLoop()).
'
For StructLoop = 1 To ObjectStructNumber
ObjectVisibleFlag = IsLineOnLine2D(VisibleArea.Top, VisibleArea.Bottom, ObjectStructArray(StructLoop).ObjectYPos, (ObjectStructArray(StructLoop).ObjectYPos + ObjectStructArray(StructLoop).ObjectYSize ‑ 1))
ObjectVisibleFlagOld = IsLineOnLine2D(VisibleAreaOld.Top, VisibleAreaOld.Bottom, ObjectStructArray(StructLoop).ObjectYPos, (ObjectStructArray(StructLoop).ObjectYPos + ObjectStructArray(StructLoop).ObjectYSize ‑ 1))
If (ObjectVisibleFlag = True) And (ObjectVisibleFlagOld = False) Then
'NOTE: the current object is the first time visible in the current frame.
Select Case ObjectStructArray(StructLoop).ObjectType
Case OBJECTTYPE_TEXT, OBJECTTYPE_PICTURE
Call ObjectImage_Create(ObjectStructArray(StructLoop).ObjectName)
'
Select Case ObjectStructArray(StructLoop).ObjectXPos
Case OBJECTXPOS_CENTERED
ObjectXPos = ((VisibleArea.Right ‑ VisibleArea.Left + 1) / 2) ‑ (ObjectImage_GetWidth() / 2)
Case OBJECTXPOS_LEFT
ObjectXPos = 10
Case OBJECTXPOS_RIGHT
ObjectXPos = VisibleArea.Right ‑ ObjectImage_GetWidth() ‑ 10
Case Else
ObjectXPos = ObjectStructArray(StructLoop).ObjectXPos
End Select
'
ObjectYPos = ObjectStructArray(StructLoop).ObjectYPos ‑ VisibleArea.Top + CreationPictureStructVar.TopSizeExtension
'
Call BitBlt(.CreationPicture(CreationPictureStructVar.LayerIndex).hDC, _
ObjectXPos, ObjectYPos, _
ObjectImage_GetWidth(), ObjectImage_GetHeight(), _
.ObjectImagePicture(ObjectImageStructVar.LayerIndex).hDC, 0, 0, vbSrcCopy)
.CreationPicture(CreationPictureStructVar.LayerIndex).Refresh
Case OBJECTTYPE_AVI 'move not‑BitBlted objects here
If Not ((Dir$(ObjectStructArray(StructLoop).wParam) = "") Or (Right$(ObjectStructArray(StructLoop).wParam, 1) = "\") Or (ObjectStructArray(StructLoop).wParam = "")) Then 'verify
If Val(ObjectStructArray(StructLoop).lParam) < (‑1&) Then ObjectStructArray(StructLoop).lParam = "‑1"
If Val(ObjectStructArray(StructLoop).lParam) > 32767& Then ObjectStructArray(StructLoop).lParam = "32767"
Call AnimationControl_Move(GFINFOTRAILER_ANIMATIONCONTROL, (ObjectStructArray(StructLoop).ObjectXPos) * Screen.TwipsPerPixelX, (ObjectStructArray(StructLoop).ObjectYPos ‑ VisibleArea.Top) * Screen.TwipsPerPixelY)
Call AnimationControl_Show(GFINFOTRAILER_ANIMATIONCONTROL)
Call AnimationControl_Open(GFINFOTRAILER_ANIMATIONCONTROL, ObjectStructArray(StructLoop).wParam)
Call AnimationControl_Play(GFINFOTRAILER_ANIMATIONCONTROL, 0, ‑1, Val(ObjectStructArray(StructLoop).lParam))
End If
Case OBJECTTYPE_WAVE
'NOTE: play sound as the sound object would have become visible now
If Not ((Dir$(ObjectStructArray(StructLoop).wParam) = "") Or (Right$(ObjectStructArray(StructLoop).wParam, 1) = "\") Or (ObjectStructArray(StructLoop).wParam = "")) Then 'verify
Call GFPlayWaveFile(ObjectStructArray(StructLoop).wParam)
End If
Case OBJECTTYPE_PAUSE
'
'NOTE: the pause object must be 'split up' into several other objects
'by a higher‑level function of the Layer project.
'
Case OBJECTTYPE_SPEEDCONTROL
CreationPictureStructVar.YDrawSpeed = CSng(ObjectStructArray(StructLoop).wParam) / 25!
Case OBJECTTYPE_SAVEDRAWSPEED
CreationPictureStructVar.YDrawSpeedOld = CreationPictureStructVar.YDrawSpeed
Case OBJECTTYPE_RECOVERDRAWSPEED
If Not (CreationPictureStructVar.YDrawSpeedOld = 0) Then 'verify
CreationPictureStructVar.YDrawSpeed = CreationPictureStructVar.YDrawSpeedOld
Else
CreationPictureStructVar.YDrawSpeed = 1 'reset (default)
End If
Case OBJECTTYPE_QUAKEENABLE
CollectingPictureStructVar.CollectingPictureQuakeEnabledFlag = True
Case OBJECTTYPE_QUAKEDISABLE
CollectingPictureStructVar.CollectingPictureQuakeEnabledFlag = False
End Select
End If
If (ObjectVisibleFlag = True) And (ObjectVisibleFlagOld = True) Then
'NOTE: the current object is and was visible.
Select Case ObjectStructArray(StructLoop).ObjectType
Case OBJECTTYPE_AVI
Call AnimationControl_Move(GFINFOTRAILER_ANIMATIONCONTROL, (ObjectStructArray(StructLoop).ObjectXPos) * Screen.TwipsPerPixelX, (ObjectStructArray(StructLoop).ObjectYPos ‑ VisibleArea.Top) * Screen.TwipsPerPixelY)
End Select
End If
If (ObjectVisibleFlag = False) And (ObjectVisibleFlagOld = True) Then
'NOTE: the current was visible in the last frame only.
Select Case ObjectStructArray(StructLoop).ObjectType
Case OBJECTTYPE_AVI 'move not‑BitBlted objects here
Call AnimationControl_Hide(GFINFOTRAILER_ANIMATIONCONTROL)
End Select
End If
Next StructLoop
'move CreationPicture image
Call BitBlt( _
.CreationPicture(CreationPictureStructVar.LayerIndex).hDC, 0, Int(CreationPictureStructVar.YDrawStartPosOld) ‑ Int(CreationPictureStructVar.YDrawStartPos), _
.CreationPicture(CreationPictureStructVar.LayerIndex).ScaleWidth, .CreationPicture(CreationPictureStructVar.LayerIndex).ScaleHeight, .CreationPicture(CreationPictureStructVar.LayerIndex).hDC, 0, 0, vbSrcCopy)
'(*) (see Layer_Initialize())
'transfer visible are
If CollectingPictureStructVar.CollectingPictureQuakeEnabledFlag = False Then
TargetXPos = 0
TargetYPos = 0
Else
TargetXPos = Int((9 ‑ 1 + 1) * Rnd(1) + 1) ‑ 5
TargetYPos = Int((9 ‑ 1 + 1) * Rnd(1) + 1) ‑ 5
End If
Call BitBlt( _
CollectingPictureStructVar.CollectingPicture.hDC, TargetXPos, TargetYPos, _
CollectingPictureStructVar.CollectingPicture.ScaleWidth, CollectingPictureStructVar.CollectingPicture.ScaleHeight, _
.CreationPicture(CreationPictureStructVar.LayerIndex).hDC, 0, CreationPictureStructVar.TopSizeExtension + 1, vbSrcCopy)
End With
CreationPictureStructVar.YDrawStartPosOld = CreationPictureStructVar.YDrawStartPos
End Sub
Public Property Let YDrawStartPos(ByVal YDrawStartPosPassed As Single)
'On Error Resume Next
CreationPictureStructVar.YDrawStartPos = YDrawStartPosPassed
End Property
Public Property Set YDrawStartPos() As Single
'On Error Resume Next
YDrawStartPos = CreationPictureStructVar.YDrawStartPos
End Property
Public Property Let YDrawSpeed(ByVal YDrawSpeedPassed As Single)
'On Error Resume Next
CreationPictureStructVar.YDrawSpeed = YDrawSpeedPassed
End Property
Public Property Set YDrawSpeed() As Single
'On Error Resume Next
YDrawSpeed = CreationPictureStructVar.YDrawSpeed
End Property
Public Function YDrawStartPosMax_Calculate() As Single
'On Error Resume Next
Dim StructLoop As Integer
For StructLoop = 1 To ObjectStructNumber
If (ObjectStructArray(StructLoop).ObjectYPos + ObjectStructArray(StructLoop).ObjectYSize ‑ 1) > YDrawStartPosMax_Calculate Then
YDrawStartPosMax_Calculate = (ObjectStructArray(StructLoop).ObjectYPos + ObjectStructArray(StructLoop).ObjectYSize ‑ 1)
End If
Next StructLoop
End Function
Public Property Let YDrawStartPosMax(ByVal YDrawStartPosMaxPassed As Single)
'On Error Resume Next
CreationPictureStructVar.YDrawStartPosMax = YDrawStartPosMaxPassed
End Property
Public Property Set YDrawStartPosMax() As Single
'On Error Resume Next
YDrawStartPosMax = CreationPictureStructVar.YDrawStartPosMax
End Property
Public Property Set ObjectCount() As Integer
'On Error Resume Next
ObjectCount = ObjectStructNumber
End Property
'***END OF INTERFACE SUBS***
'**************************************END OF DRAW**************************************
'**************************************OBJECTIMAGE**************************************
'NOTE: the ObjectImage sub system has the task to create a BitBlt‑able image
'of an object, as well as provide object size information.
'Note that the ObjectImage sub system uses the CollectingPictureStrcutVar
'to determine an object's maximum x size.
Private Function ObjectImage_Create(ByVal ObjectName As String) As Boolean
'On Error Resume Next 'returns True if creating a BitBlt‑able object image was successful, False if not
Dim ObjectStructPointer As Integer
Dim FontStructPointer As Integer
Dim ObjectTextString As String
'
'NOTE: the system requires that this sub does not use
'ObjectStructArray().ObjectYPos.
'NOTE: only images of visible objects can be created by this sub.
'
'begin
ObjectStructPointer = GetObjectStructPointer(ObjectName)
If Not (ObjectStructPointer = 0) Then 'verify
With GFInfoTrailerfrm
Select Case ObjectStructArray(ObjectStructPointer).ObjectType
Case OBJECTTYPE_TEXT
'font settings
FontStructPointer = GetFontStructPointer(ObjectStructArray(ObjectStructPointer).lParam)
If FontStructPointer = 0 Then
'
'NOTE: if "" was passed as font name, the system uses
'the font added at very first.
'
If Not (FontStructNumber = 0) Then
FontStructPointer = 1
Else
GoTo Error: 'verify
End If
End If
.ObjectImagePicture(ObjectImageStructVar.LayerIndex).Font.Name = FontStructArray(FontStructPointer).FontName
.ObjectImagePicture(ObjectImageStructVar.LayerIndex).Font.Size = FontStructArray(FontStructPointer).FontSize
.ObjectImagePicture(ObjectImageStructVar.LayerIndex).Font.Bold = FontStructArray(FontStructPointer).FontBoldFlag
.ObjectImagePicture(ObjectImageStructVar.LayerIndex).Font.Italic = FontStructArray(FontStructPointer).FontItalicFlag
.ObjectImagePicture(ObjectImageStructVar.LayerIndex).Font.Underline = FontStructArray(FontStructPointer).FontUnderlineFlag
.ObjectImagePicture(ObjectImageStructVar.LayerIndex).Font.StrikeThrough = FontStructArray(FontStructPointer).FontStrikeThroughFlag
'end of font settings
ObjectTextString = ObjectImage_GetPharsedText(ObjectStructArray(ObjectStructPointer).wParam, FontStructArray(FontStructPointer).FontBlockXSizeMax)
.ObjectImagePicture(ObjectImageStructVar.LayerIndex).Picture = LoadPicture("") 'reset
.ObjectImagePicture(ObjectImageStructVar.LayerIndex).ForeColor = FontStructArray(FontStructPointer).FontColor
.ObjectImagePicture(ObjectImageStructVar.LayerIndex).Cls 'reset
.ObjectImagePicture(ObjectImageStructVar.LayerIndex).CurrentX = 0 'reset (although Cls used)
.ObjectImagePicture(ObjectImageStructVar.LayerIndex).CurrentY = 0 'reset (although Cls used)
.ObjectImagePicture(ObjectImageStructVar.LayerIndex).Width = (.ObjectImagePicture(ObjectImageStructVar.LayerIndex).TextWidth(ObjectTextString) + 4) * Screen.TwipsPerPixelY 'TextWidth() will return text width in the format pixels
.ObjectImagePicture(ObjectImageStructVar.LayerIndex).Height = (.ObjectImagePicture(ObjectImageStructVar.LayerIndex).TextHeight(ObjectTextString) + 4) * Screen.TwipsPerPixelY 'TextHeight() will sum up height of all lines in ObjectTextString (bless it)
.ObjectImagePicture(ObjectImageStructVar.LayerIndex).Print ObjectTextString
Case OBJECTTYPE_PICTURE
If ((Dir$(ObjectStructArray(ObjectStructPointer).wParam) = "") Or (Right$(ObjectStructArray(ObjectStructPointer).wParam, 1) = "\") Or (ObjectStructArray(ObjectStructPointer).wParam = "")) Then 'verify
GoTo Error:
End If
.ObjectImagePicture(ObjectImageStructVar.LayerIndex).Picture = LoadPicture(ObjectStructArray(ObjectStructPointer).wParam)
Case Else
'
'NOTE: the following two lines set the default object
'width and height for invisible objects (0 will not work).
'
.ObjectImagePicture(ObjectImageStructVar.LayerIndex).Height = 1 'reset
.ObjectImagePicture(ObjectImageStructVar.LayerIndex).Width = 1 'reset
End Select
End With
Else
GoTo Error:
End If
ObjectImage_Create = True 'ok
Exit Function
Error:
ObjectImage_Create = False 'error
Exit Function
End Function
Private Function ObjectImage_GetWidth() As Long
'On Error Resume Next 'returns width in pixels of a previously created ObjectImage
ObjectImage_GetWidth = GFInfoTrailerfrm.ObjectImagePicture(ObjectImageStructVar.LayerIndex).ScaleWidth
End Function
Private Function ObjectImage_GetHeight() As Long
'On Error Resume Next 'returns height in pixels of a previously created ObjectImage
ObjectImage_GetHeight = GFInfoTrailerfrm.ObjectImagePicture(ObjectImageStructVar.LayerIndex).ScaleHeight
End Function
Private Function ObjectImage_GetPharsedText(ByVal TEXT As String, ByVal TextBlockXSizeMax As Long) As String
'On Error Resume Next 'inserts Chr$(13) + Chr$(10) into Text if it exceeds the maximum valid size
Dim LineNumber As Integer
Dim LineArray() As String
Dim LineLoop As Long
Dim ReturnString As String
'begin
Call GFGetLineArrayThroughLineWidth(TEXT, TextBlockXSizeMax ‑ 75, 75, " ", LineArray(), LineNumber, GFInfoTrailerfrm.ObjectImagePicture(ObjectImageStructVar.LayerIndex))
For LineLoop = 1 To LineNumber
If Not (LineLoop = LineNumber) Then
ReturnString = ReturnString + LineArray(LineLoop) + Chr$(13) + Chr$(10)
Else
ReturnString = ReturnString + LineArray(LineLoop)
End If
Next LineLoop
ObjectImage_GetPharsedText = ReturnString
End Function
'**********************************END OF OBJECTIMAGE***********************************
'***********************************GENERAL FUNCTIONS***********************************
Private Function IsLineOnLine2D(ByVal Line1XStartPos As Long, ByVal Line1XEndPos As Long, ByVal Line2XStartPos As Long, ByVal Line2XEndPos As Long) As Boolean 'bolongs to GFBlockSmooth()
'On Error Resume Next 'returns True if passed two lines 'touch' each other, False if not
If ((Not (Line1XStartPos < Line2XStartPos)) And (Not (Line1XStartPos > Line2XEndPos))) Or _
((Not (Line1XEndPos < Line2XStartPos)) And (Not (Line1XEndPos > Line2XEndPos))) Then
IsLineOnLine2D = True
Exit Function
End If
If ((Not (Line2XStartPos < Line1XStartPos)) And (Not (Line2XStartPos > Line1XEndPos))) Or _
((Not (Line2XEndPos < Line1XStartPos)) And (Not (Line2XEndPos > Line1XEndPos))) Then
IsLineOnLine2D = True
Exit Function
End If
IsLineOnLine2D = False
Exit Function
End Function
Private Function GFGetLineArrayThroughLineWidth(ByVal InputString As String, ByVal LineWidthMax As Long, ByVal LineWidthOverflowMax As Long, ByVal LineBorderChar As String, ByRef LineArray() As String, ByRef LineNumber As Integer, ByVal LineWidthPicture As PictureBox) As Boolean
'On Error Resume Next 'use as general function to create a text block with defined width; function returns True for success or False for error
Dim Temp As Long
'preset
LineNumber = 0
ReDim LineArray(1 To 1) As String
'verify
If Not (Len(LineBorderChar) = 1) Then
GoTo Error:
End If
If InputString = "" Then
GFGetLineArrayThroughLineWidth = True 'ok
Exit Function
End If
'begin
Temp = 0 'reset
Do
Temp = Temp + 1
If Mid$(InputString, Temp, 2) = Chr$(13) + Chr$(10) Then
If Not (LineNumber = 32766) Then 'verify
LineNumber = LineNumber + 1
Else
GoTo Error:
End If
ReDim Preserve LineArray(1 To LineNumber) As String
LineArray(LineNumber) = Left$(InputString, Temp ‑ 1)
InputString = Right$(InputString, Len(InputString) ‑ Temp ‑ 1)
Temp = 0 'reset
Else
If Mid$(InputString, Temp, 1) = LineBorderChar Then
Select Case LineWidthPicture.TextWidth(Left$(InputString, Temp ‑ 1))
Case Is < LineWidthMax
'do nothing
Case Is >= LineWidthMax
If Not (LineNumber = 32766) Then 'verify
LineNumber = LineNumber + 1
Else
GoTo Error:
End If
ReDim Preserve LineArray(1 To LineNumber) As String
LineArray(LineNumber) = Left$(InputString, Temp ‑ 1)
InputString = Right$(InputString, Len(InputString) ‑ Temp + 0)
Temp = 0 'reset
End Select
Else
Select Case LineWidthPicture.TextWidth(Left$(InputString, Temp ‑ 1))
Case Is < LineWidthMax
'do nothing
Case Is >= (LineWidthMax + LineWidthOverflowMax)
If Not (LineNumber = 32766) Then 'verify
LineNumber = LineNumber + 1
Else
GoTo Error:
End If
ReDim Preserve LineArray(1 To LineNumber) As String
LineArray(LineNumber) = Left$(InputString, Temp ‑ 1)
InputString = Right$(InputString, Len(InputString) ‑ Temp + 1)
Temp = 0 'reset
End Select
End If
End If
If Temp = Len(InputString) Then
If Not (LineNumber = 32766) Then 'verify
LineNumber = LineNumber + 1
Else
GoTo Error:
End If
ReDim Preserve LineArray(1 To LineNumber) As String
LineArray(LineNumber) = InputString
Exit Do
End If
Loop
GFGetLineArrayThroughLineWidth = True 'ok
Exit Function
Error:
MsgBox "internal error in GFGetLineArrayThroughLineWidth() !", vbOKOnly + vbExclamation
GFGetLineArrayThroughLineWidth = False 'error
Exit Function
End Function
Private Sub GFPlayWaveFile(ByVal WaveName As String)
On Error GoTo Error: 'if sound system not available
'
'NOTE: if playing an old wave file is not finished yet, another call of this
'sub will abort playing the old file (use GFPlayWaveFile("") to abort playing).
'
If Not ((Dir$(WaveName) = "") Or (Right$(WaveName, 1) = "\") Or (WaveName = "")) Then 'verify
Call sndPlaySound(WaveName, SND_ASYNC)
Else
If WaveName = "" Then
'abort playing a wave file
Call sndPlaySound("", SND_ASYNC Or SND_NODEFAULT)
Else
'error
MsgBox "internal error in GFPlayWaveFile(): file '" + Left$(WaveName, 512) + "' not found !", vbOKOnly + vbExclamation
End If
End If
Exit Sub
Error:
MsgBox "internal error in GFPlayWaveFile() !", vbOKOnly + vbExclamation
Exit Sub
End Sub
'*******************************END OF GENERAL FUNCTIONS********************************
[END OF FILE]