Option Explicit On Option Strict On Public Class Form1 Private Sub ToolStripButton1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripButton1.Click Call main() End Sub Private Sub ToolStripButton2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripButton2.Click Dim fnameW As String = "" SaveFileDialog1.Filter = "*.bmp|*.bmp|" _ & "*.jpg|*.jpg|" _ & "*.png|*.png|" _ & "*.wmf|*.wmf|" _ & "*.tif|*.tif|" _ & "*.gif|*.gif" If SaveFileDialog1.ShowDialog() = Windows.Forms.DialogResult.OK Then fnameW = SaveFileDialog1.FileName Select Case SaveFileDialog1.FilterIndex Case 1 : PictureBox2.Image.Save(fnameW, System.Drawing.Imaging.ImageFormat.Bmp) Case 2 : PictureBox2.Image.Save(fnameW, System.Drawing.Imaging.ImageFormat.Jpeg) Case 3 : PictureBox2.Image.Save(fnameW, System.Drawing.Imaging.ImageFormat.Png) Case 4 : PictureBox2.Image.Save(fnameW, System.Drawing.Imaging.ImageFormat.Wmf) Case 5 : PictureBox2.Image.Save(fnameW, System.Drawing.Imaging.ImageFormat.Tiff) Case 6 : PictureBox2.Image.Save(fnameW, System.Drawing.Imaging.ImageFormat.Gif) End Select End Sub Private Sub main() '作図用変数宣言 Dim kpt As Integer '拡大率（画面表示：1，ファイル保存：2） Dim HSIZE As Integer '画像横寸法（px） Dim DHL As Integer '画像左余白寸法：縦軸描画用（px） Dim DHR As Integer '画像右余白寸法（px） Dim VSIZE As Integer '画像縦寸法（px） Dim DVL As Integer '画像下余白寸法：横軸描画用（px） Dim DVU As Integer '画像上余白寸法（px） Dim sxjiku As String 'ｘ軸名（単位含む） Dim xmin As Double 'ｘ軸最小値 Dim xmax As Double 'ｘ軸最大値 Dim dx As Double 'ｘ軸増分 Dim slogx As String 'ｘ軸の種類（L：対数，N：普通） Dim syjiku As String 'ｙ軸名（単位含む） Dim ymin As Double 'ｙ軸最小値 Dim ymax As Double 'ｙ軸最大値 Dim dy As Double 'ｙ軸増分 Dim slogy As String 'ｙ軸の種類（L：対数，N：普通） Dim kxi0 As Integer Dim kxf0 As Integer Dim kyi0 As Integer Dim kyf0 As Integer Dim thePicBox As PictureBox = PictureBox1 Dim bmp As Bitmap Dim g As Graphics 'プロットデータ変数宣言 Dim datax() As Double 'データｘ値 Dim datay() As Double 'データｙ値 Dim psname() As String '発電所名 Dim steel() As String '強度クラス＋発電区分 Dim ksteel() As Integer 'プロット区分 Dim ktdrl() As Integer '発電所名表示位置 Dim nd As Integer 'データ数（入力はデータ数，プログラム上数値はデータ数−１） '入力用変数宣言 Dim sr As System.IO.StreamReader Dim dat As String Dim sbuf() As String Dim delim() As Char = {","c} Dim fnameR As String = "" Dim i As Integer Dim pi As Double = Math.PI 'データ読み込み OpenFileDialog1.InitialDirectory = System.IO.Directory.GetCurrentDirectory() If OpenFileDialog1.ShowDialog() = Windows.Forms.DialogResult.OK Then fnameR = OpenFileDialog1.FileName sr = New System.IO.StreamReader(fnameR, System.Text.Encoding.Default) dat = sr.ReadLine() dat = sr.ReadLine() : sbuf = dat.Split(delim) : sxjiku = sbuf(0) : syjiku = sbuf(1) dat = sr.ReadLine() : sbuf = dat.Split(delim) : HSIZE = CInt(sbuf(0)) : DHL = CInt(sbuf(1)) : DHR = CInt(sbuf(2)) dat = sr.ReadLine() : sbuf = dat.Split(delim) : VSIZE = CInt(sbuf(0)) : DVL = CInt(sbuf(1)) : DVU = CInt(sbuf(2)) dat = sr.ReadLine() : sbuf = dat.Split(delim) : xmin = CDbl(sbuf(0)) : xmax = CDbl(sbuf(1)) : dx = CDbl(sbuf(2)) : slogx = sbuf(3) dat = sr.ReadLine() : sbuf = dat.Split(delim) : ymin = CDbl(sbuf(0)) : ymax = CDbl(sbuf(1)) : dy = CDbl(sbuf(2)) : slogy = sbuf(3) dat = sr.ReadLine() : sbuf = dat.Split(delim) : nd = CInt(sbuf(0)) - 1 ReDim datax(nd) ReDim datay(nd) ReDim psname(nd) ReDim steel(nd) ReDim ksteel(nd) ReDim ktdrl(nd) dat = sr.ReadLine() '１行読み飛ばし i = 0 Do Until sr.EndOfStream dat = sr.ReadLine() sbuf = dat.Split(delim) psname(i) = sbuf(0).Trim() '発電所名 datax(i) = CDbl(sbuf(1)) '完成年 datay(i) = CDbl(sbuf(2)) 'H*D steel(i) = sbuf(4).Trim() & "(" & sbuf(5).Trim() & ")" '強度クラス＋発電区分 ktdrl(i) = CInt(sbuf(6)) '発電所名表記箇所 i = i + 1 Loop sr.Close() nd = i - 1 For i = 0 To nd Select Case steel(i) Case "400MPa(一般水力)" : ksteel(i) = 0 Case "490MPa(一般水力)" : ksteel(i) = 1 Case "490MPa(揚水)" : ksteel(i) = 2 Case "570MPa(一般水力)" : ksteel(i) = 3 Case "570MPa(揚水)" : ksteel(i) = 4 Case "690MPa(一般水力)" : ksteel(i) = 5 Case "690MPa(揚水)" : ksteel(i) = 6 Case "780MPa(揚水)" : ksteel(i) = 7 Case "950MPa(一般水力)" : ksteel(i) = 8 Case "950MPa(揚水)" : ksteel(i) = 9 End Select Next i 'プロット領域定義 kxi0 = DHL kxf0 = HSIZE - DHR kyi0 = DVU kyf0 = VSIZE - DVL Console.WriteLine(kxi0.ToString & " " & kxf0.ToString & " " & kyi0.ToString & " " & kyf0.ToString) '対数値処理 If slogx = "L" Then For i = 0 To nd If datax(i) < System.Math.Pow(10.0, xmin) Then datax(i) = System.Math.Pow(10.0, xmin) datax(i) = System.Math.Log10(datax(i)) Next i End If If slogy = "L" Then For i = 0 To nd If datay(i) < System.Math.Pow(10.0, ymin) Then datay(i) = System.Math.Pow(10.0, ymin) datay(i) = System.Math.Log10(datay(i)) Next i End If For i = 0 To 1 Select Case i Case 0 '画面描画 kpt = 1 thePicBox = PictureBox1 thePicBox.Visible = True Case 1 '画像書き出し kpt = 4 thePicBox = PictureBox2 thePicBox.Visible = False End Select thePicBox.Size = New Size(kpt * HSIZE, kpt * VSIZE) bmp = New Bitmap(thePicBox.Width, thePicBox.Height) thePicBox.Image = bmp g = Graphics.FromImage(thePicBox.Image) g.FillRectangle(Brushes.White, 0, 0, thePicBox.Width, thePicBox.Height) Call PLOT(g, kpt, sxjiku, syjiku, xmin, xmax, dx, ymin, ymax, dy, kxi0, kxf0, kyi0, kyf0, nd, datax, datay, psname, ksteel, ktdrl, slogx, slogy) g.Dispose() Next i PictureBox1.Left = 0 PictureBox1.Top = ToolStrip1.Height Me.ClientSize = New Size(PictureBox1.Width, PictureBox1.Height + ToolStrip1.Height) End Sub Private Sub PLOT(ByVal g As Graphics, ByVal kpt As Integer, ByVal sxjiku As String, ByVal syjiku As String, _ ByVal xmin As Double, ByVal xmax As Double, ByVal dx As Double, _ ByVal ymin As Double, ByVal ymax As Double, ByVal dy As Double, _ ByVal kxi0 As Integer, ByVal kxf0 As Integer, ByVal kyi0 As Integer, ByVal kyf0 As Integer, _ ByVal nd As Integer, ByRef datax() As Double, ByRef datay() As Double, _ ByRef psname() As String, ByRef ksteel() As Integer, ByRef ktdrl() As Integer, _ ByVal slogx As String, ByVal slogy As String) Dim i As Integer Dim kxi As Integer : Dim kxf As Integer Dim kyi As Integer : Dim kyf As Integer Dim xx As Double : Dim yy As Double Dim kxx As Integer : Dim kyy As Integer Dim kxx1 As Integer : Dim kyy1 As Integer Dim kxx2 As Integer : Dim kyy2 As Integer Dim str As String Dim dc As Integer Dim f As New Font("ＭＳ ゴシック", kpt * 11) Dim TextSize1 As New System.Drawing.SizeF Dim TextSize2 As New System.Drawing.SizeF kxi = kpt * kxi0 : kxf = kpt * kxf0 : kyi = kpt * kyi0 : kyf = kpt * kyf0 '座標軸 Dim LPen As New System.Drawing.Pen(System.Drawing.Color.Black) LPen.DashStyle = Drawing2D.DashStyle.Dot If slogx = "N" Then Call DRN_XJIKU(g, f, LPen, kpt, xmin, xmax, dx, kxi, kxf, kyi, kyf) If slogy = "N" Then Call DRN_YJIKU(g, f, LPen, kpt, ymin, ymax, dy, kxi, kxf, kyi, kyf) If slogx = "L" Then Call DRL_XJIKU(g, f, LPen, kpt, xmin, xmax, kxi, kxf, kyi, kyf) If slogy = "L" Then Call DRL_YJIKU(g, f, LPen, kpt, ymin, ymax, kxi, kxf, kyi, kyf) '枠線描画 g.DrawRectangle(New Pen(Color.Black, 2), kxi, kyi, kxf - kxi, kyf - kyi) 'ｙ軸名描画 str = syjiku TextSize2 = g.MeasureString(str, f) TextSize1 = g.MeasureString("-1.0", f) kxx = CInt(kxi - kpt * 10 - TextSize1.Width - TextSize2.Height) kyy = CInt((kyi + kyf) / 2 + TextSize2.Width / 2) Call INC_STR(g, f, str, kxx, kyy, -90) 'ｘ軸名描画 str = sxjiku TextSize2 = g.MeasureString(str, f) kxx = CInt((kxi + kxf) / 2 - TextSize2.Width / 2) kyy = CInt(kyf + kpt * 10 + TextSize1.Height) Call INC_STR(g, f, str, kxx, kyy, 0) 'データプロット dc = 5 For i = 0 To nd If ktdrl(i) <> 0 Then 'ktdrl=0:非表示 xx = datax(i) yy = datay(i) kxx = kxi + CInt((xx - xmin) * (kxf - kxi) / (xmax - xmin)) kyy = kyf - CInt((yy - ymin) * (kyf - kyi) / (ymax - ymin)) str = SYMB(ksteel(i)) '記号確定 f = New Font("ＭＳ ゴシック", kpt * 9) TextSize2 = g.MeasureString(str, f) g.DrawString(str, f, Brushes.Black, kxx - CInt(TextSize2.Width / 2), kyy - CInt(TextSize2.Height / 2)) '発電所名表示 str = psname(i) f = New Font("ＭＳ ゴシック", kpt * 8) TextSize2 = g.MeasureString(str, f) Select Case ktdrl(i) Case 1 'Left g.DrawString(str, f, Brushes.Black, kxx - CInt(TextSize2.Width) - dc * kpt, kyy - CInt(TextSize2.Height / 2)) Case 2 'Right g.DrawString(str, f, Brushes.Black, kxx + dc * kpt, kyy - CInt(TextSize2.Height / 2)) Case 3 'Top g.DrawString(str, f, Brushes.Black, kxx - CInt(TextSize2.Width / 2), kyy - CInt(TextSize2.Height) - dc * kpt) Case 4 'Bottom g.DrawString(str, f, Brushes.Black, kxx - CInt(TextSize2.Width / 2), kyy + dc * kpt) End Select End If Next i '凡例表示 str = "凡例:鋼板引張強さ区分" f = New Font("ＭＳ ゴシック", kpt * 9) TextSize2 = g.MeasureString(str, f) kxx1 = kxi + 10 * kpt kyy1 = kyi + 10 * kpt kxx2 = 2 * dc + CInt(TextSize2.Width) kyy2 = 2 * dc + CInt(TextSize2.Height) * 11 g.FillRectangle(Brushes.White, kxx1, kyy1, kxx2, kyy2) g.DrawRectangle(New Pen(Color.Black, 1), kxx1, kyy1, kxx2, kyy2) For i = 0 To 10 Select Case i Case 0 : str = "凡例:鋼板引張強さ区分" Case 1 To 10 : str = SYMB(i - 1) & " :" & SREM(i - 1) End Select kxx = kxx1 + dc kyy = kyy1 + dc + i * CInt(TextSize2.Height) g.DrawString(str, f, Brushes.Black, kxx, kyy) Next i f.Dispose() End Sub Private Function SYMB(ByVal k As Integer) As String SYMB = "" Select Case k Case 0 : SYMB = "◇" Case 1 : SYMB = "○" Case 2 : SYMB = "●" Case 3 : SYMB = "□" Case 4 : SYMB = "■" Case 5 : SYMB = "△" Case 6 : SYMB = "▲" Case 7 : SYMB = "◎" Case 8 : SYMB = "☆" Case 9 : SYMB = "★" End Select End Function Private Function SREM(ByVal k As Integer) As String SREM = "" Select Case k Case 0 : SREM = "400MPa(一般水力)" Case 1 : SREM = "490MPa(一般水力)" Case 2 : SREM = "490MPa(揚水)" Case 3 : SREM = "570MPa(一般水力)" Case 4 : SREM = "570MPa(揚水)" Case 5 : SREM = "690MPa(一般水力)" Case 6 : SREM = "690MPa(揚水)" Case 7 : SREM = "780MPa(揚水)" Case 8 : SREM = "950MPa(一般水力)" Case 9 : SREM = "950MPa(揚水)" End Select End Function Private Sub INC_STR(ByVal g As Graphics, ByVal f As System.Drawing.Font, ByVal str As String, _ ByVal kxx As Integer, ByVal kyy As Integer, ByVal ang As Single) '軸名描画 g.ScaleTransform(1.0, 1.0) '横・縦の表示比率を設定 g.TranslateTransform(kxx, kyy) '表示位置の設定（表示位置を原点とする座標移動） g.RotateTransform(ang) '表示角度を指定 g.DrawString(str, f, Brushes.Black, 0, 0) '描画実行 g.ResetTransform() '単位行列にリセット End Sub Private Sub DRN_XJIKU(ByVal g As Graphics, ByVal f As System.Drawing.Font, ByVal LPen As System.Drawing.Pen, _ ByVal kpt As Integer, _ ByVal xmin As Double, ByVal xmax As Double, ByVal dx As Double, _ ByVal kxi As Integer, ByVal kxf As Integer, _ ByVal kyi As Integer, ByVal kyf As Integer) Dim i As Integer Dim ix As Integer Dim xx As Double Dim wv As Double Dim str As String Dim kxx As Integer Dim TextSize1 As New System.Drawing.SizeF '普通ｘ軸描画 ix = CInt((xmax - xmin) / dx) For i = 0 To ix xx = xmin + CDbl(i) * dx kxx = kxi + CInt((xx - xmin) * (kxf - kxi) / (xmax - xmin)) wv = xmin + CDbl(i) * dx str = wv.ToString("0") If CInt(dx * 1000.0) Mod 10 <> 0 Then str = wv.ToString("0.000") If CInt(dx * 1000.0) Mod 10 = 0 And CInt(dx * 100.0) Mod 10 <> 0 Then str = wv.ToString("0.00") If (CInt(dx * 1000.0) Mod 10 = 0 And CInt(dx * 100.0) Mod 10 = 0) And CInt(dx * 10.0) Mod 10 <> 0 Then str = wv.ToString("0.0") TextSize1 = g.MeasureString(str, f) g.DrawLine(LPen, kxx, kyi, kxx, kyf) g.DrawString(str, f, Brushes.Black, kxx - TextSize1.Width / 2, kyf + kpt * 3) Next i End Sub Private Sub DRN_YJIKU(ByVal g As Graphics, ByVal f As System.Drawing.Font, ByVal LPen As System.Drawing.Pen, _ ByVal kpt As Integer, _ ByVal ymin As Double, ByVal ymax As Double, ByVal dy As Double, _ ByVal kxi As Integer, ByVal kxf As Integer, _ ByVal kyi As Integer, ByVal kyf As Integer) Dim i As Integer Dim iy As Integer Dim yy As Double Dim wv As Double Dim str As String Dim kyy As Integer Dim TextSize1 As New System.Drawing.SizeF '普通ｙ軸描画 iy = CInt((ymax - ymin) / dy) For i = 0 To iy yy = ymin + CDbl(i) * dy kyy = kyf - CInt((yy - ymin) * (kyf - kyi) / (ymax - ymin)) wv = ymin + CDbl(i) * dy str = wv.ToString("0") If CInt(dy * 1000.0) Mod 10 <> 0 Then str = wv.ToString("0.000") If CInt(dy * 1000.0) Mod 10 = 0 And CInt(dy * 100.0) Mod 10 <> 0 Then str = wv.ToString("0.00") If (CInt(dy * 1000.0) Mod 10 = 0 And CInt(dy * 100.0) Mod 10 = 0) And CInt(dy * 10.0) Mod 10 <> 0 Then str = wv.ToString("0.0") TextSize1 = g.MeasureString(str, f) g.DrawLine(LPen, kxi, kyy, kxf, kyy) g.DrawString(str, f, Brushes.Black, kxi - TextSize1.Width - kpt * 2, kyy - TextSize1.Height / 2) Next i End Sub Private Sub DRL_XJIKU(ByVal g As Graphics, ByVal f As System.Drawing.Font, ByVal LPen As System.Drawing.Pen, _ ByVal kpt As Integer, _ ByVal xmin As Double, ByVal xmax As Double, _ ByVal kxi As Integer, ByVal kxf As Integer, _ ByVal kyi As Integer, ByVal kyf As Integer) Dim i As Integer Dim j As Integer Dim xx As Double Dim str As String Dim kxx As Integer Dim TextSize1 As New System.Drawing.SizeF '対数ｘ軸描画 For i = CInt(xmin) To CInt(xmax) - 1 For j = 1 To 9 xx = System.Math.Log(CDbl(j) * System.Math.Pow(10.0, CDbl(i))) / System.Math.Log(10.0) kxx = kxi + CInt((xx - xmin) * (kxf - kxi) / (xmax - xmin)) g.DrawLine(LPen, kxx, kyi, kxx, kyf) Next j Next i For i = CInt(xmin) To CInt(xmax) xx = CDbl(i) kxx = kxi + CInt((xx - xmin) * (kxf - kxi) / (xmax - xmin)) str = CStr(System.Math.Pow(10.0, CDbl(i))) TextSize1 = g.MeasureString(str, f) g.DrawString(str, f, Brushes.Black, kxx - TextSize1.Width / 2, kyf + kpt * 3) Next i End Sub Private Sub DRL_YJIKU(ByVal g As Graphics, ByVal f As System.Drawing.Font, ByVal LPen As System.Drawing.Pen, _ ByVal kpt As Integer, _ ByVal ymin As Double, ByVal ymax As Double, _ ByVal kxi As Integer, ByVal kxf As Integer, _ ByVal kyi As Integer, ByVal kyf As Integer) Dim i As Integer Dim j As Integer Dim yy As Double Dim str As String Dim kyy As Integer Dim TextSize1 As New System.Drawing.SizeF '対数ｙ軸描画 For i = CInt(ymin) To CInt(ymax) - 1 For j = 1 To 9 yy = System.Math.Log(CDbl(j) * System.Math.Pow(10.0, CDbl(i))) / System.Math.Log(10.0) kyy = kyf - CInt((yy - ymin) * (kyf - kyi) / (ymax - ymin)) g.DrawLine(LPen, kxi, kyy, kxf, kyy) Next j Next i For i = CInt(ymin) To CInt(ymax) yy = CDbl(i) kyy = kyf - CInt((yy - ymin) * (kyf - kyi) / (ymax - ymin)) str = CStr(System.Math.Pow(10.0, CDbl(i))) TextSize1 = g.MeasureString(str, f) g.DrawString(str, f, Brushes.Black, kxi - TextSize1.Width - kpt * 2, kyy - TextSize1.Height / 2) Next i End Sub End Class