Hatena::Groupuwsc

CX's UWSC Diary

Windows 自動化ツール「UWSC」を使って何が出来るかを探求する日記です。構文をマスターしたい方はこちらをどうぞ→UWSC 基礎文法最速マスター
こくばん.in」投稿サンプル
アインシュタイン マリオとクッパ 千円札(見本) 猫
eピアノ」「Google Moog」自動演奏サンプル
eピアノ Google Moog
はてなロクロ」投稿サンプル
マリオ テトリス デフォルトさん はてなロゴ 全自動マリオ 3Dプロッタ
はてなハイク」投稿サンプル
デフォルトさん カラーパレット カラーパレット マリオ ルイージ カラーパレット 日本地図
 | 

2008-08-31MML Player for eピアノ

cx2020080831

MML Player for eピアノ

03:10 | MML Player for eピアノ - CX's UWSC Diary を含むブックマーク はてなブックマーク - MML Player for eピアノ - CX's UWSC Diary

// ---------------------------------------------------------
// File : mmlPlayer_for_ePiano.uws
// ---------------------------------------------------------
// 
// <使用上の注意>
// ・このスクリプトはWindows 自動化ソフト「UWSC」を使った「eピアノ」自動化スクリプトです。
// ・以下の環境でのみスクリプトの動作確認済みです。
//   ・解像度:1920x1200, Windows Vista(Aero) + IE9(ウィンドウ最大化、ツールバー無し)。タスクバーは下に配置。
// ・中断する場合は [Alt] + [F2] です。動作中にウィンドウを切り替えないでください。誤動作します。
//
// <サポートしている構文>
// CDEFGAB … 音階
// R       … 休符
// T[n]    … テンポ指定
// O[n]    … オクターブ指定
// L[n]    … 音長
// <       … オクターブを上げる
// >       … オクターブを下げる
// 
// ※ 今のところ、最小限の構文しかサポートしていません。
//   和音や、その他、もろもろの MML の構文は使えません。
//   なお、指定可能な音階は、O3:G#~O5:D#(「eピアノ」がキーボードでサポートしている範囲)です。
//
// <使用ツール>
// ■ UWSC Free版 Ver4.7c
// http://www.uwsc.info/download.html
// 
// <スクリプトを作成した人>
// id:cx20
// 
// <変更履歴>
// 2010/07/03 Ver0.06 「C-」を1オクターブ下の「B」、「B+」を1オクターブ上の「C」として扱うよう変更。
// 2010/06/27 Ver0.05 指定可能な音階を「O3:G#~O5:D#」→「O3:C~O6:C」に拡張。
// 2008/09/06 Ver0.04 テンポ(BPM)を指定できるよう対応。
// 2008/09/03 Ver0.03 音長を指定できるように対応。
// 2008/09/02 Ver0.02 構文解析処理を正規表現に変更。
// 2008/08/31 Ver0.01 とりあえず版作成。

Option Explicit

Public g_winID
Public g_flashID
g_winID = ActivateWindow("eピアノ")
Ifb g_winID = -1 Then
   g_winID = ActivateWindow("ePiano")
EndIf

Ifb g_winID = -1 Then
   MsgBox( "「eピアノ」が起動していない為、スクリプトを終了します。" )
   ExitExit
EndIf

g_flashID = HndToId( GetCtlHnd( g_winID, "MacromediaFlashPlayerActiveX") )
MouseOrg( g_flashID, 1 )

Public m_octave = 4        // オクターブ初期値
Public m_tempo  = 120      // テンポ (BPM)
Public m_length = 4        // 音長初期値

Main()

