【6日でできるVisual Basic2022入門】⑦サブルーティンを使う方法

CalcButton_Click（イベント）
 ├─ TryReadDoubleInRange_UI（Function, UIあり）
 ├─ CalcBmi（Function, 純粋計算）
 ├─ Round1（Function, 表示丸め）
 ├─ GetBmiCategory（Function, 判定）
 ├─ GetBmiColor（Function, 判定に応じた色）
 └─ UpdateResultUI（Sub, 結果の書き戻し）

Option Strict On       'クラス内へ配置する時はコメントアウト
Option Infer On        'クラス内へ配置する時はコメントアウト
Imports System.Drawing 'クラス内へ配置する時はコメントアウト

' 純粋ロジック（UI に依存しない）
Private Function CalcBmi(heightCm As Double, weightKg As Double) As Double
    Dim h As Double = heightCm / 100.0
    If h <= 0 Then Return Double.NaN '「数値ではない」ことを表す Double 型の定数
    Return weightKg / (h * h)
End Function

Private Function Round1(value As Double) As Double
    Return Math.Round(value, 1, MidpointRounding.AwayFromZero)
End Function

Private Function GetBmiCategory(bmi As Double) As String
    Select Case bmi
        Case < 18.5 : Return "やせ気味です。体調管理に注意しましょう。"
        Case < 25.0 : Return "標準です。現在の生活リズムを維持しましょう。"
        Case < 30.0 : Return "やや高めです。食事と運動のバランスを意識しましょう。"
        Case Else    : Return "高めです。専門家への相談を検討してください。"
    End Select
End Function

Private Function GetBmiColor(bmi As Double) As Color
    Select Case bmi
        Case < 18.5 : Return Color.SteelBlue
        Case < 25.0 : Return Color.ForestGreen
        Case < 30.0 : Return Color.DarkOrange
        Case Else    : Return Color.Crimson
    End Select
End Function

' 空/数値/範囲をまとめて検証し、成功時 result に数値を返す
Private Function TryReadDoubleInRange_UI(tb As TextBox, fieldName As String,
                                         minValue As Double, maxValue As Double,
                                         ByRef result As Double) As Boolean
    Dim raw = tb.Text.Trim()

    If String.IsNullOrWhiteSpace(raw) Then
        MessageBox.Show($"{fieldName} を入力してください。", "入力エラー")
        tb.Focus() : tb.SelectAll()
        Return False
    End If
    If Not Double.TryParse(raw, result) Then
        MessageBox.Show($"{fieldName} は半角の数字で入力してください。", "入力エラー")
        tb.Focus() : tb.SelectAll()
        Return False
    End If
    If result < minValue OrElse result > maxValue Then
        MessageBox.Show($"{fieldName} は {minValue} ～ {maxValue} の範囲で入力してください。", "範囲エラー")
        tb.Focus() : tb.SelectAll()
        Return False
    End If
    Return True
End Function

' 計算結果を UI に反映
Private Sub UpdateResultUI(bmiRounded As Double, message As String, color As Color)
    BmiTextBox.Text = bmiRounded.ToString("0.0")
    ResultLabel.Text = message
    ResultLabel.ForeColor = color
End Sub

' エラー共通表示（必要に応じて）
Private Sub ShowError(msg As String, Optional focusControl As Control = Nothing)
    MessageBox.Show(msg, "エラー")
    If focusControl IsNot Nothing Then
        focusControl.Focus()
    End If
End Sub

Option Strict On
Option Infer On
Imports System.Drawing

Public Class MainForm

    Private Sub CalcButton_Click(sender As Object, e As EventArgs) Handles CalcButton.Click
        ' 1) 入力（UI 付き検証）
        Dim heightCm As Double, weightKg As Double
        If Not TryReadDoubleInRange_UI(HeightTextBox, "身長(cm)", 80, 250, heightCm) Then Return
        If Not TryReadDoubleInRange_UI(WeightTextBox, "体重(kg)", 20, 300, weightKg) Then Return

        ' 2) 計算（純粋関数）
        Dim bmi = CalcBmi(heightCm, weightKg)
        If Double.IsNaN(bmi) OrElse Double.IsInfinity(bmi) Then
            ShowError("計算できませんでした。入力値を確認してください。", HeightTextBox)
            Return
        End If
        Dim bmiRounded = Round1(bmi)

        ' 3) 判定（純粋関数）
        Dim msg = GetBmiCategory(bmiRounded)
        Dim col = GetBmiColor(bmiRounded)

        ' 4) 表示（副作用はここに集約）
        UpdateResultUI(bmiRounded, msg, col)
    End Sub

    ' ここに 7.3～7.5 の関数・サブルーチンを同じクラス内へ配置して動作します
End Class

Option Strict On
Option Infer On
Imports System.Drawing

Public Module BmiCore
    Public Function CalcBmi(heightCm As Double, weightKg As Double) As Double
        Dim h = heightCm / 100.0
        If h <= 0 Then Return Double.NaN
        Return weightKg / (h * h)
    End Function
    Public Function Round1(v As Double) As Double
        Return Math.Round(v, 1, MidpointRounding.AwayFromZero)
    End Function
    Public Function GetBmiCategory(bmi As Double) As String
        Select Case bmi
            Case < 18.5 : Return "やせ気味です。体調管理に注意しましょう。"
            Case < 25.0 : Return "標準です。現在の生活リズムを維持しましょう。"
            Case < 30.0 : Return "やや高めです。食事と運動のバランスを意識しましょう。"
            Case Else    : Return "高めです。専門家への相談を検討してください。"
        End Select
    End Function
    Public Function GetBmiColor(bmi As Double) As Color
        Select Case bmi
            Case < 18.5 : Return Color.SteelBlue
            Case < 25.0 : Return Color.ForestGreen
            Case < 30.0 : Return Color.DarkOrange
            Case Else    : Return Color.Crimson
        End Select
    End Function
End Module

''' <summary>BMI を計算します（身長 cm, 体重 kg）</summary>
''' <returns>BMI の倍精度値。身長が無効なら NaN。</returns>
Private Function CalcBmi(heightCm As Double, weightKg As Double) As Double
    ' ...
End Function