Multimédia la Compil' 2/Sybex_Multimedia_La_Compil_2.iso/cooltool/songplay/songplay.frm

Text File | 1995-04-20 | 12KB | 445 lines

VERSION 2.00
Begin Form SongPlayer
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "MCI MIDI Song Player"
   ClientHeight    =   1635
   ClientLeft      =   1425
   ClientTop       =   2595
   ClientWidth     =   4890
   ForeColor       =   &H00C0C0C0&
   Height          =   2325
   Icon            =   SONGPLAY.FRX:0000
   Left            =   1365
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   1635
   ScaleWidth      =   4890
   Top             =   1965
   Width           =   5010
   Begin CommandButton Cmd_Rewind
      Caption         =   "Rewind"
      Enabled         =   0   'False
      Height          =   675
      Left            =   3720
      TabIndex        =   8
      Top             =   60
      Width           =   1125
   End
   Begin CommandButton Cmd_Stop
      Caption         =   "Stop"
      Enabled         =   0   'False
      Height          =   675
      Left            =   2580
      TabIndex        =   7
      Top             =   60
      Width           =   1125
   End
   Begin CommandButton Cmd_Play
      Caption         =   "Play"
      Enabled         =   0   'False
      Height          =   675
      Left            =   1440
      TabIndex        =   6
      Top             =   60
      Width           =   1125
   End
   Begin Frame Frame2
      BackColor       =   &H00C0C0C0&
      Caption         =   "Measure Controls"
      Height          =   765
      Left            =   1440
      TabIndex        =   4
      Top             =   810
      Width           =   3405
      Begin HSlider MeasureScroll
         BackColor       =   &H00C0C0C0&
         BevelInner      =   0  'None
         BevelOuter      =   1  'Raised
         BevelWidth      =   1
         BorderWidth     =   1
         Gap             =   3
         Height          =   285
         LargeChange     =   10
         Left            =   120
         LinkControl     =   ""
         LinkProperty    =   ""
         Max             =   100
         Min             =   1
         ThumbHeight     =   270
         ThumbStyle      =   2  'Pointed Down
         ThumbWidth      =   240
         TickColor       =   &H00000000&
         TickCount       =   5
         TickLength      =   4
         TickMarks       =   3  'Both
         TickWidth       =   1
         Top             =   330
         TrackBevel      =   1  'Raised
         TrackWidth      =   0
         Value           =   0
         Width           =   3165
      End
   End
   Begin Frame Frame1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Song &Tempo"
      Height          =   765
      Left            =   60
      TabIndex        =   2
      Top             =   810
      Width           =   1275
      Begin VSlider VSliderTempo
         BackColor       =   &H00C0C0C0&
         BevelInner      =   0  'None
         BevelOuter      =   0  'None
         BevelWidth      =   2
         BorderWidth     =   2
         Gap             =   3
         Height          =   465
         LargeChange     =   10
         Left            =   870
         LinkControl     =   ""
         LinkProperty    =   ""
         Max             =   250
         Min             =   0
         ThumbHeight     =   140
         ThumbStyle      =   1  'Pointed Left
         ThumbWidth      =   200
         TickColor       =   &H00000000&
         TickCount       =   3
         TickLength      =   4
         TickMarks       =   1  'Left
         TickWidth       =   1
         Top             =   270
         TrackBevel      =   1  'Raised
         TrackWidth      =   0
         Value           =   100
         Width           =   255
      End
      Begin TextBox TempoLabel
         Alignment       =   2  'Center
         BackColor       =   &H00C0C0C0&
         Enabled         =   0   'False
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   12
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00FF0000&
         Height          =   420
         Left            =   180
         TabIndex        =   3
         Text            =   "120"
         Top             =   300
         Width           =   645
      End
   End
   Begin CommonDialog CMDialog1
      CancelError     =   -1  'True
      Color           =   &H00C0C0C0&
      DefaultExt      =   "mid"
      DialogTitle     =   "Open Song File"
      Left            =   780
      PrinterDefault  =   0   'False
      Top             =   1740
   End
   Begin Timer Timer1
      Interval        =   10
      Left            =   9960
      Top             =   165
   End
   Begin Label LabelSongLength
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Total Length 0:00"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Small Fonts"
      FontSize        =   6.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   225
      Left            =   60
      TabIndex        =   1
      Top             =   450
      Width           =   1305
   End
   Begin Label Label1
      Alignment       =   2  'Center
      BackColor       =   &H00000000&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "0:00"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H0000FF00&
      Height          =   315
      Left            =   60
      TabIndex        =   5
      Top             =   60
      Width           =   1305
   End
   Begin Label readout
      Alignment       =   2  'Center
      BackColor       =   &H00FF0000&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "ErrorCode"
      ForeColor       =   &H00FFFFFF&
      Height          =   225
      Left            =   6660
      TabIndex        =   0
      Top             =   4890
      Width           =   1515
   End
   Begin Menu MnuFile
      Caption         =   "&File"
      Begin Menu MnuOpenSong
         Caption         =   "&Open Song"
         Shortcut        =   ^O
      End
      Begin Menu MnuLine
         Caption         =   "-"
      End
      Begin Menu MnuExit
         Caption         =   "E&xit"
      End
   End
   Begin Menu mnuSettings
      Caption         =   "Settings"
      Begin Menu mnuSettingsMIDI
         Caption         =   "&MIDI..."
      End
   End
