Option Explicit

'フォームのロードをします
Private Sub Form_Load()
    Dim j As Integer
    
    'コンボボックス(月)の初期設定です
    With Combo1
        For j = 1 To 12
            .AddItem j
        Next
    End With
    
    '今、現在の日付(年、月)のカレンダーを描画します
    'Combo1.ListIndexでCombo1_Clickにジャンプします
    Text1.Text = Year(Date)
    Combo1.ListIndex = Month(Date) - 1
    
End Sub

'コンボボックスの項目もクリックしました
Private Sub Combo1_Click()
    Dim jy As Integer, jm As Integer
    
    On Error GoTo ErrProcess
    
    '年が数字で入力されているかを調べ、
    '整数に直し変数へ代入します
    jy = CInt(Text1.Text)
    
    'コンボボックスで選択した月を変数に代入します
    jm = Combo1.ListIndex + 1
    
    'ピクチャボックスにカレンダーを描画します
    MyCalendar Picture1, jy, jm
    
    '表示しているカレンダーの西暦と月を表示します
    Label4(0).Caption = "西暦" & jy & "年" & jm & "月"
    Label4(1).Caption = Label4(0).Caption
    
    Exit Sub
    
ErrProcess:
    MsgBox "西暦を正しく入力してください", vbCritical
End Sub

'カレンダーを描画します
Sub MyCalendar(ByRef obj As Object, ByVal nYear As Integer, ByVal nMonth As Integer)
    Dim EndMonth(1 To 12) As Integer
    Dim nBias As Integer, nSum As Integer
    Dim nWeek As Integer, nDay As Integer
    Dim n1 As Integer, n2 As Integer, n3 As Integer
    Dim strDay As String, n As Integer, j As Integer

    '月末日のひにち(その月の日数ともいえる)
    EndMonth(1) = 31
    EndMonth(2) = 28
    EndMonth(3) = 31
    EndMonth(4) = 30
    EndMonth(5) = 31
    EndMonth(6) = 30
    EndMonth(7) = 31
    EndMonth(8) = 31
    EndMonth(9) = 30
    EndMonth(10) = 31
    EndMonth(11) = 30
    EndMonth(12) = 31
    
    With obj
        '描画内容を消去します
        .Cls
        
        '色付きの曜日を描画します(土曜日に改行)
        .ForeColor = vbRed
        obj.Print " 日 ";
        .ForeColor = vbBlack
        obj.Print "月 火 水 木 金";
        .ForeColor = vbBlue
        obj.Print " 土"
        .ForeColor = vbBlack
    End With
    
    'うるう年の条件を満たした場合
    '２月の末日を29に変更します
    n1 = nYear Mod 4
    n2 = nYear Mod 100
    n3 = nYear Mod 400
    If (n1 = 0 And Not (n2 = 0)) Or n3 = 0 Then
        EndMonth(2) = 29
    End If
    
    '月初が何曜日から始まるかを求めます
    For j = 1 To nMonth - 1
        nSum = nSum + EndMonth(j)
    Next
    nWeek = (Fix(nYear + ((nYear - 1) / 4) - ((nYear - 1) / 100) + ((nYear - 1) / 400)) + nSum) Mod 7
    
    '月初の日のために曜日(位置)を進めます(改行なし)
    For j = 0 To nWeek - 1
        obj.Print Space(3);
    Next
    
    '日を描画します
    For nDay = 1 To EndMonth(nMonth)
        
        'nDayからの曜日を代入します
        n = (nWeek + nDay) Mod 7
        
        '日を文字列に直し代入します
        strDay = Trim(Str(nDay))
        
        '曜日別に処理します
        If n = 1 Then
            '日曜日なので赤色で日を描画します
            obj.ForeColor = vbRed
            obj.Print IIf(Len(strDay) = 1, "  ", " ") & strDay;
            obj.ForeColor = vbBlack
        ElseIf n = 0 Then
            '土曜日なので青で日を描画します
            obj.ForeColor = vbBlue
            obj.Print IIf(Len(strDay) = 1, "  ", " ") & strDay;
            obj.ForeColor = vbBlack
        Else
            '平日なので通常描画します
            obj.Print IIf(Len(strDay) = 1, "  ", " ") & strDay;
        End If
        
        '土曜日で改行します
        If n = 0 Then
            obj.Print ""
        End If
    Next
    

End Sub