home *** CD-ROM | disk | FTP | other *** search
/ Chip 2005 November / CDVD1105.ISO / Software / Freeware / programare / bass / vb / BASStest / frmBassTest.frm (.txt) next >
Encoding:
Visual Basic Form  |  2005-09-20  |  14.3 KB  |  411 lines
  1. VERSION 5.00
  2. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
  3. Begin VB.Form frmBassTest 
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "BASS - Simple Test"
  6.    ClientHeight    =   2655
  7.    ClientLeft      =   45
  8.    ClientTop       =   330
  9.    ClientWidth     =   7830
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    ScaleHeight     =   2655
  13.    ScaleWidth      =   7830
  14.    StartUpPosition =   2  'CenterScreen
  15.    Begin VB.CommandButton cmdResumeAll 
  16.       Caption         =   "Resume"
  17.       Height          =   375
  18.       Left            =   3120
  19.       TabIndex        =   14
  20.       Top             =   2160
  21.       Width           =   1215
  22.    End
  23.    Begin VB.CommandButton cmdStopAll 
  24.       Caption         =   "Stop Everything"
  25.       Height          =   375
  26.       Left            =   1320
  27.       TabIndex        =   13
  28.       Top             =   2160
  29.       Width           =   1695
  30.    End
  31.    Begin VB.Timer tmrBass 
  32.       Enabled         =   0   'False
  33.       Interval        =   250
  34.       Left            =   5160
  35.       Top             =   2160
  36.    End
  37.    Begin VB.Frame frameStream 
  38.       Caption         =   "Stream"
  39.       Height          =   2055
  40.       Left            =   120
  41.       TabIndex        =   12
  42.       Top             =   0
  43.       Width           =   2415
  44.       Begin VB.CommandButton cmdStreamRemove 
  45.          Caption         =   "Remove"
  46.          Height          =   375
  47.          Left            =   1200
  48.          TabIndex        =   18
  49.          Top             =   1560
  50.          Width           =   1095
  51.       End
  52.       Begin VB.CommandButton cmdStreamRestart 
  53.          Caption         =   "Restart"
  54.          Height          =   375
  55.          Left            =   1560
  56.          TabIndex        =   20
  57.          Top             =   1200
  58.          Width           =   735
  59.       End
  60.       Begin VB.CommandButton cmdStreamAdd 
  61.          Caption         =   "Add ..."
  62.          Height          =   375
  63.          Left            =   120
  64.          TabIndex        =   19
  65.          Top             =   1560
  66.          Width           =   1095
  67.       End
  68.       Begin VB.CommandButton cmdStreamStop 
  69.          Caption         =   "Stop"
  70.          Height          =   375
  71.          Left            =   840
  72.          TabIndex        =   21
  73.          Top             =   1200
  74.          Width           =   735
  75.       End
  76.       Begin VB.ListBox lstStream 
  77.          Height          =   840
  78.          Left            =   120
  79.          TabIndex        =   17
  80.          Top             =   240
  81.          Width           =   2175
  82.       End
  83.       Begin VB.CommandButton cmdStreamPlay 
  84.          Caption         =   "Play"
  85.          Height          =   375
  86.          Left            =   120
  87.          TabIndex        =   22
  88.          Top             =   1200
  89.          Width           =   735
  90.       End
  91.    End
  92.    Begin VB.Frame frameSamples 
  93.       Caption         =   "Sample"
  94.       Height          =   2055
  95.       Left            =   5160
  96.       TabIndex        =   7
  97.       Top             =   0
  98.       Width           =   2535
  99.       Begin VB.CommandButton cmdSampleRemove 
  100.          Caption         =   "Remove"
  101.          Height          =   375
  102.          Left            =   1320
  103.          TabIndex        =   11
  104.          Top             =   1560
  105.          Width           =   1095
  106.       End
  107.       Begin VB.CommandButton cmdSampleAdd 
  108.          Caption         =   "Add ..."
  109.          Height          =   375
  110.          Left            =   120
  111.          TabIndex        =   10
  112.          Top             =   1560
  113.          Width           =   1095
  114.       End
  115.       Begin VB.ListBox lstSamples 
  116.          Height          =   840
  117.          Left            =   120
  118.          TabIndex        =   9
  119.          Top             =   240
  120.          Width           =   2295
  121.       End
  122.       Begin VB.CommandButton cmdSamplePlay 
  123.          Caption         =   "Play"
  124.          Height          =   375
  125.          Left            =   120
  126.          TabIndex        =   8
  127.          Top             =   1200
  128.          Width           =   2295
  129.       End
  130.    End
  131.    Begin MSComDlg.CommonDialog DLG 
  132.       Left            =   4560
  133.       Top             =   2160
  134.       _ExtentX        =   847
  135.       _ExtentY        =   847
  136.       _Version        =   393216
  137.    End
  138.    Begin VB.Frame frameMusic 
  139.       Caption         =   "Music"
  140.       Height          =   2055
  141.       Left            =   2640
  142.       TabIndex        =   0
  143.       Top             =   0
  144.       Width           =   2415
  145.       Begin VB.CommandButton cmdMusicRemove 
  146.          Caption         =   "Remove"
  147.          Height          =   375
  148.          Left            =   1200
  149.          TabIndex        =   6
  150.          Top             =   1560
  151.          Width           =   1095
  152.       End
  153.       Begin VB.CommandButton cmdMusicAdd 
  154.          Caption         =   "Add ..."
  155.          Height          =   375
  156.          Left            =   120
  157.          TabIndex        =   5
  158.          Top             =   1560
  159.          Width           =   1095
  160.       End
  161.       Begin VB.CommandButton cmdMusicRestart 
  162.          Caption         =   "Restart"
  163.          Height          =   375
  164.          Left            =   1560
  165.          TabIndex        =   4
  166.          Top             =   1200
  167.          Width           =   735
  168.       End
  169.       Begin VB.CommandButton cmdMusicStop 
  170.          Caption         =   "Stop"
  171.          Height          =   375
  172.          Left            =   840
  173.          TabIndex        =   3
  174.          Top             =   1200
  175.          Width           =   735
  176.       End
  177.       Begin VB.CommandButton cmdMusicPlay 
  178.          Caption         =   "Play"
  179.          Height          =   375
  180.          Left            =   120
  181.          TabIndex        =   2
  182.          Top             =   1200
  183.          Width           =   735
  184.       End
  185.       Begin VB.ListBox lstMusic 
  186.          Height          =   840
  187.          Left            =   120
  188.          TabIndex        =   1
  189.          Top             =   240
  190.          Width           =   2175
  191.       End
  192.    End
  193.    Begin VB.Label lblCPUP 
  194.       AutoSize        =   -1  'True
  195.       BackStyle       =   0  'Transparent
  196.       Caption         =   "CPU%"
  197.       Height          =   195
  198.       Left            =   6720
  199.       TabIndex        =   16
  200.       Top             =   2280
  201.       Width           =   450
  202.    End
  203.    Begin VB.Label lblCPU 
  204.       Alignment       =   2  'Center
  205.       AutoSize        =   -1  'True
  206.       Caption         =   "0.0"
  207.       Height          =   195
  208.       Left            =   7320
  209.       TabIndex        =   15
  210.       Top             =   2280
  211.       Width           =   240
  212.    End
  213. Attribute VB_Name = "frmBassTest"
  214. Attribute VB_GlobalNameSpace = False
  215. Attribute VB_Creatable = False
  216. Attribute VB_PredeclaredId = True
  217. Attribute VB_Exposed = False
  218. '*****************************************************************
  219. '* BASS Simple test (rev .1), copyright (c) 1999 Adam Hoult.     *
  220. '*                                                               *
  221. '* Updated: 2003-2005 by (: JOBnik! :) [Arthur Aminov, ISRAEL]   *
  222. '*                                     [http://www.jobnik.org]   *
  223. '*                                     [  jobnik@jobnik.org  ]   *
  224. '*                                                               *
  225. '* Originally translated from - basstest.c - example of Ian Luck *
  226. '*****************************************************************
  227. Option Explicit
  228. ' display error messages
  229. Public Sub Error_(ByVal es As String)
  230.     Call MsgBox(es & vbCrLf & "(error code: " & BASS_ErrorGetCode() & ")", vbExclamation, "Error")
  231. End Sub
  232. Private Sub Form_Load()
  233.     'change and set the current path
  234.     'so it won't ever tell you that bass.dll is not found
  235.     ChDrive App.Path
  236.     ChDir App.Path
  237.     'check if 'bass.dll' is exists
  238.     If Not FileExists(RPP(App.Path) & "bass.dll") Then
  239.         Call MsgBox("BASS.DLL does not exists", vbCritical, "BASS.DLL")
  240.         End
  241.     End If
  242.     'Check that BASS 2.2 was loaded
  243.     If BASS_GetVersion <> MakeLong(2, 2) Then
  244.         Call MsgBox("BASS version 2.2 was not loaded", vbCritical, "Incorrect BASS.DLL")
  245.         End
  246.     End If
  247.     'Initialize output - default device, 44100hz, stereo, 16 bits
  248.     If BASS_Init(-1, 44100, 0, Me.hWnd, 0) = BASSFALSE Then
  249.         Call Error_("Can't initialize digital sound system")
  250.         End
  251.     End If
  252.     'Start the timer
  253.     tmrBass.Enabled = True
  254. End Sub
  255. Private Sub Form_Unload(Cancel As Integer)
  256.     'stop timer
  257.     tmrBass.Enabled = False
  258.     'Close sound system and release everything
  259.     Call BASS_Free
  260. End Sub
  261. 'Pause output
  262. Private Sub cmdStopAll_Click()
  263.     Call BASS_Pause
  264. End Sub
  265. 'Resume output
  266. Private Sub cmdResumeAll_Click()
  267.     Call BASS_Start
  268. End Sub
  269. Private Sub cmdStreamAdd_Click()
  270.     On Error Resume Next
  271.     DLG.FileName = ""
  272.     DLG.CancelError = True
  273.     DLG.flags = cdlOFNExplorer Or cdlOFNFileMustExist Or cdlOFNHideReadOnly
  274.     DLG.Filter = "Streamable Files (wav/aif/mp3/mp2/mp1/ogg)|*.wav;*.aif;*.mp3;*.mp2;*.mp1;*.ogg|All Files (*.*)|*.*|"
  275.     DLG.ShowOpen
  276.     'if cancel was pressed, exit the procedure
  277.     If Err.Number = 32755 Then Exit Sub
  278.     Dim StreamHandle As Long
  279.     StreamHandle = BASS_StreamCreateFile(BASSFALSE, DLG.FileName, 0, 0, 0)
  280.     If StreamHandle = 0 Then
  281.         Call Error_("Can't open stream")
  282.     Else
  283.         lstStream.AddItem GetFileName(DLG.FileName)
  284.         lstStream.ItemData(lstStream.ListCount - 1) = StreamHandle
  285.     End If
  286. End Sub
  287. 'Free the selected stream resource
  288. 'Remove the selected list
  289. Private Sub cmdStreamRemove_Click()
  290.     If (lstStream.ListIndex >= 0) Then
  291.         Call BASS_StreamFree(lstStream.ItemData(lstStream.ListIndex))
  292.         lstStream.RemoveItem lstStream.ListIndex
  293.     End If
  294. End Sub
  295. 'Play the stream (continue from current position)
  296. Private Sub cmdStreamPlay_Click()
  297.     If (lstStream.ListIndex >= 0) Then _
  298.         If (BASS_ChannelPlay(lstStream.ItemData(lstStream.ListIndex), BASSFALSE) = 0) Then _
  299.             Call Error_("Can't play stream")
  300. End Sub
  301. 'Stop the stream
  302. Private Sub cmdStreamStop_Click()
  303.     If (lstStream.ListIndex >= 0) Then _
  304.         Call BASS_ChannelStop(lstStream.ItemData(lstStream.ListIndex))
  305. End Sub
  306. 'Play the stream from the start
  307. Private Sub cmdStreamRestart_Click()
  308.     If (lstStream.ListIndex >= 0) Then _
  309.         Call BASS_ChannelPlay(lstStream.ItemData(lstStream.ListIndex), BASSTRUE)
  310. End Sub
  311. Private Sub cmdMusicAdd_Click()
  312.     On Error Resume Next
  313.     DLG.FileName = ""
  314.     DLG.CancelError = True
  315.     DLG.flags = cdlOFNExplorer Or cdlOFNFileMustExist Or cdlOFNHideReadOnly
  316.     DLG.Filter = "MOD Music Files (mo3/xm/mod/s3m/it/mtm/umx)|*.mo3;*.xm;*.mod;*.s3m;*.it;*.mtm;*.umx|All Files (*.*)|*.*|"
  317.     DLG.ShowOpen
  318.     'if cancel was pressed, exit the procedure
  319.     If Err.Number = 32755 Then Exit Sub
  320.     Dim ModHandle As Long
  321.     'Load a music from "DLG.FileName" and make it use ramping
  322.     ModHandle = BASS_MusicLoad(BASSFALSE, DLG.FileName, 0, 0, BASS_MUSIC_RAMP Or BASS_MUSIC_POSRESET, 0)
  323.     If ModHandle = 0 Then
  324.         Call Error_("Can't Load Music")
  325.     Else
  326.         lstMusic.AddItem BASS_MusicGetNameString(ModHandle)
  327.         lstMusic.ItemData(lstMusic.ListCount - 1) = ModHandle
  328.     End If
  329. End Sub
  330. 'Free the selected mod resource
  331. 'Remove the selected list
  332. Private Sub cmdMusicRemove_Click()
  333.     If (lstMusic.ListIndex >= 0) Then
  334.         Call BASS_MusicFree(lstMusic.ItemData(lstMusic.ListIndex))
  335.         lstMusic.RemoveItem lstMusic.ListIndex
  336.     End If
  337. End Sub
  338. 'Play the music (continue from current position)
  339. Private Sub cmdMusicPlay_Click()
  340.     If (lstMusic.ListIndex >= 0) Then _
  341.         If (BASS_ChannelPlay(lstMusic.ItemData(lstMusic.ListIndex), BASSFALSE) = 0) Then _
  342.             Call Error_("Can't play music")
  343. End Sub
  344. 'Stop the music
  345. Private Sub cmdMusicStop_Click()
  346.     If (lstMusic.ListIndex >= 0) Then _
  347.         Call BASS_ChannelStop(lstMusic.ItemData(lstMusic.ListIndex))
  348. End Sub
  349. 'Play the music from the start
  350. Private Sub cmdMusicRestart_Click()
  351.     If (lstMusic.ListIndex >= 0) Then _
  352.         Call BASS_ChannelPlay(lstMusic.ItemData(lstMusic.ListIndex), BASSTRUE)
  353. End Sub
  354. Private Sub cmdSampleAdd_Click()
  355.     On Local Error Resume Next
  356.     DLG.FileName = ""
  357.     DLG.CancelError = True
  358.     DLG.flags = cdlOFNExplorer Or cdlOFNFileMustExist Or cdlOFNHideReadOnly
  359.     DLG.Filter = "Sample files (wav/aif)|*.wav;*.aif|All Files (*.*)|*.*|"
  360.     DLG.ShowOpen
  361.     'if cancel was pressed, exit the procedure
  362.     If Err.Number = 32755 Then Exit Sub
  363.     Dim SampleHandle As Long
  364.     'Load a sample from "DLG.FileName" and give it a max of 3 simultaneous
  365.     'playings using playback position as override decider
  366.     SampleHandle = BASS_SampleLoad(BASSFALSE, DLG.FileName, 0, 0, 3, BASS_SAMPLE_OVER_POS)
  367.     If SampleHandle = 0 Then
  368.         Call Error_("Can't Load Sample")
  369.     Else
  370.         lstSamples.AddItem GetFileName(DLG.FileName)
  371.         lstSamples.ItemData(lstSamples.ListCount - 1) = SampleHandle
  372.     End If
  373. End Sub
  374. 'Play the sample at default rate, volume=50, random pan position
  375. Private Sub cmdSamplePlay_Click()
  376.     If (lstSamples.ListIndex >= 0) Then
  377.         Dim ch As Long
  378.         ch = BASS_SampleGetChannel(lstSamples.ItemData(lstSamples.ListIndex), BASSFALSE)
  379.         Call BASS_ChannelSetAttributes(ch, -1, 50, Int((201 * Rnd) - 100))
  380.         If (BASS_ChannelPlay(ch, BASSFALSE) = 0) Then Error_ ("Can't play sample")
  381.     End If
  382. End Sub
  383. 'Free the selected sample resource
  384. 'Remove the selected list item
  385. Private Sub cmdSampleRemove_Click()
  386.     If (lstSamples.ListIndex >= 0) Then
  387.         Call BASS_SampleFree(lstSamples.ItemData(lstSamples.ListIndex))
  388.         lstSamples.RemoveItem lstSamples.ListIndex
  389.     End If
  390. End Sub
  391. 'Main timer, to update all info needed.
  392. Private Sub tmrBass_Timer()
  393.     'update the CPU usage % display
  394.     lblCPU.Caption = Format(BASS_GetCPU, "0.00")
  395. End Sub
  396. '-------------------------
  397. 'some useful functions :)
  398. '-------------------------
  399. 'check if any file exists
  400. Public Function FileExists(ByVal fp As String) As Boolean
  401.     FileExists = (Dir(fp) <> "")
  402. End Function
  403. ' RPP = Return Proper Path
  404. Public Function RPP(ByVal fp As String) As String
  405.     RPP = IIf(Mid(fp, Len(fp), 1) = "\", fp, fp & "\")
  406. End Function
  407. 'get file name from file path
  408. Public Function GetFileName(ByVal fp As String) As String
  409.     GetFileName = Mid(fp, InStrRev(fp, "\") + 1)
  410. End Function
  411.