BMFont _Assistant 生成位图字体/动态字体的辅助脚本

大家好，我是笨笨，笨笨的笨，笨笨的笨，谢谢！

 BMFont _Assistant   是一个用于辅助  bmfont 的小脚本。

 

bmfont_Assistant 源码

'---------------------------------------------------
'大家好，我是笨笨，笨笨的笨，笨笨的笨，谢谢
'bmfont_Assistant by Jerryjin 2015-11-27
'---------------------------------------------------
'bmfont是生成动态字体的好工具。
'bmfont_Assistant 是辅助它的一个脚本
'bmfont用自定义图片生成字体时很坑爹，因为不能多选。
'所以做了这个助手，其实就是复制bmfont生成的配置文件，然后自己遍历文件夹把每个图片文字加进去。
'这里我们订个规则：文件名的最后一个字符为图片文件。比如 red_0.png, red_1.png 这样就取0, 1 出来。
'正反斜杠等无法作为文件名的字符要特殊处理。
'建议1：用其它字符代替。2：自己手动修改配置文件。
'3、直接用它们对应的unicode码做文件名:【 \ : 92 】 【 / : 47 】 【 : : 58 】 【 * : 42 】 【 ? : 63 】 【 "" : 34 】 【 < : 60 】 【 > : 62 】 【 | : 124 】。
' 比如冒号的美术字：red58.png red_58.png jfopaiefupa58.png 反正最后一串数字是就行了
'如果当前文件夹未找到配置文件，就会自动打开 bmfont.exe 这时设置下参数，然后关闭就可以了
'要改的参数主要也就是：
'输出贴图的尺寸：看情况，节省着用就是了。够放下所有文字就行了
'图位深度：自定义肯定是彩色啦 我用 32 因为选了8就只能出灰度图。我也没多想
'输出格式：我先了PNG
'------------------------------------------------------------------
'添加了直接运行脚本弹出说明提示
'添加了无配置文件时，弹出 bmfont 的输出设置窗口
'添加了输出贴图尺寸的自动记算（算法太不精确。有空要研究一下。）
'生成完字体，询问是否清除配置文件。
'------------------------------------------------------------------

Dim fd,currentpath,configFileName,configFileFullPath,oExec
'==========================================================
'----------准备 object ----------
Set objDict = CreateObject("Scripting.Dictionary")
Set WshShell=Wscript.CreateObject("Wscript.Shell")
'----------准备文件读写----------
Set fso = CreateObject("Scripting.FileSystemObject")
'==========================================================
'---------- 初始化变量 ----------
currentpath  = fso.GetFile(Wscript.ScriptFullName).ParentFolder.Path 
configFileName = "bmfont.bmfc"
configFileFullPath = currentpath & "\" & configFileName

'==========================================================
If WScript.Arguments.Count = 0 Then
	Call MsgBox("将存放美术字的文件夹拖到脚本上即可！(生成的字体会与此文件夹同名，图片对应的文字就是文件名的最后一字符！正反斜杠等无法作为文件名的字符要特殊处理，建议1：用其它字符代替。2：自己手动修改配置文件。3、直接用它们对应的unicode码做文件名【 \ : 92 】 【 / : 47 】 【 : : 58 】 【 * : 42 】 【 ? : 63 】 【 "" : 34 】 【 < : 60 】 【 > : 62 】 【 | : 124 】。 比如冒号的美术字：red58.png)" & vbCrLf  & vbCrLf   & "如果当前文件夹未找到配置文件，就会自动运行 bmfont.exe 打开 Options》Export Options 窗口，请按所需设置然后关闭即可。" & vbCrLf  & "一般主要是改如下参数：" & vbCrLf  & "图片位深度：Bit depth：32"& vbCrLf  & "图片格式：Textures：png - Portable Network Graphics" & vbCrLf  & "贴图尺寸脚本会自动算不用写！"& vbCrLf   ,1+64+256,"使用说明！")
	WScript.Quit (0)  
