【UTAU插件】辅音速度重载

背景

饴屋大大在开发UTAU的时候规定了音符的福音速的的范围是0~200，但在UTAU中音符属性设置的时候却可以设超过200的数值，并且能够让引擎使用，这算UTAU的一个Bug。

矛盾

当你在UTAU中将音符设为超过200的数值了，并保存了文件，但是第二次在UTAU中打开这个文件时，超过200的辅音速度会被忽略。【说得简单点，如果你想用200以上的辅音速度，那么必须一次调音完一次导出】

需求

可能在某些音源中，辅音速度超过200是需要的（可能辅音太长）。因此我认为开发者规定的辅音速度范围存在不合理性。

原理

由于UTAU打开文件或者是插件规范中都把辅音速度的范围限死了，所以本插件只能使用一种投机取巧的办法，利用模拟按键在UTAU中批量重新输入辅音速度。

 

方法

①建立插件

• 在.../UTAU/plugins目录下新建一个文件夹，命名为“辅音速度重载”
• 在“辅音速度重载”文件夹内新建两个文本文档，第一个命名为“plugin.txt”，第二个命名为"plugin.vbs"（需要显示扩展名）
• plugin.txt中输入以下内容并保存

  name=辅音速度重载
  execute=plugin.vbs
  shell=use

• plugin.vbs（不要直接打开，右键-编辑）中输入后文“脚本”中的内容并保存

（也可以直接下载本插件解压到.../UTAU/plugins目录下）

链接:https://pan.baidu.com/s/1sXBquLKX55KbJsoAXnC3lA 提取码:utau

③打开UST后，选择第一个音符（其实不选也没关系，只是选了可以提高效率）

（打开没有辅音速度大于200的UST时无需使用本插件。反之，如果自己懒得重输的话，可以使用本插件。）

④使用插件，等待模拟按键结束即可（不要切换到别的窗口）。

 

脚本

plugin.vbs

REM 2020.04.28

Dim filePath
Dim proName
Dim pluginCodes
Dim utauCodes
Dim utauVelo()
Dim utauArr
Dim pluginArr
Dim firstIndex

REM 主程序部分

Set objArgs = WScript.Arguments
title = "辅音速度重载"

Form_Load
RunKeys

REM 模块部分

Sub Form_Load()

	Dim cur
	Dim i

	REM 判断是否获取到命令行参数
	
	if objArgs.Count = 0 then
		MsgBox "请在UTAU中运行！", vbExclamation, title
		WScript.Quit
	else
		x = msgbox("请在打开UST后没有进行任何操作的情况下运行本插件，否则请点击取消。", VbOkCancel, title)
		if x = vbCancel then
			WScript.Quit
		end if
		filePath = objArgs(0)
	end if
	
	REM 从临时文件推测UST路径
	
	Set fs = CreateObject("scripting.filesystemobject")
	Set ts = fs.OpenTextFile(filePath, 1)
	pluginCodes = ts.ReadAll
	ts.Close

	pluginArr = Split(pluginCodes, vbCrLf)
	proName = getProjectName()
	
	if proName = "" then
		MsgBox "请先保存UST文件！", vbExclamation, title
		WScript.Quit
	end if
	
	
	REM 从临时文件中推测当前音符的序号
	
	cur = -1
	
	For i = LBound(pluginArr) To UBound(pluginArr)
    
        If (Mid(pluginArr(i), 1, 1) = "[") Then
			cur = getNumber(pluginArr(i))
            If (cur > -1) Then
				Exit For
            End If
        End If
		
	next
	
	firstIndex = cur
	
	REM 读取目标UST文件
	
	Set fs = CreateObject("scripting.filesystemobject")
	Set ts = fs.OpenTextFile(proName, 1)
	utauCodes = ts.ReadAll
	ts.Close
	 
    utauArr = Split(utauCodes, vbCrLf)
	
	REM 从UST文件中获取辅音速度
	
	cur = 0
        
    For i = LBound(utauArr) To UBound(utauArr)
    
        If (Mid(utauArr(i), 1, 1) = "[") Then
			cur = getNumber(utauArr(i))
            If (cur > -1) Then
                ReDim Preserve utauVelo(cur + 1)
                utauVelo(cur) = 100
            End If
        End If
        
        If (Mid(utauArr(i), 1, 8) = "Velocity") Then
            utauVelo(cur) = getNumber(utauArr(i))
        End If
		
		REM 标记休止符
		
		If (Mid(utauArr(i), 1, 5) = "Lyric") Then
			if (isRest(Mid(utauArr(i), 7))) Then
				utauVelo(cur) = -1
			end if
		end if
        
    Next
	
	output = ""
	total = 0
	
	For i = LBound(utauVelo) To UBound(utauVelo) - 1
		
		if utauVelo(i) > 200 then
			output = output & i & "." & utauVelo(i) & "  "
			total = total + 1
		end if
		
	Next
	
	Msgbox output, vbOKOnly, "需要重载" & total & "个辅音速度"

