Keskustelu: Koodit: VB6: QB:n PLAY-aliohjelma VB:lle

Antti Laaksonen [02.03.2002 19:26:03]

PLAY on yksi niistä komennoista, jotka ovat QBasicissa mutta eivät Visual Basicissa. Tässä on lähes 100% yhteensopiva PLAY-komento Visual Basicille toteutettuna API-komennon Beep avulla. Ainoat puuttuvat komennot ovat MB ja MF toteutussyistä.

Määrittelyt ja muuttujat

Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Dim Aanet(1 To 84) As Integer
Dim tempo As Integer, oktaavi As Integer, nkesto As Integer
Dim tyyli As Integer

Pääohjelma

Private Sub Form_Load()

    'aloitusarvot
    tempo = 120
    oktaavi = 3
    nkesto = 4
    tyyli = 2

    'lasketaan sävelien taajuudet
    Aanet(1) = 64
    For i = 2 To 84
        Aanet(i) = Aanet(i - 1) * 1.06
    Next

    'esimerkkimusiikkia
    PLAY "t160l16gl8gl16gl8ab-bp8l32gb>dg<p8 l16cegecegecegecegecdgdcdgc<b>dgd<b>dgd<a>cec<a>cec<a>cec<a>cec"
    PLAY "<gb>e<bgb>e<b><gb>e<bgb>e<bfa>c<afa>c<afa>c<afa>c<aeg>c<geg>c<geg>c<geg>c<g"
    PLAY "dg>c<gdg>c<gdg>c<gdg>c<gdgbgdgbgdgbgdgbg"

    'virheenkäsittelyesimerkki
    PLAY "t256cdefg"

End Sub

Aliohjelmat