End if

'---------- 遍历命令行参数 （也就是拖上来的文件夹） ----------
Set CommandLineArguments = WScript.Arguments 
    For Each Argument In CommandLineArguments
    	If fso.FolderExists(Argument) Then '如果文件夹存在就执行，当然不存的可能貌似也不大
    		Set fd = fso.GetFolder(Argument)
			currentConfig = ProcessAllFiles(Argument)
			If configN = Null Then
				MsgBox "生成配置文件失败！"
			End If
			objDict.Add currentConfig, fd.Name '配置文件名、字体名 加入字典（字体名就用切图所有的文件夹名字）
			Set fd = Nothing
		End If	
    Next    
Set oArgs = Nothing

' 以下是遍历字典,批量执行生成字体的命令
Dim objKeys, objItems, i
objKeys = objDict.Keys
objItems = objDict.Items
For i = 0 To objDict.Count - 1
	'WScript.Echo objKeys(i)&"  "&objItems(i)
    BatchBmfont objKeys(i),objItems(i)
Next
	'字体生成完毕，是否清除配置文件？
	msgboxReturn = MsgBox("动态字体生成完毕，是否清除配置文件？",1+64+256,"是否清除配置文件？")
	If msgboxReturn = 1 Then  
		'删除配置文件
		Call fso.DeleteFile(currentpath&"\*_bmfont.bmfc") '& configFile)
	End if
Set objDict = Nothing