End Sub

Sub RunKeys()

	Dim i
	Dim j
	Dim cur
	
	Set WshShell = WScript.CreateObject("WScript.Shell")
	
	if firstIndex = -1 Then
		firstIndex = UBound(utauVelo) - LBound(utauVelo)
	End if
	
	REM 退出插件
	
	WshShell.SendKeys "%{F4}"
	WshShell.SendKeys "^N"
	
	REM 移动到第一个音符
	
	WshShell.SendKeys "^n"
	
	for i = firstIndex + 1 to 0 Step -1
		WshShell.SendKeys "^b"
	Next
	
	cur = LBound(utauArr)
	
	for i = LBound(utauVelo) to UBound(utauVelo)
		if utauVelo(i) <> -1 Then
		
			REM 找到需要操作的音符（辅音速度>200）
			
			if utauVelo(i) > 200 Then
			
				REM 打开属性
			
				WshShell.SendKeys "^e"
				
				REM 移动焦点到辅音速度文本框
			
				for j = 1 to 11
					WshShell.SendKeys "{TAB}"
				next
				
				REM 删除原有值
			
				for j = 1 to 5
					WshShell.SendKeys "{DELETE}"
				next
				
				REM 写入UST中的数值
			
				WshShell.SendKeys utauVelo(i)
				
				REM 确定
			
				WshShell.SendKeys "{ENTER}"
				
			end if
			
			REM 移动到下一个音符
			
			WshShell.SendKeys "^n"
			
		end if
	next

End Sub

REM 获取工程信息

Function getProjectName()
	
	Dim s
	Dim i
	
    s = ""
    
    For i = LBound(pluginArr) To UBound(pluginArr)
        If Mid(pluginArr(i), 1, 7) = "Project" Then
            s = Mid(pluginArr(i), 9)
            Exit For
        End If
    Next
    
    getProjectName = s

End Function

REM 获取字符串中的数字

Function getNumber(s)

    Dim i
    Dim cur
	Dim str
    Dim num
    
    str = ""
    num = -1
    
    For i = 1 To Len(s)
        cur = Mid(s, i, 1)
        If (cur >= "0" And cur <= "9") Or cur = "." Then
            str = str + cur
        End If
    Next
    
    If str <> "" Then
        num = CInt(str)
    End If
	
    getNumber = num
    
End Function

REM 判断是否为休止符

Function isRest(s)

    Dim i
	Dim cur
    Dim flag
	Dim flag2
    
    flag = True
	flag2 = False
    
    For i = 1 To Len(s)
        cur = Mid(s, i, 1)
        
		If (cur = "R" Or cur = "r") Then
			If Not flag2 Then
				REM 判断是否为第一次出现
				flag2 = True
			Else
				flag = False
				Exit For
			End If
		ElseIf cur <> " " Then
            flag = False
            Exit For
        End If
		
    Next
    
    isRest = flag

End Function

写在后面：如果开发者日后开发了新版本的UTAU并消除了这个Bug，那么本帖作废ε=(´ο｀*)))。