Option Explicit On
Option Strict On
Public Class Form1

    Private thePicBox As PictureBox
    Private str As String = "WANtaro 0123456789 日本語"

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim ff As FontFamily

        Me.Width = 400
        PictureBox1.Visible = True
        PictureBox2.Visible = False
        PictureBox3.Visible = False

        For Each ff In FontFamily.Families
            If ff.IsStyleAvailable(FontStyle.Regular) Then
                If ff.Name.IndexOf("@") = -1 Then ListBox1.Items.Add(ff.Name)
            End If
        Next ff
        ListBox1.SelectedIndex = 0
    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim bmp As Bitmap
        Dim g As Graphics
        Dim ff As FontFamily
        Dim f As Font
        Dim TextSize As SizeF

        thePicBox = PictureBox1
        bmp = New Bitmap(thePicBox.Width, thePicBox.Height)
        thePicBox.Image = bmp
        g = Graphics.FromImage(thePicBox.Image)
        ff = New FontFamily(ListBox1.SelectedItem.ToString())
        f = New Font(ff, 14)
        g.FillRectangle(Brushes.White, 0, 0, thePicBox.Width, thePicBox.Height)
        g.DrawString(str, f, Brushes.Black, 3, 3)
        TextSize = g.MeasureString(str, f)
        If 35 < TextSize.Height Then
            MessageBox.Show("文字列寸法が大きすぎです" & ControlChars.CrLf _
            & TextSize.Width.ToString("0") + "×" + TextSize.Height.ToString("0"))
        End If
        f.Dispose()
        ff.Dispose()
        g.Dispose()
    End Sub


    Private Sub ToolStripButton1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripButton1.Click
        Dim kpt As Integer = 1
        Dim HSIZE As Integer = 400
        Dim VSIZE As Integer = 200
        Dim bmp As Bitmap
        Dim g As Graphics
        Dim ff As FontFamily
        Dim f As Font
        Dim i As Integer
        Dim dir As String = ""
        Dim fnameW As String
        Dim TextSize As SizeF
        Dim Vsave(ListBox1.Items.Count - 1) As Integer
        Dim Hsave(ListBox1.Items.Count - 1) As Integer
        Dim bmpsave As Bitmap
        Dim rectsave As Rectangle
        Dim gsave As Graphics
        Dim saveBox As PictureBox = pictureBox3
        Dim dd As Integer = 6
        
        If FolderBrowserDialog1.ShowDialog() = DialogResult.OK Then
            dir = FolderBrowserDialog1.SelectedPath
        End If

        thePicBox = PictureBox2
        thePicBox.Size = New Size(kpt * HSIZE, kpt * VSIZE)
        bmp = New Bitmap(kpt * thePicBox.Width, kpt * thePicBox.Height)
        thePicBox.Image = bmp
        g = Graphics.FromImage(thePicBox.Image)
        For i = 0 To ListBox1.Items.Count - 1
            Console.WriteLine(ListBox1.Items(i).ToString())
            ff = New FontFamily(ListBox1.Items(i).ToString())
            f = New Font(ff, 14)
            g.FillRectangle(Brushes.White, New Rectangle(0, 0, kpt * HSIZE, kpt * VSIZE))
            g.DrawString(str, f, Brushes.Black, 3, 3)

            TextSize = g.MeasureString(str, f)
            Vsave(i) = CInt(TextSize.Height) + dd
            Hsave(i) = CInt(TextSize.Width) + dd
            rectsave = New Rectangle(0, 0, Hsave(i), Vsave(i))
            saveBox.Size = New Size(Hsave(i), Vsave(i))
            bmpsave = New Bitmap(rectsave.Width, rectsave.Height)
            saveBox.Image = bmpsave
            gsave = Graphics.FromImage(saveBox.Image)
            gsave.DrawImage(thePicBox.Image, 0, 0, rectsave, GraphicsUnit.Pixel)
            Console.WriteLine(ListBox1.Items(i).ToString() + " " + TextSize.Width.ToString("0") + " " + TextSize.Height.ToString("0"))
            fnameW = dir + "\png_fnt_" + i.ToString() + ".png"
            saveBox.Image.Save(fnameW, System.Drawing.Imaging.ImageFormat.Png)
            gsave.Dispose()
            f.Dispose()
            ff.Dispose()
        Next i
        g.Dispose()

        'htmlファイル出力
        Dim sw As System.IO.StreamWriter
        Dim fntname(ListBox1.Items.Count - 1) As String
        Dim pngname(ListBox1.Items.Count - 1) As String

        fnameW = dir + "\subFONT.html"
        sw = New System.IO.StreamWriter(fnameW, False, System.Text.Encoding.GetEncoding("shift-jis"))
        sw.WriteLine("<html lang=""ja"">")

        sw.WriteLine("<body bgcolor=""#2F4F4F"" text=""#FFFFFF"">")
        sw.WriteLine("<h1>VB &amp C# Font</h1>")
        '*******************************************************************
        sw.WriteLine("<h2>フォント描画サンプル（14ポイントで描画）</h2>")
        For i = 0 To ListBox1.Items.Count - 1
            pngname(i) = "png_fnt_" & i.ToString() & ".png"
            fntname(i) = ListBox1.Items(i).ToString()
        Next i
        sw.WriteLine("<table class=""clrtbl"">")
        sw.WriteLine("<tr>")
        sw.WriteLine("<th>")
        sw.WriteLine("フォント")
        sw.WriteLine("</th>")
        sw.WriteLine("<th>")
        sw.WriteLine("png 画像（文字列寸法＋ 6 pixel）")
        sw.WriteLine("</th>")
        sw.WriteLine("<th>")
        sw.WriteLine("文字列寸法（Pixel）")
        sw.WriteLine("</th>")
        sw.WriteLine("</tr>")
        For i = 0 To ListBox1.Items.Count - 1
            sw.WriteLine("<tr>")
            sw.WriteLine("<td class=""clrtbl"">")
            sw.WriteLine(fntname(i))
            sw.WriteLine("</td>")
            sw.WriteLine("<td class=""clrtbl"">")
            sw.WriteLine("<img src=""" & pngname(i) & """ alt=""" & fntname(i) & """ width=""" & Hsave(i).ToString("0") & """ height=""" & Vsave(i).ToString("0") + """>")
            sw.WriteLine("</td>")
            sw.WriteLine("<td class=""clrtbl"">")
            sw.WriteLine((Hsave(i) - dd).ToString("0") & "×" & (Vsave(i) - dd).ToString("0"))
            sw.WriteLine("</td>")
            sw.WriteLine("</tr>")
        Next i
        sw.WriteLine("</table>")
        '*******************************************************************
        sw.WriteLine("</body>")
        sw.WriteLine("</html>")
        sw.Close()
        '*******************************************************************

        System.Threading.Thread.Sleep(1000) '1秒待つ
        System.Diagnostics.Process.Start(fnameW)

    End Sub

End Class