Procedure Main()
    // <サポートしている構文>
    // CDEFGAB … 音階
    // R       … 休符
    // O[n]    … オクターブ指定
    // <       … オクターブを上げる
    // >       … オクターブを下げる

    Public HashTbl mmlSamples
    Public HashTbl mmlClasic
    Public HashTbl mmlGames
    Public HashTbl mmlAnime
    Public HashTbl mmlOther

    mmlSamples["音階テスト1"]      = "c d e f g a b < c"                                                  // 音階テスト
    mmlSamples["音階テスト2"]      = "o3 f f# g g# a a# b < c c# d d# e f f# g g# a a# b < c c# d d# e f" // 音階テスト
    mmlSamples["テンポ変更テスト"] = "t120 l4 o4 c d e f g a b < c t240 l4 o4 c d e f g a b < c"          // テンポ変更テスト
    mmlSamples["かえるの歌"]       = "t120l4o4 cdefedcr efgagfer crcrcrcr cdefedcr"                       // かえるの歌
    mmlSamples["きらきら星"]       = "t190l4o4 ccggaag2 ffeeddc2 ggffeed2 ggffeed2 ccggaag2 ffeeddc2 r"   // きらきら星
    mmlClasic["トルコ行進曲"]      = "t160l16o3 bag#ab#8e8<dccce8>e8<fed#ebag#abag#ab#4L8ab#ragaragaragf" _
         + "#e4L16>bag#ab#8e8<dccce8>e8<fed#ebag#abag#ab#4L8ab#ragaragaragf#e4efggL16agfed4e8f8g8g8agfed" _
         + "4c8d8e8e8fedcc4c8d8e8e8fedc>b4bag#ab#8e8<dccce8>e8<fed#ebag#abag#ab#4L8abb#bag#aefdc4L32cccc" _
         + "cc>aba4L8<efggL16agfed4e8f8g8g8agfed4c8d8e8e8fedcc4c8d8e8e8fedc>b4bag#ab#8e8<dccce8>e8<fed#e" _
         + "bag#abag#ab#4L8abb#bag#aefdc4L32cccccc>aba4L8<ab<c#4>ab<c#>bag#f#g#abg#eab<c#r>ab<c#>bag#f#b" _
         + "g#ea4ab<c#4>ab<c#>bag#f#g#abg#eab<c#r>ab<c#>bag#f#bg#ea4L16<c#dc#>babag#f#ag#f#ff#g#fc#d#fc#" _
         + "f#ff#g#ag#ab<c#cc#cc#dc#>babag#f#ag#f#ef#g#ec#d#ec#d#ef#d#cc#d#cc#4<c#dc#>babag#f#ag#f#ff#g#" _
         + "fc#d#fc#f#ff#g#ag#ab<c#cc#cc#dc#>babag#f#ag#f#ef#g#ec#d#ec#d#ef#d#cc#d#cc#4edc#>bab<c#def#g#" _
         + "aag#f#eedc#>bab<c#def#g#aa#8b8edc#>bab<c#def#g#aag#f#eedc#cc#e>a<c#cd>g#ba4"                  // トルコ行進曲
    
    mmlClasic["天国と地獄"]        = "T230l4o4 V15 o3 r1b32ar<ar>ar<ar>aaaa<aaaa>a32L16r<ererf+rerdrdrf+" _
         + "rgrbr<dr>brb8a8a4brc+rc+rbrardrdrf+rg32f+32rerg32f+32rerg32f+32rerg32f+32rer>ar<ererf+rerdrd" _
         + "rf+rgrbr<dr>brb8a8a4brara.r8r32brara.r8r32brarbrara.r8r32>a.L8rr32<d2egf+ea4a4abf+ge4e4egf+e" _
         + "d<dc+>bagf+ed2egf+ea4a4abf+ge4e4egf+edaef+d4d4L16>ar<ererf+rerdrdrf+rgrbr<dr>brb8a8a4brc+rc+" _
         + "rbrardrdrf+rg32f+32rerg32f+32rerg32f+32rerg32f+32rer>ar<ererf+rerdrdrf+rgrbr<dr>brb8a8a4brar" _
         + "a.r8r32brara.r8r32brarbrara.r8r32>a.L8rr32<d2egf+ea4a4abf+ge4e4egf+ed<dc+>bagf+ed2egf+ea4a4a" _
         + "bf+ge4e4egf+edaef+d4d"                                                                        // 天国と地獄
    