End
Dim LastBar, CurrentBar As Integer

' This MCI example only uses MIDI CoolTools to access different MIDI Output port.
' All the MIDI file playing is being performed by the Windows MCI. The MCI does not
' give you low level access to any of the actual MIDI data, but can be very useful
' for playing MIDI files that contain less than 32 tracks.

' For more information on the MCI for playing MIDI, WAVE and CD-ROM audio, please
' Refer to the Microsoft Windows Multimedia Progrmmer's Reference.
' Available from Microsoft Press at 800-MSPRESS





Sub Cmd_Play_Click ()
    Dim i As Integer
    Dim X As Integer
    Dim Action As String

    Screen.MousePointer = 11

    Action = "Set " + "MCIMidi " + "Port " + Str$(MIDISetupForm.ComboMidiOut.ListIndex - 1)
    i = mciExecute(Action)

    If SongLength = CurrentBar Then
        Action = "SEEK " + "MCIMidi " + "TO START"
        i = mciExecute(Action)
        Action = "Play " + "MCIMidi "
        MidiBarNumber = 0
        Label1.Caption = " 0:00"
    Else
        If MeasureScroll.Value = CurrentBar Then
            Action = "Play " + "MCIMidi "
        Else
            Action = "Play " + "MCIMidi " + "from " + Str$(MeasureScroll.Value * 4)
        End If
    End If
    i = mciExecute(Action)
    SetTempo

    MeasureScroll.Enabled = False

    Cmd_Play.Enabled = False
    Cmd_stop.Enabled = True

    Screen.MousePointer = 0
    Timer1.Enabled = True

End Sub

Sub Cmd_Rewind_Click ()
    Dim i As Integer
    Dim X As Integer

    Screen.MousePointer = 11

    Label1.Caption = " 0:00"
    MeasureScroll.Value = 1

    Action$ = "SEEK " + "MCIMidi " + "TO START"
    i = mciExecute(Action$)

    MidiBarNumber = 0
    MeasureScroll.Enabled = True

    Cmd_Play.Enabled = True
    Cmd_stop.Enabled = False

    Screen.MousePointer = 0
End Sub

Sub Cmd_Stop_Click ()
    Dim i As Integer

    Screen.MousePointer = 11

    Timer1.Enabled = False

    Action$ = "Pause " + "MCIMidi"
    i = mciExecute(Action$)

    MidiBarNumber = 0
    MeasureScroll.Enabled = True

    Cmd_Play.Enabled = True
    Cmd_stop.Enabled = False

    Screen.MousePointer = 0
