Option Explicit On Option Strict On Public Class Form1 Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim sr As System.IO.StreamReader Dim sw As System.IO.StreamWriter Dim sw1 As System.IO.StreamWriter Dim sw2 As System.IO.StreamWriter Dim fnameR0 As String = "" Dim fnameR As String = "" Dim fnameW As String = "" Dim fnameW1 As String = "" Dim fnameW2 As String = "" Dim fnameI As String = "" Dim dat As String Dim sbuf() As String Dim delim As Char = " "c Dim i As Integer Dim j As Integer Dim k As Integer Dim nd As Integer Dim nn As Integer Dim mm As Integer Dim scname(,) As String Dim scnend(,) As String Dim iflg As Integer = 0 Dim icol As Integer Dim ww As Integer = 88 Dim hh As Integer = 31 Dim LastNonEmpty As Integer Dim nl As Integer = 1 Dim datnl() As String ReDim datnl(nl - 1) nn = 1000 : mm = 3 ReDim scname(nn, mm) ReDim scnend(1, mm) '入出力ファイル指定 OpenFileDialog1.InitialDirectory = System.IO.Directory.GetCurrentDirectory() If OpenFileDialog1.ShowDialog() = DialogResult.OK Then fnameR = OpenFileDialog1.FileName If SaveFileDialog1.ShowDialog() = DialogResult.OK Then fnameW = SaveFileDialog1.FileName fnameR0 = fnameR 'データ読み込み sr = New System.IO.StreamReader(fnameR0, System.Text.Encoding.Default) i = 0 Do Until sr.EndOfStream dat = sr.ReadLine() dat = dat.Trim() sbuf = dat.Split(delim) sbuf = Split(dat) LastNonEmpty = -1 For j = 0 To sbuf.Length - 1 If sbuf(j) <> "" Then LastNonEmpty += 1 sbuf(LastNonEmpty) = sbuf(j) End If Next For j = 1 To mm scname(i, j) = sbuf(j - 1).Trim() Next j '並び替え用の小文字変換 scname(i, 0) = scname(i, 1).ToLower() '文字列rgbの削除（rgbaは残す） If scname(i, 2).Substring(0, 4) <> "rgba" Then scname(i, 2) = scname(i, 2).Remove(0, 3) i = i + 1 Loop sr.Close() nd = i - 1 'ImageMagick実行 For i = 0 To nd fnameI = System.IO.Path.GetDirectoryName(fnameR) & "\imcoldat\" & scname(i, 0) & ".png" datnl(0) = String.Format("convert -size {0:D}x{1:D} canvas:{2:s} {3:s}", ww, hh, scname(i, 1), fnameI) ECA(nl, datnl) Next i '一般職と灰色でのデータ振り分け書き込み fnameW1 = System.IO.Path.GetDirectoryName(fnameR0) & "\out_color1.txt" fnameW2 = System.IO.Path.GetDirectoryName(fnameR0) & "\out_color2.txt" sw1 = New System.IO.StreamWriter(fnameW1, False, System.Text.Encoding.Default) sw2 = New System.IO.StreamWriter(fnameW2, False, System.Text.Encoding.Default) For i = 0 To nd iflg = 1 If 0 = scname(i, 0).IndexOf("gray") Or 0 = scname(i, 0).IndexOf("grey") Then For k = 0 To 100 If scname(i, 0).Replace("gray", "") = k.ToString("0") Then iflg = 2 If scname(i, 0).Replace("grey", "") = k.ToString("0") Then iflg = 2 Next k End If dat = scname(i, 0) & " " & scname(i, 1) & " " & scname(i, 2) & " " & scname(i, 3) Select Case iflg Case 1 : sw1.WriteLine(dat) Case 2 : sw2.WriteLine(dat) End Select Next i sw1.Close() sw2.Close() 'HTMLファイル書き出し sw = New System.IO.StreamWriter(fnameW, False, System.Text.Encoding.Default) sw.WriteLine("") sw.WriteLine("") sw.WriteLine("") '一般色 fnameR = System.IO.Path.GetDirectoryName(fnameR) & "\out_color1.txt" sr = New System.IO.StreamReader(fnameR, System.Text.Encoding.Default) icol = 0 Call WHTML(sr, sw, icol, ww, hh) '灰色 fnameR = System.IO.Path.GetDirectoryName(fnameR) & "\out_color2.txt" sr = New System.IO.StreamReader(fnameR, System.Text.Encoding.Default) icol = 3 Call WHTML(sr, sw, icol, ww, hh) sw.WriteLine("