//    PlayList( mmlSamples)
//    PlayList( mmlClasic)
//    PlayListByName( mmlSamples, "音階テスト1" )
//    PlayListByName( mmlSamples, "音階テスト2" )
//    PlayListByName( mmlSamples, "テンポ変更テスト" )
//    PlayListByName( mmlSamples, "かえるの歌" )
//    PlayListByName( mmlSamples, "きらきら星" )
    PlayListByName( mmlClasic, "トルコ行進曲" )
//    PlayListByName( mmlClasic, "天国と地獄" )
Fend

Function PlayList( mmlTable[] )
    Dim strMML
    Dim i
    For i = 0 To Length(mmlTable) - 1
        strMML = mmlTable[i, HASH_VAL]
        PlayMML( strMML )
        Sleep( 1 )
    Next
    Result = 0
Fend

Function PlayListByName( mmlTable[], strName )
    Dim strMML
    strMML = mmlTable[ strName ]
    PlayMML( strMML )
    Result = 0
Fend

Function PlayMML( strMML )
    Dim strMMLCode
    Dim re = CreateOleObj("VBScript.RegExp")
    re.Global = True
    re.IgnoreCase = True // 大文字、小文字の区別をしない
    re.Pattern = "([t][\d]+|[l][\d\.]+|[o][\d]|[a-g|r]{1}[#|+|-]*[\d\.]*|\>|\<)"
    Dim items = re.Execute(strMML)
    Dim strItem
    Dim strPrefix
    Dim i
    For i = 0 To items.Count - 1
        Dim item = items.Item(i)
        strItem = StrConv( item.Value, SC_UPPERCASE )
        strPrefix = Copy( strItem, 1, 1 )
//Print "strItem = [" + strItem + "]"
        Select strPrefix
            Case "T"
                m_tempo  = GetTempo( strItem )
            Case "L"
                m_length = GetLength( strItem )
            Case "O"
                m_octave = GetOctave( strItem )
            Case "<"
                m_octave = m_octave + 1
            Case ">"
                m_octave = m_octave - 1
            Default
                strMMLCode = GetMMLCodeWithLen( m_octave, strItem )
                PlayMMLCodeWithLen( strMMLCode )
        SelEnd
    Next

    Result = 0
Fend

// 例)"O4" -> [4] を返却
Function GetOctave( strItem )
    Dim nResult
    Dim strOctave
    Dim re = CreateOleObj("VBScript.RegExp")
    re.Global = True
    re.IgnoreCase = True // 大文字、小文字の区別をしない
    re.Pattern = "([o])([\d])"
    strOctave = re.Replace( strItem, "$2" )
    nResult = Val( strOctave, 4 )    // 変換できない場合はオクターブ値を4にセット
    Result = nResult
Fend

// 例)"T120" -> [120] を返却
Function GetTempo( strItem )
    Dim nResult
    Dim strTempo
    Dim re = CreateOleObj("VBScript.RegExp")
    re.Global = True
    re.IgnoreCase = True // 大文字、小文字の区別をしない
    re.Pattern = "([t])([\d]+)"
    strTempo = re.Replace( strItem, "$2" )
    nResult = Val( strTempo, 120 )    // 変換できない場合はテンポを120にセット
    Result = nResult
Fend

// 例)"L8" -> [8] を返却
Function GetLength( strItem )
    Dim strResult
    Dim nResult
    Dim strLength
    Dim re = CreateOleObj("VBScript.RegExp")
    re.Global = True
    re.IgnoreCase = True // 大文字、小文字の区別をしない
    re.Pattern = "([l])([\d\.]+)"
    strLength = re.Replace( strItem, "$2" )
    nResult = Val( strLength, 4 )    // 変換できない場合は長さを4にセット
    Ifb Pos( ".", strLength ) <> 0 Then
        strResult = nResult + "."
    Else
        strResult = nResult
    EndIf
    Result = strResult
Fend