End Sub

Sub Form_Load ()
   On Error GoTo ErrorHandler:

    SongFileOpened = False
    SongLength = 1
    CurrentBar = 0

ErrorHandler:
    If Err > 0 Then
        Msg$ = "Unanticipated error number" + Str$(Err) + " occurred: " + Error$
        MsgBox Msg$, 16
        End
    End If
End Sub

Sub Form_Unload (Cancel As Integer)
    Dim Action As String
    Dim X As Integer

    Action$ = "close all"
    X = mciExecute(Action$)

    End
End Sub

Sub MeasureScroll_Change ()
    If SongTempo > 0 Then Label1.Caption = Str$(Int((60 / SongTempo) * Int(Val(MeasureScroll.Value)) / 60)) + ":" + Format$(Int((60 / SongTempo) * Int(Val(MeasureScroll.Value))) Mod 60, "00")
End Sub

Sub MnuExit_Click ()
    Dim Action As String
    Dim X As Integer

    Action$ = "close all"
    X = mciExecute(Action$)

    End
End Sub

Sub MnuOpenSong_Click ()
    OpenSongFile
End Sub

Sub mnuSettingsMidi_Click ()
    MIDISetupForm.Show
    Action$ = "Set " + "MCIMidi " + "Port " + Str$(MIDISetupForm.ComboMidiOut.ListIndex - 1)
    i = mciExecute(Action$)
End Sub

Sub SSCommand1_Click ()

End Sub

Sub TempoLabel_KeyPress (KeyAscii As Integer)
    If KeyAscii = 13 Then
        Cmd_Rewind.SetFocus
    End If
    If Len(LTrim$(TempoLabel.Text)) > 3 Then
        Beep
        KeyAscii = 0
    End If
    c$ = Chr$(KeyAscii)
    If c$ < "0" Or c$ > "9" Then
        KeyAscii = 0
    End If
End Sub

Sub TempoLabel_LostFocus ()
    If Val(TempoLabel.Text) > 0 And Val(TempoLabel.Text) < 1000 Then
        SongTempo = Val(TempoLabel.Text)
        SetTempo
    End If
    If Val(TempoLabel.Text) > 999 Then
        TempoLabel.Text = "999"
        SongTempo = Val(TempoLabel.Text)
        SetTempo
    End If
    If Val(TempoLabel.Text) = 0 Then
        TempoLabel.Text = "1"
        SongTempo = Val(TempoLabel.Text)
        SetTempo
    End If
End Sub

Sub TempoSpin1_SpinDown ()
    If SongTempo < 2 Then
        SongTempo = 999
    Else
       SongTempo = SongTempo - 1
    End If

    TempoLabel.Text = Str$(SongTempo)
    TempoLabel.Refresh
    SetTempo
End Sub

Sub TempoSpin1_SpinUp ()
    If SongTempo > 998 Then
        SongTempo = 1
    Else
       SongTempo = SongTempo + 1
    End If

    TempoLabel.Text = Str$(SongTempo)
    TempoLabel.Refresh
    SetTempo
End Sub

Sub Timer1_Timer ()
    If SongFileOpened = True Then
        Dim j, k, L As Integer
        Dim RtnString As String, i As String
        j = 100
        k = 0
        RtnString = "                                "
        Action$ = "Status " + "MCIMidi " + "Position"
        i$ = mciSendString(Action$, RtnString, j, k)

        CurrentBar = Int(Val(RtnString) / 4)
        If LastBar <> CurrentBar Then
            LastBar = CurrentBar
            MeasureScroll.Value = CurrentBar
        End If
        RtnString = "                                "
    End If
End Sub

Sub VSliderTempo_Change ()
    SongTempo = VSliderTempo.Value
    TempoLabel.Text = Str$(SongTempo)
    SetTempo
End Sub