'=====================================================================================
'* 遍历文件夹
'******************************
Function ProcessAllFiles(folderspec)        
    Dim baseName, extensioName, configTxt, textureSize, chrUnicode 'sfds, sfd,
    Dim imageList, fd, fs, f
    Set imageList = CreateObject("Scripting.Dictionary")
    Set fd = fso.GetFolder(folderspec)
    Set fs = fd.Files   
	
    newConfigFileName = fd.Name & "_bmfont.bmfc"
    newConfigFullPath = currentpath & "\" & newConfigFileName    
    
    '遍历文字图片，找文件名中的最后一个字符，取出unicode码
    For Each f in fs	
    	baseName = fso.GetBaseName(f)'取文件名
    	extensioName = UCase(fso.GetExtensionName(f)) '取扩展名,并转大写方便下面比较
        If extensioName = "BMP" Or extensioName = "JPG" Or extensioName = "TGA" Or extensioName = "DDS" Or extensioName = "PNG" Then
        	chrUnicode = RegExpMatch("\d+$",baseName)
        	If chrUnicode <> "" then
	        	'如果文件名末尾是以下字符的 unicode码 那就直接使用
	        	Select Case chrUnicode
	        	    Case 92 '美术字为 \ 
	        	    	chrUnicode = 92
	        	    Case 47 '美术字为 / 
	        	    	chrUnicode = 47
	        	    Case 58 '美术字为 : 
	        	    	chrUnicode = 58
	        	    Case 42 '美术字为 * 
	        	    	chrUnicode = 42
	        	    Case 63 '美术字为 ? 
	        	    	chrUnicode = 63
	        	    Case 34 '美术字为 " 
	        	    	chrUnicode = 34
	        	    Case 60 '美术字为 < 
	        	    	chrUnicode = 60
	        	    Case 62 '美术字为 > 
	        	    	chrUnicode = 62
	        	    Case 124 '美术字为 | 
	        	    	chrUnicode = 124    
	        	    Case Else '取最后一个字符的 unicode码
	        	    	chrUnicode = char2Unicode(right(baseName,1))
	        	End Select       
	        Else
	        	'否则取最后一个字符的 unicode码
	        	chrUnicode = char2Unicode(right(baseName,1))
        	End if
            configTXT = configTxt & "icon="""& fd.Name &"/" & f.Name &"""," & chrUnicode &",0,0,0" & vbCrLf 
        End If
    Next

	'判断 bmfont.bmfc 是否存在，如果不在提示生成
    If Not fso.FileExists(configFileFullPath) Then
		'---提示未找到配置文件的情况--
		'msgboxReturn = MsgBox("运行 bmfont.exe 生成配置文件 bmfont.bmfc"&  vbCrLf  &"参数：" & vbCrLf  & "图片位深度：Bit depth：32"& vbCrLf  & "图片格式：Textures：png - Portable Network Graphics",1+64+256,"未找到配置文件！")
		'If msgboxReturn = 1 Then  	
		If true Then  
			Set oExec = WshShell.Exec(currentpath&"\"&"bmfont.exe")
			
			'打开输出设置窗口o
			WshShell.AppActivate "Bitmap font generator"
			WScript.Sleep 100
			WshShell.SendKeys "%o"
			WScript.Sleep 100
			WshShell.SendKeys "o"
			
			'bmfont.exe 关闭前一直等待
			Do While oExec.Status <> 1 'fso.FileExists(configFileFullPath)
     			WScript.Sleep 100
			Loop
    	Else
    		WScript.Quit (0)	
		End If
    End If

	'找到原始配置文件 bmfont.bmfc 文件复制出新的，并写入数据
    If fso.FileExists(configFileFullPath) Then
    	newConfigFullPath = currentpath & "\" & fd.Name & "_bmfont.bmfc"
    	fso.CopyFile configFileFullPath, newConfigFullPath
    	
    	Do While Not fso.FileExists(newConfigFullPath)
    		WScript.Sleep 100
    	loop  	
    	
    	'写入数据（图片文字和对应Unicode的数据）
    	appendTXT newConfigFullPath, configTxt    	
    	'计算出最节省的贴图面积    
    	textureSize = GetTextureSize(fs) 
    	'改贴图尺寸
    	SetIni newConfigFullPath ,"output file", "outWidth", textureSize(0)
    	SetIni newConfigFullPath ,"output file", "outHeight", textureSize(1)
    	'一切成功，返回所创建的config的名字
    	ProcessAllFiles = newConfigFileName 
    	'退出函数
    	exit Function 
    End If 
    			
    ProcessAllFiles = Null '没成功才会走到这里返回 null
        
End Function

'* 读取文件名最后一个字转unicode码
'******************************
Function char2Unicode(str)
	'WScript.Echo 	clng("&h" & hex((AscW(str))))
	char2Unicode = clng("&h" & hex((AscW(str))))
End Function

'* 文件末尾追加文本
'******************************
Sub appendTXT(textFileName,str)
	set fso = createobject("scripting.filesystemobject")	
	' 读取文件
	set stream = fso.opentextfile(textFileName,8,False)
	stream.Write str
    stream.Close
End Sub

'* 批量执行 bmfont.exe 生成字体
'******************************
Function BatchBmfont(configFile,fontFile)  
	set fso = createobject("scripting.filesystemobject")
	WshShell.run currentpath&"\"&"bmfont.exe -c" & currentpath&"\"& configFile & " -o " & currentpath&"\"&fontFile,,True
	'WScript.Echo currentpath&"\"&"bmfont.exe -c" & currentpath&"\"& configFile & " -o " & currentpath&"\"&fontFile
	'生成字体后，删除临时配置文件
	'fso.DeleteFile(currentpath&"\"& configFile)
End Function


'* 获取图片尺寸
'******************************
Function GetSize(imageName)  
	Set Img = CreateObject("WIA.ImageFile")
	Img.LoadFile imageName
	Dim size(2)
	size(0) = Img.Width
	size(1) = Img.Height
	GetSize = size
	'WScript.Echo "Width = " & Img.Width
	'WScript.Echo "Height = " & Img.Height
End Function

'* 记算贴图尺寸
'******************************
Function GetTextureSize(imageList)
	Dim Width,Height,m
	Dim imageSize,textureSize(2)
	
	m = 0
	'设补始贴图尺寸为 64x64
	Width = 64
	Height = 64
	
	'遍历文件夹下的图片，算出总长宽
    For Each image In imageList
    	imageSize = GetSize(image.path)
		m = m + imageSize(0) * imageSize(1)		
    Next 
    '为了防止放不下的情况，给面积加上它自己的1/3
    m = m+ m/2
    
	'如果 ts*tx 放不下 所有文字,就 ts * 2 直到能放下为止
	Do
		If m > Width * Height Then
			Height = Height*2
		Else
			Exit Do
		End If
		
		If m > Width * Height Then
			Width = Width*2
		Else
			Exit Do
		End If
		'MsgBox " W : " & w & "  " & " H : " & h & "  " & " w*h : " & w * h & vbcrlf&"ts : " & ts & "  ts*ts : " & ts * ts
	Loop
	textureSize(0) = Width
	textureSize(1) = Height
	'WScript.Echo "文件夹: " & fd.Path &  vbCrLf & "图字面积 : " & m & vbCrLf &"贴图尺寸: " & ts & "  贴图面积: " & ts * ts

	'返回贴图的尺寸,长宽放在一个数组里
	GetTextureSize = textureSize	
End Function

'* 读写配置文件
'******************************
'VBS 读 INI配置文件 GetIni(文件名,章节名，KEY)
Sub GetIni(TxtFileFullPath,strPrimary ,strKey) 
    Dim myfso 
    Dim intCount , strState 
    Set myfso =  CreateObject("Scripting.FileSystemObject")

    Set TextFile = myfso.OpenTextFile(TxtFileFullPath, 1, False, False)
    With TextFile
        Do Until .AtEndOfStream
            If intCount = 0 Then '到了指定小节，下一行才开始读KEY。不然一直找小节名
                If .ReadLine = "# " & strPrimary Then
                    intCount = 1
                End If
            Else 
                strState = .ReadLine
                If UCase(Left(strState, Len(strKey & "="))) = UCase(strKey & "=") Then '找到KEY
                    GetIni = Right(strState, Len(strState) - Len(strKey & "=")) '就返回值
                End If
            End If
        Loop
        .Close
    End With
    '打扫卫生,省屁吹灯
    Set TextFile = Nothing
    Set myfso = Nothing
End Sub

'VBS 写 INI配置文件 GetIni(文件名, 章节名, KEY, Value)
Sub SetIni(TxtFileFullPath,strPrimary,strKey,strValue)
	Dim intCount,strTmp
	Const ForReading = 1
	Const ForWriting = 2
	Set myfso = CreateObject("Scripting.FileSystemObject")
	Set TextFile = myfso.OpenTextFile(TxtFileFullPath, ForReading)
	Do Until TextFile.AtEndOfStream 
		strLine = TextFile.ReadLine
		If intCount = 0 Then '到了指定小节，下一行才开始读KEY。不然一直找小节名
            If strLine = "# " & strPrimary Then
                intCount = 1
            End If
	    Else
			If InStr(strLine,strKey)<>0 Then '如果是要找的 key 改值
				strLine=strKey&"="&strValue 
			End If				
		End If
		strTmp=strTmp&strLine&vbCrLf '如果不等于要找的key 直接保存
	Loop
	TextFile.Close
	
	'打开文本文件，把结果写入
	Set TextFile = myfso.OpenTextFile(TxtFileFullPath, ForWriting)
	TextFile.WriteLine strTmp
	
	'打扫卫生,省屁吹灯
	TextFile.Close
	Set TextFile = Nothing
	Set myfso=Nothing
End Sub 

'正则匹配返回匹配内容拼接的字符串，用空格分隔 MsgBox(RegExpMatch("\d+$","123a44"))
Function RegExpMatch(patrn, strng)
	Dim regEx, Match, Matches   ' 建立变量。
	Set regEx = New RegExp   ' 建立正则表达式。
	regEx.Pattern = patrn   ' 设置模式。
	regEx.IgnoreCase = True   ' 设置是否区分大小写。
	regEx.Global = True   ' 设置全程可用性。
	Set Matches = regEx.Execute(strng)   ' 执行搜索。
	For Each Match In Matches      ' 遍历 Matches 集合。
		RetStr = RetStr & Match.value &" "   '匹配的值
	Next
	RegExpMatch = Trim(RetStr)
End Function
'正则匹配返回匹配内容的集合 MsgBox(RegExpMatchs("\d+","123a44"))
Function RegExpMatchs(patrn, strng)
	Dim regEx, Match, Matches   ' 建立变量。
	Set regEx = New RegExp   ' 建立正则表达式。
	regEx.Pattern = patrn   ' 设置模式。
	regEx.IgnoreCase = True   ' 设置是否区分大小写。
	regEx.Global = True   ' 设置全程可用性。
	Set RegExpMatchs = regEx.Execute(strng)   ' 执行搜索。Matches '返回集合
End Function

bmfont + bmfont_Assistant  + 测试文字 打包下载（百度盘）  密码: hhty

 BMFont 在网上教程很多，这里就不细说，主要讲下和这个辅助脚本有关的部分。

一句话教程：

如果你赶时间其实就一句，图片放文件夹里，文件夹拖到脚本上放手OK了：

如果一句话教程不能满足你，那就看看下面吧：

 

如要你想要使用动态字体或者叫位图字体，那一到网上搜搜肯定会看到 bmfont （ Bitmap Font Generator）  真是个不错的好东西。

可以生成我们所需要的动态字体，最主要还免费。

-------------------------普通文字-------------------------

如果只是想从某个字体中提取一部分文字出来那还是很方便的。

首先打开 bmfont ：

然后从这里打开对话框先一个文本文件，那么里面的字就会都标记好了。只要保存动态字体就行了。

 

 

-------------------------美术字-------------------------

但是游戏中经验会用到一些美术字来做动态字体。这就比较坑了，因为bmfont 只能一张图一张图 添加再设置，说白了有多少个字就要设置多少遍。点到手断的节奏啊有木有。

所做了个小脚本来辅助一下。

这里我们要先商定些规则。比如 bmfont  怎么知道每张图对应哪个字，它又不识字。所以我们将图片文件名的最后一个字符与图片内容相同。

其实通常我们也就是这么做的。比如做一组数字的美术字它们的名字也就分别是 0.png  1.png  2.png 这样，复杂点的像 red_0.png   red_1.png  red_2.png 这个应该还是比较好理解的吧。然后将它放进一个叫 red 的文件夹下。我们可能会做很多不同的颜色的文字那么每个文件夹就对应一个字体。

如图：（刀塔传奇里的资源，满大街都是正好拿来做演示）

在上图中可能你也注意到了，有一些无法作为文件名的字符会给我们带来些麻烦。比如这个冒号

方案有三个：

1、直接换个字符代替它。反正一个字体里空着没使用的字符多了去了。

2、但对于某些完美主义来说，这种事是无法接受的，那就回到最原始的方法手动去修改下吧。

2.1、生成字体时会自动创建对应的配置文件，加载它来修改其实简化了很多了。先拖一次获得它的配置文件就行！

2.2、打开 Image Manager

2.3、以冒号为例：

<1、将鼠标放到冒号的格式下。

<2、在2处可以看到冒号的unicode码是58。

<3、在Image Manager列表中选中冒号的图片

<4、打开 Edit image

<5、把ID 改为 58 然后确定。

3、直接用这些字符对应的unicode码做文件名【 \ : 92 】 【 / : 47 】 【 : : 58 】 【 * : 42 】 【 ? : 63 】 【 "" : 34 】 【 < : 60 】 【 > : 62 】 【 | : 124 】。

比如冒号的美术字：red58.png 或都 red_58.png 都可以，只要末尾是以上这些数字就可
 

4、最后当然就是 Ctrl + S 保存字体啦。

 

对了还有通常我们还要设置两个参数：