// 例)"C4" -> [4] を返却
Function GetNoteLength( strItem )
    Dim strResult
    Dim nResult
    Dim strLength
    Dim re = CreateOleObj("VBScript.RegExp")
    re.Global = True
    re.IgnoreCase = True // 大文字、小文字の区別をしない
    re.Pattern = "([o][\d])*([:])*([a-g|r][\#\+\-]*)([\d\.]*)"
    strLength = re.Replace( strItem, "$4" )
    nResult = Val( strLength, m_length )  // 変換できない場合は長さをデフォルト値に設定
    Ifb strLength = "." Then
        nResult = m_length                // 変換できない場合は長さをデフォルト値に設定
    EndIf
    Ifb Pos( ".", strLength ) <> 0 Then
        strResult = nResult + "."
    Else
        strResult = nResult
    EndIf
    Result = strResult
Fend

// 例)"C4" -> "C" を返却
Function GetNote( strItem )
    Dim strResult
    Dim strLength
    Dim re = CreateOleObj("VBScript.RegExp")
    re.Global = True
    re.IgnoreCase = True // 大文字、小文字の区別をしない
    re.Pattern = "([a-g|r][\#\+\-]*)([\d\.]*)"
    strResult = re.Replace( strItem, "$1" )
    strResult = Replace( strResult, "+", "#" )
    strResult = Replace( strResult, "D-", "C#" )
    strResult = Replace( strResult, "E-", "D#" )
    strResult = Replace( strResult, "G-", "F#" )
    strResult = Replace( strResult, "A-", "G#" )
    strResult = Replace( strResult, "B-", "A#" )
    
    Result = strResult
Fend

Function GetMMLCodeWithLen( nOctave, strMMLChar )
//Print "strMMLChar = [" + strMMLChar + "]"
    Dim strMMLCode
    //strMMLCode = "O" + nOctave + ":" + StrConv( strMMLChar, SC_UPPERCASE )
    //strMMLCode = "O" + nOctave + ":" + StrConv( strMMLChar, SC_UPPERCASE ) + ":" + GetNoteLength( strMMLChar )
    strMMLCode = "O" + nOctave + ":" + GetNote( StrConv( strMMLChar, SC_UPPERCASE ) ) + ":" + GetNoteLength( strMMLChar )
    Result = strMMLCode
Fend

// 例)"O4:C:8" -> "O4:C"
Function GetMMLCodeByCodeWithLen( strMMLCodeWithLen )
    Dim strResult
    Dim nPos
    nPos = Pos( ":", strMMLCodeWithLen, 2 ) // 2個目の":" を検索
    Ifb nPos <> 0 Then
        strResult = Copy( strMMLCodeWithLen, 1, nPos - 1 )
    Else
        strResult = strMMLCodeWithLen
    EndIf
    Result = strResult
Fend

// 例)"O4:C:8" -> [8]
Function GetNoteLengthByCodeWithLen( strMMLCodeWithLen )
    Dim nResult
    Dim strNoteLength
    Dim nPos
    nPos = Pos( ":", strMMLCodeWithLen, 2 ) // 2個目の":" を検索
    Dim nLength
    nLength = Length( strMMLCodeWithLen )
    Ifb nPos <> 0 Then
        strNoteLength = Copy( strMMLCodeWithLen, nPos + 1, nLength - nPos )
    Else
        strNoteLength = ""
    EndIf
    nResult = Val( strNoteLength, m_length )  // 変換できない場合は長さをデフォルト値に設定
    Ifb Pos( ".", strNoteLength ) <> 0 Then
        nResult = nResult / 1.5 // 付点「.」がある場合、音の長さを1.5倍にする
    EndIf
    
    Result = nResult
Fend

Procedure PlayMMLCodeWithLen( strMMLCodeWithLen )
//    Print strMMLCodeWithLen
Print "strMMLCodeWithLen = [" + strMMLCodeWithLen + "]"
    Dim strNote
    Dim nLength
    Dim strMMLCode
    // "O4:C:8" -> "O4:C"
    strMMLCode = GetMMLCodeByCodeWithLen( strMMLCodeWithLen )
    // "O4:C:8" -> [8]
    nLength = GetNoteLengthByCodeWithLen( strMMLCodeWithLen )
//    Print "strMMLCode = [" + strMMLCode + "]"
//    Print "nLength    = [" + nLength + "]"
    
    Dim nKeyCode
    Dim nTime
    Ifb nLength = 0 Then
        nTime = 0
    Else
        nTime = 60 / m_tempo * 1000 * ( 4 / nLength )
    EndIf
