Public Class Form1 Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load ToolStripButton1.Text = "[フォント名表示]" ToolStripButton2.Text = "[html 作成]" Label1.Text = "c:\Windows\Fonts" End Sub Private Sub ToolStripButton1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripButton1.Click Dim dir As String = "" Dim fname As String = "" '************************************************************************** '指定したしたフォルダ内の，指定した拡張子のファイル名をlistBoxに列挙する '************************************************************************** dir = Label1.Text ListBox1.Items.Clear() For Each fname In System.IO.Directory.GetFiles(dir) If System.IO.Path.GetExtension(fname) = ".ttf" Then ListBox1.Items.Add(System.IO.Path.GetFileName(fname)) If System.IO.Path.GetExtension(fname) = ".TTF" Then ListBox1.Items.Add(System.IO.Path.GetFileName(fname)) If System.IO.Path.GetExtension(fname) = ".ttc" Then ListBox1.Items.Add(System.IO.Path.GetFileName(fname)) If System.IO.Path.GetExtension(fname) = ".TTC" Then ListBox1.Items.Add(System.IO.Path.GetFileName(fname)) Next fname End Sub Private Sub ToolStripButton2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripButton2.Click Dim sw As System.IO.StreamWriter Dim fnameW As String = "" Dim i As Integer Dim dat As String = "" Dim fnameF As String = "" Dim fnameI As String = "" Dim fnameB As String = "" Dim dirW As String = "" Dim img As Image Dim nl As Integer Dim datnl(3) As String '書出用htmlファイル指定 SaveFileDialog1.InitialDirectory = System.IO.Directory.GetCurrentDirectory() If SaveFileDialog1.ShowDialog() = DialogResult.OK Then fnameW = SaveFileDialog1.FileName End If 'カレントフォルダをhtmlファイルを作る場所(InageMagick実行フォルダ)に移動 My.Computer.FileSystem.CurrentDirectory = System.IO.Path.GetDirectoryName(fnameW) dirW = My.Computer.FileSystem.CurrentDirectory 'コマンドプロンプトでのImageMagick実行 nl = 4 For i = 0 To ListBox1.Items.Count - 1 fnameF = Label1.Text & "\" & ListBox1.Items(i).ToString() fnameI = dirW & "\imfdat\imf" & i.ToString("000") & ".png" datnl(0) = "convert -trim -background white -fill navy -font " & fnameF & " -pointsize 32 label:@inp.txt " & fnameI datnl(1) = "convert -bordercolor ""#ffffff"" -border 5 " & fnameI & " " & dirW & "\imfdat\temp.png" datnl(2) = "del " & fnameI datnl(3) = "rename " & dirW & "\imfdat\temp.png imf" & i.ToString("000") & ".png" Call ECA(nl, datnl) Next i 'htmlファイル書出 sw = New System.IO.StreamWriter(fnameW, False, System.Text.Encoding.GetEncoding("shift-jis")) sw.WriteLine("") sw.WriteLine("") sw.WriteLine("") sw.WriteLine("") For i = 0 To ListBox1.Items.Count - 1 fnameF = Label1.Text & "\" & ListBox1.Items(i).ToString() fnameI = System.IO.Path.GetDirectoryName(fnameW) & "\imfdat\" & "imf" & i.ToString("000") & ".png" img = Image.FromFile(fnameI) '画像サイズデータ収集用 sw.WriteLine("") sw.WriteLine("") sw.WriteLine("") sw.WriteLine("") sw.WriteLine("") sw.WriteLine("") Next i sw.WriteLine("

") sw.WriteLine(System.IO.Path.GetFileName(fnameF)) sw.WriteLine("

") sw.WriteLine("") sw.WriteLine("

") sw.WriteLine(img.Width.ToString("0") & "x" & img.Height.ToString("0")) sw.WriteLine("

") sw.WriteLine("") sw.WriteLine("") sw.Close() MessageBox.Show("処理完了", "通知") End Sub Private Sub ECA(ByVal nl As Integer, ByRef datnl() As String) '***************************************************** 'DOSコマンド実行 '***************************************************** Dim pr As System.Diagnostics.Process Dim sw As System.IO.StreamWriter 'Dim dat As String = "" Dim i As Integer pr = New System.Diagnostics.Process() pr.StartInfo.FileName = "cmd.exe" pr.StartInfo.RedirectStandardInput = True pr.StartInfo.RedirectStandardOutput = True pr.StartInfo.UseShellExecute = False pr.StartInfo.CreateNoWindow = True pr.Start() sw = pr.StandardInput For i = 0 To nl - 1 sw.WriteLine(datnl(i)) Next i sw.Close() pr.WaitForExit() pr.Close() End Sub End Class