home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 16
/
CD_ASCQ_16_0994.iso
/
news
/
4609
/
wavplus
/
wavplus.bas
< prev
next >
Wrap
BASIC Source File
|
1994-06-28
|
11KB
|
239 lines
'WavPlus.DLL should be in your Windows\System directory or in the Path
'Assorted functions
Declare Function GetWavPlusVersion% Lib "WavPlus.DLL" ()
Declare Sub RevString Lib "WavPlus.DLL" (ByVal lpString$)
'WAV functions
'non-MCI WAV functions
Declare Function PlayWavWait% Lib "WavPlus.DLL" (ByVal lpString$)
Declare Function PlayWavNoWait% Lib "WavPlus.DLL" (ByVal lpString$)
Declare Function PlayWavLoop% Lib "WavPlus.DLL" (ByVal lpString$)
Declare Function StopWavLoop% Lib "WavPlus.DLL" ()
Declare Function HowManyWavPlayDevices% Lib "WavPlus.DLL" ()
Declare Function HowManyWavRecordDevices% Lib "WavPlus.DLL" ()
'MCI WAV info functions
Declare Sub WavCanPlay Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub WavCanRecord Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub WavMaxBitSize Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub WavMaxChannels Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub WavMaxSampleRate Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub WavGetLengthMS Lib "WavPlus.DLL" (ByVal lpFileName$, ByVal lpString$)
Declare Sub WavGetLengthBytes Lib "WavPlus.DLL" (ByVal lpFileName$, ByVal lpString$)
Declare Sub WavGetBitSize Lib "WavPlus.DLL" (ByVal lpFileName$, ByVal lpString$)
Declare Sub WavGetChannels Lib "WavPlus.DLL" (ByVal lpFileName$, ByVal lpString$)
Declare Sub WavGetSampleRate Lib "WavPlus.DLL" (ByVal lpFileName$, ByVal lpString$)
'MCI WAV open session functions
Declare Sub WavOpen Lib "WavPlus.DLL" (ByVal lpFileName$, ByVal lpString$)
Declare Sub WavOpenNew Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub WavClose Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub WavPause Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub WavResume Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub WavStop Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub WavStart Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub WavStartSectionWait Lib "WavPlus.DLL" (ByVal lpSecStart$, ByVal lpSecEnd$, ByVal lpString$)
Declare Sub WavStartSectionNoWait Lib "WavPlus.DLL" (ByVal lpSecStart$, ByVal lpSecEnd$, ByVal lpString$)
Declare Sub WavSeekEnd Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub WavSeekStart Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub WavSeekPosition Lib "WavPlus.DLL" (ByVal lpStrValue$, ByVal lpString$)
Declare Sub WavStatusMode Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub WavStatusLengthMS Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub WavStatusLengthBytes Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub WavStatusPosition Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub WavStatusBitSize Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub WavStatusChannels Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub WavStatusSampleRate Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub WavRecord Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub WavSave Lib "WavPlus.DLL" (ByVal lpFileName$, ByVal lpString$)
Declare Sub WavEraseAll Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub WavEraseSection Lib "WavPlus.DLL" (ByVal lpSecStart$, ByVal lpSecEnd$, ByVal lpString$)
Declare Sub WavSetBitSize Lib "WavPlus.DLL" (ByVal lpValue$, ByVal lpString$)
Declare Sub WavSetChannels Lib "WavPlus.DLL" (ByVal lpValue$, ByVal lpString$)
Declare Sub WavSetSampleRate Lib "WavPlus.DLL" (ByVal lpValue$, ByVal lpString$)
'MIDI info functions
Declare Function HowManyMidiPlayDevices% Lib "WavPlus.DLL" ()
Declare Function HowManyMidiRecordDevices% Lib "WavPlus.DLL" ()
'MCI Midi open session functions
Declare Sub MidiOpen Lib "WavPlus.DLL" (ByVal lpFileName$, ByVal lpString$)
Declare Sub MidiOpenNew Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub MidiClose Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub MidiPause Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub MidiResume Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub MidiStop Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub MidiStart Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub MidiStartSectionWait Lib "WavPlus.DLL" (ByVal lpSecStart$, ByVal lpSecEnd$, ByVal lpString$)
Declare Sub MidiStartSectionNoWait Lib "WavPlus.DLL" (ByVal lpSecStart$, ByVal lpSecEnd$, ByVal lpString$)
Declare Sub MidiSeekEnd Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub MidiSeekStart Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub MidiSeekPosition Lib "WavPlus.DLL" (ByVal lpStrValue$, ByVal lpString$)
Declare Sub MidiStatusMode Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub MidiStatusLengthMS Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub MidiStatusPosition Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub MidiRecord Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub MidiSave Lib "WavPlus.DLL" (ByVal lpFileName$, ByVal lpString$)
Declare Sub MidiEraseAll Lib "WavPlus.DLL" (ByVal lpString$)
Declare Sub MidiEraseSection Lib "WavPlus.DLL" (ByVal lpSecStart$, ByVal lpSecEnd$, ByVal lpString$)
'Assorted WIN API Functions
Declare Function DestroyWindow% Lib "User" (ByVal hWnd%)
Declare Function GetWindowsDirectory% Lib "Kernel" (ByVal lpBuffer$, ByVal nSize%)
Declare Function OutMessage% Lib "User" Alias "SendMessage" (ByVal hWnd%, ByVal wMsg%, ByVal wParam%, lParam As Any)
Declare Function SendMessage& Lib "User" (ByVal hWnd%, ByVal wMsg%, ByVal wParam%, lParam As Any)
Declare Function WinHelp% Lib "User" (ByVal hWnd%, ByVal lpHelpFile$, ByVal wCommand%, ByVal dwData As Any)
Global Const HELP_CONTENTS = &H3
Global Const HELP_PARTIALKEY = &H105
'program constants
Global Const raised = 1
Global Const sunken = 2
'program variables
Global FormPassString As String 'used to pass strings
Global FormPassString2 As String
Function AddSeparator (ThePath$)
If Right$(ThePath$, 1) <> "\" Then
ThePath$ = ThePath$ + "\"
End If
AddSeparator = ThePath$
End Function
Sub DoControl3D (Obj As Control, Style%, Thick%)
If Thick <= 0 Then Thick = 1
If Thick > 8 Then Thick = 8
OldMode = Obj.Parent.ScaleMode
OldWidth = Obj.Parent.DrawWidth
Obj.Parent.ScaleMode = 3
Obj.Parent.DrawWidth = 1
ObjHeight = Obj.Height
ObjWidth = Obj.Width
ObjLeft = Obj.Left
ObjTop = Obj.Top
Select Case Style
Case sunken:
TLshade = QBColor(8)
BRshade = QBColor(15)
Case raised:
TLshade = QBColor(15)
BRshade = QBColor(8)
End Select
For i = 1 To Thick
CurLeft = ObjLeft - i
CurTop = ObjTop - i
CurWide = ObjWidth + (i * 2) - 1
CurHigh = ObjHeight + (i * 2) - 1
Obj.Parent.Line (CurLeft, CurTop)-Step(CurWide, 0), TLshade
Obj.Parent.Line -Step(0, CurHigh), BRshade
Obj.Parent.Line -Step(-CurWide, 0), BRshade
Obj.Parent.Line -Step(0, -CurHigh), TLshade
Next i
If Thick > 2 Then
CurLeft = ObjLeft - Thick - 1
CurTop = ObjTop - Thick - 1
CurWide = ObjWidth + ((Thick + 1) * 2) - 1
CurHigh = ObjHeight + ((Thick + 1) * 2) - 1
Obj.Parent.Line (CurLeft, CurTop)-Step(CurWide, 0), QBColor(0)
Obj.Parent.Line -Step(0, CurHigh), QBColor(0)
Obj.Parent.Line -Step(-CurWide, 0), QBColor(0)
Obj.Parent.Line -Step(0, -CurHigh), QBColor(0)
End If
Obj.Parent.ScaleMode = OldMode
Obj.Parent.DrawWidth = OldWidth
End Sub
Sub DoForm3D (TheForm As Form, Style%, Thick%, Distance%)
If Thick <= 0 Then Thick = 1
If Thick > 8 Then Thick = 8
If Distance < 0 Then Distance = 0
If Distance > 8 Then Distance = 8
OldMode = TheForm.ScaleMode
OldWidth = TheForm.DrawWidth
TheForm.ScaleMode = 3
TheForm.DrawWidth = 1
FormHeight = TheForm.ScaleHeight
FormWidth = TheForm.ScaleWidth
FormLeft = TheForm.ScaleLeft
FormTop = TheForm.ScaleTop
Select Case Style
Case sunken:
TLshade = QBColor(8)
BRshade = QBColor(15)
Case raised:
TLshade = QBColor(15)
BRshade = QBColor(8)
End Select
Select Case TheForm.BorderStyle
Case 0:
OLshade = QBColor(0)
TheForm.Line (0, 0)-(FormWidth, 0), OLshade
TheForm.Line (0, 0)-(0, FormHeight), OLshade
TheForm.Line (FormWidth - 1, 0)-(FormWidth - 1, FormHeight + 1), OLshade
TheForm.Line (0, FormHeight - 1)-(FormWidth, FormHeight - 1), OLshade
For i = 1 To Thick
CurLeft = FormLeft + i + Distance
CurTop = FormTop + i + Distance
CurWide = FormWidth - (i + Distance) * 2 - 1
CurHigh = FormHeight - (i + Distance) * 2 - 1
TheForm.Line (CurLeft, CurTop)-Step(CurWide, 0), TLshade
TheForm.Line -Step(0, CurHigh), BRshade
TheForm.Line -Step(-CurWide, 0), BRshade
TheForm.Line -Step(0, -CurHigh), TLshade
Next i
Case 1 To 3:
If Thickness = 1 Then
TheForm.Line (Thick, Thick)-(FormWidth - Thick, Thick), TLshade
TheForm.Line (Thick, Thick)-(Thick, FormHeight - Thick), TLshade
TheForm.Line (FormWidth - Thick, Thick)-(FormWidth - Thick, FormHeight - Thick + 1), BRshade
TheForm.Line (Thick, FormHeight - Thick)-(FormWidth - Thick, FormHeight - Thick), BRshade
Else
For i = 1 To Thick
CurLeft = FormLeft + i - 1 + Distance
CurTop = FormTop + i - 1 + Distance
CurWide = FormWidth - (i + Distance) * 2 + 1
CurHigh = FormHeight - (i + Distance) * 2 + 1
TheForm.Line (CurLeft, CurTop)-Step(CurWide, 0), TLshade
TheForm.Line -Step(0, CurHigh), BRshade
TheForm.Line -Step(-CurWide, 0), BRshade
TheForm.Line -Step(0, -CurHigh), TLshade
Next i
End If
End Select
TheForm.ScaleMode = OldMode
TheForm.DrawWidth = OldWidth
End Sub
Sub FormCenterForm (TheForm As Form, MainForm As Form)
TheForm.Move MainForm.Left + (MainForm.Width - TheForm.Width) / 2, MainForm.Top + (MainForm.Height - TheForm.Height) / 2
End Sub
Sub FormCenterScreen (TheForm As Form)
TheForm.Move (Screen.Width - TheForm.Width) / 2, (Screen.Height - TheForm.Height) / 2
End Sub
Function GetWinDir ()
Buffer$ = Space$(255)
count% = GetWindowsDirectory(Buffer$, 255)
GetWinDir = Left$(Buffer$, count%)
End Function
Sub ListHscroll (TheListBox As Control, CharsWide%)
If CharsWide% > 15000 Then CharsWide% = 15000
LongString$ = String$(CharsWide%, "W")
tppx% = Screen.TwipsPerPixelX
MaxiWide% = TheListBox.Parent.TextWidth(LongString$) / tppx%
HscrollLen& = SendMessage(TheListBox.hWnd, 1045, MaxiWide%, 0)
End Sub
Sub TrimAtNull (TheWord$)
pos% = InStr(TheWord$, Chr$(0))
If pos% = 0 Then Exit Sub
TheWord$ = Left$(TheWord$, pos% - 1)
End Sub