//    Print "nTime = [" + nTime + "]"
    Dim x
    Dim y
    Dim strXY

    strXY = GetKeyPosByMMLCode( strMMLCode )
    ConvertStrToXY( strXY, x, y )

    Ifb Length( strXY ) = 0 Then
        Sleep(nTime/1000)    // キーコードが取得できない場合は休符と判断する
    Else
        BTN( LEFT, CLICK, x, y, 0 )
        Sleep(nTime/1000)    // キーコードが取得できない場合は休符と判断する
    EndIf

//      nKeyCode = GetKeyCodeByMMLCode(strMMLCode)
//      Ifb nKeyCode = 0 Then
//          Sleep(nTime/1000)    // キーコードが取得できない場合は休符と判断する
//      Else
//          KBD( nKeyCode, CLICK, 0)
//          Sleep(nTime/1000)    // キーコードが取得できない場合は休符と判断する
//      EndIf
Fend

Function GetKeyPosByMMLCode( strMMLCode )
    Public HashTbl mmlTable

    mmlTable["O3:C"]  = " 19,180"   // ""
    mmlTable["O3:C#"] = " 33,150"   // ""
    mmlTable["O3:D"]  = " 43,180"   // ""
    mmlTable["O3:D#"] = " 59,150"   // ""
    mmlTable["O3:E"]  = " 66,180"   // ""
    mmlTable["O3:F"]  = " 90,180"   // ""
    mmlTable["O3:F#"] = "105,150"   // ""
    mmlTable["O3:G"]  = "114,180"   // ""
    mmlTable["O3:G#"] = "130,150"   // "Q"
    mmlTable["O3:A"]  = "137,180"   // "A"
    mmlTable["O3:A#"] = "153,150"   // "W"
    mmlTable["O3:B"]  = "161,180"   // "S"
    mmlTable["O4:C-"] = "161,180"   // "S"

    mmlTable["O3:B#"] = "185,180"   // "D"
    mmlTable["O4:C"]  = "185,180"   // "D"
    mmlTable["O4:C#"] = "197,150"   // "R"
    mmlTable["O4:D"]  = "208,180"   // "F"
    mmlTable["O4:D#"] = "221,150"   // "T"
    mmlTable["O4:E"]  = "232,180"   // "G"
    mmlTable["O4:F"]  = "256,180"   // "H"
    mmlTable["O4:F#"] = "267,150"   // "U"
    mmlTable["O4:G"]  = "279,180"   // "J"
    mmlTable["O4:G#"] = "291,150"   // "I"
    mmlTable["O4:A"]  = "302,180"   // "K"
    mmlTable["O4:A#"] = "315,150"   // "O"
    mmlTable["O4:B"]  = "326,180"   // "L"
    mmlTable["O5:C-"] = "326,180"   // "L"

    mmlTable["O4:B#"] = "349,180"   // ";"
    mmlTable["O5:C"]  = "349,180"   // ";"
    mmlTable["O5:C#"] = "363,150"   // "@"
    mmlTable["O5:D"]  = "373,180"   // ":"
    mmlTable["O5:D#"] = "387,150"   // "["
    mmlTable["O5:E"]  = "396,180"   // "]"
    mmlTable["O5:F"]  = "419,180"   // ""
    mmlTable["O5:F#"] = "431,150"   // ""
    mmlTable["O5:G"]  = "442,180"   // ""
    mmlTable["O5:G#"] = "456,150"   // ""
    mmlTable["O5:A"]  = "466,180"   // ""
    mmlTable["O5:A#"] = "480,150"   // ""
    mmlTable["O5:B"]  = "489,180"   // ""
    mmlTable["O6:C-"] = "489,180"   // ""
    
    mmlTable["O5:B#"] = "512,180"   // ""
    mmlTable["O6:C"]  = "512,180"   // ""

    Result = mmlTable[strMMLCode]
Fend

Procedure ConvertStrToXY( strXY, Var x, Var y )
    Dim strX
    Dim strY
    Dim nPos
    nPos = Pos( ",", strXY )
    strX = Copy( strXY, 1, nPos - 1 )
    strY = Copy( strXY, nPos + 1 )
    x = Val( strX )
    y = Val( strY )