") sw.WriteLine("
") sw.WriteLine("") sw.WriteLine("") sw.Close() MessageBox.Show("処理完了", "通知") End Sub Private Sub WHTML(ByVal sr As System.IO.StreamReader, ByVal sw As System.IO.StreamWriter, _ ByVal icol As Integer, ByVal ww As Integer, ByVal hh As Integer) Dim dat As String Dim sbuf() As String Dim delim As Char = " "c Dim i As Integer Dim k As Integer Dim iflg As Integer Dim nd As Integer Dim wstr(,) As String Dim swk As String = "" Dim fnameI As String = "" ReDim wstr(1000, 3) 'データ読み込み i = 0 Do Until sr.EndOfStream dat = sr.ReadLine() sbuf = dat.Split(delim) wstr(i, 0) = sbuf(0) wstr(i, 1) = sbuf(1) wstr(i, 2) = sbuf(2) wstr(i, 3) = sbuf(3) i = i + 1 Loop sr.Close() nd = i - 1 '並び替え Select Case icol Case 0 : SORTS(nd, icol, wstr) Case 3 : SORTL(nd, icol, wstr) End Select sw.WriteLine("") sw.WriteLine("") sw.WriteLine("png画像") sw.WriteLine("") sw.WriteLine("") sw.WriteLine("カラーネーム") sw.WriteLine("") sw.WriteLine("") sw.WriteLine("16進表示") sw.WriteLine("") sw.WriteLine("") sw.WriteLine("(r, g, b)") sw.WriteLine("") sw.WriteLine("") For k = 1 To 2 For i = 0 To nd iflg = 0 Select Case k Case 1 : If wstr(i, 0) = "none" Or wstr(i, 0) = "transparent" Then iflg = 1 Case 2 : If wstr(i, 0) <> "none" And wstr(i, 0) <> "transparent" Then iflg = 1 End Select If iflg = 0 Then fnameI = wstr(i, 0) & ".png" sw.WriteLine("") sw.WriteLine("") sw.WriteLine("") sw.WriteLine("") sw.WriteLine("") sw.WriteLine(wstr(i, 1)) '色名 sw.WriteLine("") sw.WriteLine("") sw.WriteLine(wstr(i, 3)) '16進数 sw.WriteLine("") sw.WriteLine("") sw.WriteLine(wstr(i, 2)) 'RGB sw.WriteLine("") sw.WriteLine("") End If Next i Next k End Sub Private Sub SORTL(ByVal nd As Integer, ByVal icol As Integer, ByRef wstr(,) As String) Dim i As Integer Dim j As Integer Dim swk As String '大きい順の並び替え For i = 0 To nd For j = nd To i + 1 Step -1 If wstr(j, icol) > wstr(j - 1, icol) Then swk = wstr(j, 0) : wstr(j, 0) = wstr(j - 1, 0) : wstr(j - 1, 0) = swk swk = wstr(j, 1) : wstr(j, 1) = wstr(j - 1, 1) : wstr(j - 1, 1) = swk swk = wstr(j, 2) : wstr(j, 2) = wstr(j - 1, 2) : wstr(j - 1, 2) = swk swk = wstr(j, 3) : wstr(j, 3) = wstr(j - 1, 3) : wstr(j - 1, 3) = swk End If Next j Next i End Sub Private Sub SORTS(ByVal nd As Integer, ByVal icol As Integer, ByRef wstr(,) As String) Dim i As Integer Dim j As Integer Dim swk As String '小さい順の並び替え For i = 0 To nd For j = nd To i + 1 Step -1 If wstr(j, icol) < wstr(j - 1, icol) Then swk = wstr(j, 0) : wstr(j, 0) = wstr(j - 1, 0) : wstr(j - 1, 0) = swk swk = wstr(j, 1) : wstr(j, 1) = wstr(j - 1, 1) : wstr(j - 1, 1) = swk swk = wstr(j, 2) : wstr(j, 2) = wstr(j - 1, 2) : wstr(j - 1, 2) = swk swk = wstr(j, 3) : wstr(j, 3) = wstr(j - 1, 3) : wstr(j - 1, 3) = swk End If Next j Next i 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