Sub PLAY(musiikki As String)

    Dim um As String, vaihdettu As Boolean, unuotti As Integer
    Dim nuottij As String, unuottia(1 To 7) As Integer
    Dim vkesto As Integer

    um = LCase$(musiikki)
    nuottij = "cdefgab"
    nuottia = Array(0, 0, 2, 4, 5, 7, 9, 11)

    Do
        vaihdettu = False

        'jos tempoa vaihdetaan
        If Left$(um, 1) = "t" Then
            If IsNumeric(Mid$(um, 2, 1)) Then
                If IsNumeric(Mid$(um, 3, 1)) Then
                    If IsNumeric(Mid$(um, 4, 1)) Then
                        tempo = Val(Mid$(um, 2, 3))
                        um = Mid$(um, 5)
                    Else
                        tempo = Val(Mid$(um, 2, 2))
                        um = Mid$(um, 4)
                    End If
                Else
                    MsgBox "Virhe: Tempo tulee olla väliltä 32-255", , "PLAY": Exit Sub
                End If
            Else
                MsgBox "Virhe: Tempo tulee olla väliltä 32-255", , "PLAY": Exit Sub
            End If
            vaihdettu = True
        End If
        If tempo < 32 Or tempo > 255 Then MsgBox "Virhe: Tempo tulee olla väliltä 32-255", , "PLAY": Exit Sub

        'jos oktaavia vaihdetaan komennolla o
        If Left$(um, 1) = "o" Then
            If IsNumeric(Mid$(um, 2, 1)) Then
                oktaavi = Val(Mid$(um, 2, 1))
                um = Mid$(um, 3)
            Else
                MsgBox "Virhe: Oktaavin tulee olla väliltä 0-6", , "PLAY": Exit Sub
            End If
            vaihdettu = True
        End If
        If oktaavi > 6 Then MsgBox "Virhe: Oktaavin tulee olla väliltä 0-6", , "PLAY": Exit Sub

        'jos oktaavia vaihdetaan < tai > merkillä
        If Left$(um, 1) = "<" Then
           oktaavi = oktaavi - 1
           If oktaavi < 0 Then MsgBox "Virhe: Oktaavin tulee olla väliltä 0-6", , "PLAY": Exit Sub
           um = Mid$(um, 2)
           vaihdettu = True
        End If
        If Left$(um, 1) = ">" Then
           oktaavi = oktaavi + 1
           If oktaavi > 6 Then MsgBox "Virhe: Oktaavin tulee olla väliltä 0-6", , "PLAY": Exit Sub
           um = Mid$(um, 2)
           vaihdettu = True
        End If

        'jos soittotyyliä vaihdetaan
        If Left$(um, 1) = "m" Then
            Select Case Mid$(um, 2, 1)
            Case "l"
                tyyli = 1
            Case "n"
                tyyli = 2
            Case "s"
                tyyli = 3
            Case Else
                MsgBox "Virhe: Soittotyylin tulee olla l, n tai s", , "PLAY": Exit Sub
            End Select
            um = Mid$(um, 3)
            vaihdettu = True
        End If

        'jos nuotin kestoa vaihdetaan
        If Left$(um, 1) = "l" Then
            If IsNumeric(Mid$(um, 2, 1)) Then
                If IsNumeric(Mid$(um, 3, 1)) Then
                    nkesto = Val(Mid$(um, 2, 2))
                    um = Mid$(um, 4)
                Else
                    nkesto = Val(Mid$(um, 2, 1))
                    um = Mid$(um, 3)
                End If
            Else
                MsgBox "Virhe: Nuotin keston tulee olla väliltä 1-64", , "PLAY": Exit Sub
            End If
            If nkesto > 64 Then MsgBox "Virhe: Nuotin keston tulee olla väliltä 1-64", , "PLAY": Exit Sub
            vaihdettu = True
        End If

        'jos nuotti soitetaan komennolla n
        If Left$(um, 1) = "n" Then
            If IsNumeric(Mid$(um, 2, 1)) Then
                If IsNumeric(Mid$(um, 3, 1)) Then
                    If Val(Mid$(um, 2, 2)) < 85 Then
                        SoitaNuotti Val(Mid$(um, 2, 2))
                        um = Mid$(um, 4)
                    Else
                        MsgBox "Virhe: Soitettava nuotti tulee olla väliltä 0-84", , "PLAY": Exit Sub
                    End If
                Else
                    SoitaNuotti Val(Mid$(um, 2, 1))
                    um = Mid$(um, 3)
                End If
            Else
                MsgBox "Virhe: Soitettava nuotti tulee olla väliltä 0-84", , "PLAY": Exit Sub
            End If
            vaihdettu = True
        End If

        'jos tauko
        If Left$(um, 1) = "p" Then
            If IsNumeric(Mid$(um, 2, 1)) Then
                If IsNumeric(Mid$(um, 3, 1)) Then
                    If Val(Mid$(um, 2, 2)) < 65 Then
                        vkesto = nkesto
                        nkesto = Val(Mid$(um, 2, 2))
                        SoitaNuotti 0
                        nkesto = vkesto
                        um = Mid$(um, 4)
                    Else
                        MsgBox "Virhe: Tauon pituus tulee olla väliltä 1-64", , "PLAY": Exit Sub
                    End If
                Else
                    vkesto = nkesto
                    nkesto = Val(Mid$(um, 2, 1))
                    SoitaNuotti 0
                    nkesto = vkesto
                    um = Mid$(um, 3)
                End If
            Else
                MsgBox "Virhe: Soitettava nuotti tulee olla väliltä 0-84", , "PLAY": Exit Sub
            End If
            vaihdettu = True
        End If


        'jos jotain muuta
        If vaihdettu = False Then
            Select Case Left$(um, 1)
            Case "a", "b", "c", "d", "e", "f", "g", "+", "#", "-"
                unuotti = (oktaavi + 1) * 12 + nuottia(InStr(nuottij, Left$(um, 1))) + 1
                If Mid$(um, 2, 1) = "+" Or Mid$(um, 2, 1) = "#" Then
                    unuotti = unuotti + 1
                    um = Mid$(um, 2)
                ElseIf Mid$(um, 2, 1) = "-" Then
                    unuotti = unuotti - 1
                    um = Mid$(um, 2)
                End If
                SoitaNuotti unuotti
                um = Mid$(um, 2)
            Case " "
                um = Mid$(um, 2)
            Case Else
                MsgBox "Virhe: Tunnistamaton komento: " + Left$(um, 1), , "PLAY": Exit Sub
            End Select
        End If
        DoEvents
    Loop While um <> ""