Fend

Function GetKeyCodeByMMLCode( strMMLCode )
    Public HashTbl mmlTable

    mmlTable["O3:C"]  = 0           // ""
    mmlTable["O3:C#"] = 0           // ""
    mmlTable["O3:D"]  = 0           // ""
    mmlTable["O3:D#"] = 0           // ""
    mmlTable["O3:E"]  = 0           // ""
    mmlTable["O3:F"]  = 0           // ""
    mmlTable["O3:F#"] = 0           // ""
    mmlTable["O3:G"]  = 0           // ""
    mmlTable["O3:G#"] = VK_Q        // "Q"
    mmlTable["O3:A"]  = VK_A        // "A"
    mmlTable["O3:A#"] = VK_W        // "W"
    mmlTable["O3:B"]  = VK_S        // "S"
    mmlTable["O3:C-"] = VK_S        // "S"

    mmlTable["O3:B#"] = VK_D        // "D"
    mmlTable["O4:C"]  = VK_D        // "D"
    mmlTable["O4:C#"] = VK_R        // "R"
    mmlTable["O4:D"]  = VK_F        // "F"
    mmlTable["O4:D#"] = VK_T        // "T"
    mmlTable["O4:E"]  = VK_G        // "G"
    mmlTable["O4:F"]  = VK_H        // "H"
    mmlTable["O4:F#"] = VK_U        // "U"
    mmlTable["O4:G"]  = VK_J        // "J"
    mmlTable["O4:G#"] = VK_I        // "I"
    mmlTable["O4:A"]  = VK_K        // "K"
    mmlTable["O4:A#"] = VK_O        // "O"
    mmlTable["O4:B"]  = VK_L        // "L"
    mmlTable["O5:C-"] = VK_L        // "L"

    mmlTable["O4:B#"] = VK_OEM_PLUS // ";"
    mmlTable["O5:C"]  = VK_OEM_PLUS // ";"
    mmlTable["O5:C#"] = VK_OEM_3    // "@"
    mmlTable["O5:D"]  = VK_OEM_1    // ":"
    mmlTable["O5:D#"] = VK_OEM_4    // "["
    mmlTable["O5:E"]  = VK_OEM_6    // "]"
    mmlTable["O5:F"]  = 0           // ""
    mmlTable["O5:F#"] = 0           // ""
    mmlTable["O5:G"]  = 0           // ""
    mmlTable["O5:G#"] = 0           // ""
    mmlTable["O5:A"]  = 0           // ""
    mmlTable["O5:A#"] = 0           // ""
    mmlTable["O5:B"]  = 0           // ""
    mmlTable["O6:C-"] = 0           // ""

    Result = mmlTable[strMMLCode]
Fend

Function ActivateWindow( strCaption )
    Dim winID = GetWindowID( strCaption )
    Dim window_x = Status( winID, ST_X )
    Dim window_y = Status( winID, ST_Y )
    Dim window_width = Status( winID, ST_WIDTH )
    Dim window_height = Status( winID, ST_HEIGHT )
    
    // 画面の中央をクリックしてプログラム(Flash)をアクティブ化する
    // ※ Firefox には未対応(アクティブ化はするが、一旦、Flash をクリックしないとキーボード入力が行えない)
    Dim click_pos_x
    Dim click_pos_y
    click_pos_x = window_x + ( window_width / 2 )
    click_pos_y = window_y + ( window_height / 2 )

    Ifb g_winID <> -1 Then
        ACW( winID )
        BTN( RIGHT, CLICK, click_pos_x, click_pos_y, 10 )
        KBD( VK_ESC, CLICK, 10 )
    EndIf

    Result = winID
Fend

Function GetWindowID( strCaption )
    Dim winID = 0

    // 「eピアノ」のウィンドウIDを取得(IE6~IE9 版)
    winID = GETID( strCaption, "IEFrame" )
    Ifb winID <> -1 Then
        Result = winID
        Exit
    EndIf

    Result = winID
Fend
 |