117 lines
4 KiB
Text
117 lines
4 KiB
Text
|
VERSION 5.00
|
||
|
|
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
|
||
|
|
Begin VB.Form frmCustLoop
|
||
|
|
AutoRedraw = -1 'True
|
||
|
|
BorderStyle = 3 'Fixed Dialog
|
||
|
|
Caption = "BASS custom looping example (left-click to set loop start, right-click to set end)"
|
||
|
|
ClientHeight = 3015
|
||
|
|
ClientLeft = 45
|
||
|
|
ClientTop = 330
|
||
|
|
ClientWidth = 9000
|
||
|
|
BeginProperty Font
|
||
|
|
Name = "MS Sans Serif"
|
||
|
|
Size = 9.75
|
||
|
|
Charset = 177
|
||
|
|
Weight = 700
|
||
|
|
Underline = 0 'False
|
||
|
|
Italic = 0 'False
|
||
|
|
Strikethrough = 0 'False
|
||
|
|
EndProperty
|
||
|
|
LinkTopic = "Form1"
|
||
|
|
MaxButton = 0 'False
|
||
|
|
MinButton = 0 'False
|
||
|
|
ScaleHeight = 201
|
||
|
|
ScaleMode = 3 'Pixel
|
||
|
|
ScaleWidth = 600
|
||
|
|
StartUpPosition = 2 'CenterScreen
|
||
|
|
Begin VB.Timer tmrCustLoop
|
||
|
|
Enabled = 0 'False
|
||
|
|
Interval = 100
|
||
|
|
Left = 7800
|
||
|
|
Top = 2400
|
||
|
|
End
|
||
|
|
Begin MSComDlg.CommonDialog cmdCustLoop
|
||
|
|
Left = 8400
|
||
|
|
Top = 2400
|
||
|
|
_ExtentX = 847
|
||
|
|
_ExtentY = 847
|
||
|
|
_Version = 393216
|
||
|
|
End
|
||
|
|
End
|
||
|
|
Attribute VB_Name = "frmCustLoop"
|
||
|
|
Attribute VB_GlobalNameSpace = False
|
||
|
|
Attribute VB_Creatable = False
|
||
|
|
Attribute VB_PredeclaredId = True
|
||
|
|
Attribute VB_Exposed = False
|
||
|
|
'/////////////////////////////////////////////////////////////////////////////////
|
||
|
|
' frmCustLoop.frm - Copyright (c) 2004-2007 (: JOBnik! :) [Arthur Aminov, ISRAEL]
|
||
|
|
' [http://www.jobnik.org]
|
||
|
|
' [ jobnik@jobnik.org ]
|
||
|
|
' Other source: modCustLoop.bas
|
||
|
|
'
|
||
|
|
' BASS custom looping example
|
||
|
|
' Originally translated from - custloop.c - Example of Ian Luck
|
||
|
|
'/////////////////////////////////////////////////////////////////////////////////
|
||
|
|
|
||
|
|
Option Explicit
|
||
|
|
|
||
|
|
Private Sub Form_Load()
|
||
|
|
' change and set the current path, to prevent from VB not finding BASS.DLL
|
||
|
|
Call ChDrive(App.Path)
|
||
|
|
Call ChDir(App.Path)
|
||
|
|
|
||
|
|
' check the correct BASS was loaded
|
||
|
|
If (HiWord(BASS_GetVersion) <> BASSVERSION) Then
|
||
|
|
Call MsgBox("An incorrect version of BASS.DLL was loaded", vbCritical)
|
||
|
|
End
|
||
|
|
End If
|
||
|
|
|
||
|
|
' initialize BASS
|
||
|
|
If (BASS_Init(-1, 44100, 0, Me.hWnd, 0) = 0) Then
|
||
|
|
Call Error_("Can't initialize device")
|
||
|
|
End
|
||
|
|
End If
|
||
|
|
|
||
|
|
If (Not PlayFile) Then ' start a file playing
|
||
|
|
Call BASS_Free
|
||
|
|
End
|
||
|
|
End If
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Private Sub Form_Unload(Cancel As Integer)
|
||
|
|
killscan = True
|
||
|
|
tmrCustLoop.Enabled = False
|
||
|
|
Call BASS_Free
|
||
|
|
End
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
|
||
|
|
If (Button = vbLeftButton) Then ' set loop start
|
||
|
|
Call SetLoopStart(X * bpp)
|
||
|
|
Call DrawTimeLine(Me.hdc, loop_(0), &HFFFF00, 12) ' loop start
|
||
|
|
ElseIf (Button = vbRightButton) Then ' set loop end
|
||
|
|
Call SetLoopEnd(X * bpp)
|
||
|
|
Call DrawTimeLine(Me.hdc, loop_(1), vbYellow, 24) ' loop end
|
||
|
|
End If
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
|
||
|
|
If ((X >= 0) And (X < WIDTH_)) Then
|
||
|
|
If (Button = vbLeftButton) Then
|
||
|
|
Call SetLoopStart(X * bpp)
|
||
|
|
ElseIf (Button = vbRightButton) Then
|
||
|
|
Call SetLoopEnd(X * bpp)
|
||
|
|
End If
|
||
|
|
End If
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Private Sub tmrCustLoop_Timer()
|
||
|
|
With Me
|
||
|
|
' draw buffered peak waveform
|
||
|
|
Call SetDIBitsToDevice(.hdc, 0, 0, WIDTH_, HEIGHT_, 0, 0, 0, HEIGHT_, wavebuf(-(WIDTH_ / 2)), bh, 0)
|
||
|
|
Call DrawTimeLine(.hdc, BASS_ChannelGetPosition(chan, BASS_POS_BYTE), &HFFFFFF, 0) ' current pos
|
||
|
|
Call DrawTimeLine(.hdc, loop_(0), &HFFFF00, 12) ' loop start
|
||
|
|
Call DrawTimeLine(.hdc, loop_(1), vbYellow, 24) ' loop end
|
||
|
|
End With
|
||
|
|
End Sub
|