End Sub

Sub SoitaNuotti(nuotti As Integer)

    'aliohjelma nuotin soittamiseen tai taukoon
    Dim nopeus As Integer, tauko As Integer
    tauko = 0
    nopeus = 4 / (tempo / 60) * 1000
    nopeus = nopeus / nkesto
    If nuotti <> 0 Then
        If tyyli = 2 Then
            tauko = nopeus * (1 / 8)
            nopeus = nopeus * (7 / 8)
        ElseIf tyyli = 3 Then
            tauko = nopeus * (1 / 4)
            nopeus = nopeus * (3 / 4)
        End If
    End If
    If nuotti = 0 Then
        Sleep nopeus
    Else
        x = Beep(Aanet(nuotti), nopeus)
        If tauko <> 0 Then
            Sleep tauko
        End If
    End If

End Sub

Rykker [04.03.2002 19:33:22]

hmm...ja kuka haluaa piipperi äänet vb:ssä?

Miksu [04.03.2002 20:47:28]

Pienoinen korjaus koodiin. Nuo määrittelyt kun tulee luonnollisesti moduuliin, niin jostain syystä samaan listaukseen on laitettu muuttujat. Joten väärinkäsitestysen välttämiseksi laittakaa siis nuo muuttujat formin puolelle tai vaihtakaa Dim arvot Public:eiksi.

Antti Laaksonen [04.03.2002 21:00:30]

Esim. minä :) Määrittelyt voi kyllä kirjoittaa Formillekin.

Miksu [09.03.2002 21:25:47]

Juu, juu, mutta kun jos joku luulee, että nuo kuuluu laittaa moduuliin, kun yleensä ne on aina tossa moduulissa, vaikkei tuossa nyt luekkaan mitään moduulista :)

Monkkats [13.12.2003 21:10:08]

Tolleehan saa tehtyä parempaa musaa ku monet midit :)

Fisher [29.02.2004 13:03:34]

Olisiko mahdollista saada piste (esim. CD.E) toimimaan?

Gwaur [05.09.2004 15:16:53]

Tämähän on kiva! :)
Meinasin jo valittaa kun lopussa tuli virhe "Tempo tulee olla väliltä 32-255", mutta sitten huomasinkin että se on tahallinen :P

tästä pitää vääntää myös se moniraitaversio

efteri [28.09.2004 21:25:05]

lainaus:

Rykker [04.03.2002 19:33:22] Lainaa Muokkaa
hmm...ja kuka haluaa piipperi äänet vb:ssä?

Piiperi on äänistä kaikkein paras mitä tietokoneista voi löytää elikkä minä
Tämä on yksi parhaista vinkeistä mitä on koskaan ollut kiitos!

Ahti [25.02.2005 17:43:48]

Hieno on!!

Ibe666 [09.04.2006 12:13:21]

VÄHÄN COOL...:D

Ibe666 [10.04.2006 16:09:01]

Miten ton saa pysäytettyä jos laitaa loopin??

moptim [28.10.2006 17:36:29]

Ctrl + Alt + Pause (arvatkaa mikä kappale:

"t120l4cccedddfeeddl2cl4p8ffffl2agp8l4eeeel2gfp4l4cccedddfeeddl2cl4"

)

JussiR [15.05.2007 15:43:58]

Oliskohan ukko nooa? :D

Sivun alkuun

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Kirjautuminen

Haku

Tehtävät