'=================================================================
'
' A Tool to Make the JourNal Calender (VB2017)
'
' Copy Right Miyama. 2025 April

' http://kazutomimiyama.sakura.ne.jp
' KazutomiMiyamaSub@gmail.com

'=================================================================

Option Explicit On

Public Class Form1
    Private Sub Gobtn_Click(sender As Object, e As EventArgs) Handles Gobtn.Click

        Dim tmpSTR As String

        Dim LeapYearFlag As Boolean = False

        Dim NumMonthNow As Integer
        Dim NumDayOnMonthNow As Integer

        Dim NumWeekDayKindNow As Integer

        Dim LargeManthDays As Integer = 31
        Dim SmallMonthDays As Integer = 30

        Dim NormalFebruaryDays As Integer = 28
        Dim SpecialFridayDays As Integer = 29 ':LeapYear

        Dim EachMonthDays(12 + 1) As Integer

        Dim L, i, j, k As Integer 'Counter
        Dim WeekDayKindSTR(6 + 1) As String

        Dim TotalDays As Integer

        Dim DaysHeaderCounter As Integer
        Dim StakeDays As Integer

        Dim Dec31WeekDayKindNum As Integer
        'before years Dec31 is 0 point days on the Logic.

        Dim WeekDayKindEachLocal As Integer
        'TotalDaysUntilNow,DayHeaderNum,StakeDaysNum,Dec31WeekDayKindBeforeYear

        Dim J1stWeekDaySameKindDayfromToday As Integer
        Dim MonthCounter As Integer
        Dim DaysInEachMonth As Integer = 0
        '-----
        Dim DisplayTotalDaysPermissionFlag As Boolean
        Dim TryCounter As Integer
        '-----
        Dim FSO As Object = CreateObject("Scripting.FileSystemObject")
        Dim WTS As Object 'WriteTextStream

        REM --WeekDay Name---
        For L = 0 To 6
            Select Case L
                Case 0 : WeekDayKindSTR(L) = "SUN"
                Case 1 : WeekDayKindSTR(L) = "MON"
                Case 2 : WeekDayKindSTR(L) = "THU"
                Case 3 : WeekDayKindSTR(L) = "WED"
                Case 4 : WeekDayKindSTR(L) = "THR"
                Case 5 : WeekDayKindSTR(L) = "FRI"
                Case 6 : WeekDayKindSTR(L) = "SAT"
            End Select
        Next L

        REM --EachMonthDaysDecide --
        tmpSTR = ""
        TryCounter = 0
        Do While (TryCounter = 0) 'in bracket,only num type---
            tmpSTR = CStr(InputBox("Leap year distinguish" + vbCrLf + "normal or Leap" + vbCrLf + "N or L chr"))
            If tmpSTR = "n" Then tmpSTR = "N"
            If tmpSTR = "l" Then tmpSTR = "L"

            If tmpSTR = "N" Then TryCounter = 1
            If tmpSTR = "L" Then TryCounter = 1
        Loop
        Select Case tmpSTR
            Case "N" : LeapYearFlag = False
            Case "L" : LeapYearFlag = True
        End Select

        For i = 0 To 12
            Select Case i
                Case 0 : EachMonthDays(i) = 0 'SpecialCase for Logic
                Case 1 : EachMonthDays(i) = LargeManthDays
                Case 2
                    If LeapYearFlag = False Then
                        EachMonthDays(i) = NormalFebruaryDays
                    Else
                        EachMonthDays(i) = SpecialFridayDays
                    End If
                Case 3 : EachMonthDays(i) = LargeManthDays
                Case 4 : EachMonthDays(i) = SmallMonthDays
                Case 5 : EachMonthDays(i) = LargeManthDays
                Case 6 : EachMonthDays(i) = SmallMonthDays
                Case 7 : EachMonthDays(i) = LargeManthDays
                Case 8 : EachMonthDays(i) = LargeManthDays
                Case 9 : EachMonthDays(i) = SmallMonthDays
                Case 10 : EachMonthDays(i) = LargeManthDays
                Case 11 : EachMonthDays(i) = SmallMonthDays
                Case 12 : EachMonthDays(i) = LargeManthDays
            End Select
        Next

        'REM --Make TotalDays UntilToday--
        NumMonthNow = -1
        Do While (NumMonthNow < 1 Or 12 < NumMonthNow)
            tmpSTR = InputBox("Month num, as 1 to 12")

            If ASCCHK_AllNum(tmpSTR) = False Then
                NumMonthNow = -1
            Else
                NumMonthNow = CInt(tmpSTR)
            End If
        Loop

        NumDayOnMonthNow = -1
        Do While (NumDayOnMonthNow < 1 Or 31 < NumDayOnMonthNow)
            tmpSTR = InputBox("1 to 31 but February is small.")
            If ASCCHK_AllNum(tmpSTR) = False Then
                NumDayOnMonthNow = -1
            Else
                NumDayOnMonthNow = CInt(tmpSTR)
                If NumMonthNow = 2 Then
                    Select Case LeapYearFlag
                        Case False
                            If Not NumDayOnMonthNow <= 28 Then
                                NumDayOnMonthNow = -1
                                MessageBox.Show("ThisYear's February doesnot permit over28th day")
                            End If
                        Case True
                            If Not NumDayOnMonthNow <= 29 Then
                                NumDayOnMonthNow = -1
                                MessageBox.Show("ThisYear's February does not permit over29th day")
                            End If
                    End Select
                End If
                If NumDayOnMonthNow = 31 Then
                    Select Case NumMonthNow
                        Case 4 : NumDayOnMonthNow = AvoidSmallMonth31()
                        Case 6 : NumDayOnMonthNow = AvoidSmallMonth31()
                        Case 9 : NumDayOnMonthNow = AvoidSmallMonth31()
                        Case 11 : NumDayOnMonthNow = AvoidSmallMonth31()
                    End Select
                End If
            End If
        Loop

        StakeDays = 0
        For j = 0 To NumMonthNow - 1
            StakeDays = StakeDays + EachMonthDays(j)
        Next j
        TotalDays = StakeDays + NumDayOnMonthNow

        REM --January 1st WeekCHK-----
        NumWeekDayKindNow = -1
        Do While (NumWeekDayKindNow < 0 Or 6 < NumWeekDayKindNow)
            tmpSTR = InputBox("Today's WeekDay num:1 to 7" + vbCrLf + vbCrLf + "1    2     3    4    5    6    7" + vbCrLf + "Sun Mon Thu Wed Thr Fri Sat")
            If ASCCHK_AllNum(tmpSTR) = False Then
                NumWeekDayKindNow = -1
            Else
                NumWeekDayKindNow = CInt(tmpSTR) - 1
                'CInt("any") >> 0 avoid..
            End If
        Loop

        k = 0
        Do While (0 <= TotalDays - 7 * k)
            k = k + 1
        Loop
        J1stWeekDaySameKindDayfromToday = TotalDays - (k + 0) * 7
        Dec31WeekDayKindNum = NumWeekDayKindNow - J1stWeekDaySameKindDayfromToday

        If 7 <= Dec31WeekDayKindNum Then Dec31WeekDayKindNum = Dec31WeekDayKindNum - 7

        REM --Output to Journal--
        tmpSTR = ""
        TryCounter = 0
        Do While (TryCounter = 0) 'in bracket,only num type---
            tmpSTR = CStr(InputBox("Display Total Days header?" + vbCrLf + "Y or N"))
            If tmpSTR = "y" Then tmpSTR = "Y"
            If tmpSTR = "n" Then tmpSTR = "N"

            Select Case tmpSTR
                Case "Y"
                    TryCounter = 1
                    DisplayTotalDaysPermissionFlag = True
                Case "N"
                    TryCounter = 1
                    DisplayTotalDaysPermissionFlag = False
            End Select
        Loop

        DaysHeaderCounter = 0 'is Dec31
        WeekDayKindEachLocal = Dec31WeekDayKindNum
        MonthCounter = 0 + 1 'Start as January

        OutPutTXT.Text = ""
        Do While (DaysHeaderCounter < 365 + 1)

            DaysHeaderCounter = DaysHeaderCounter + 1
            WeekDayKindEachLocal = WeekDayKindEachLocal + 1

            If WeekDayKindEachLocal = 7 Then 'week return circle
                WeekDayKindEachLocal = 0
            End If

            DaysInEachMonth = DaysInEachMonth + 1
            If EachMonthDays(MonthCounter) < DaysInEachMonth Then
                MonthCounter = MonthCounter + 1
                DaysInEachMonth = 1
            End If

            If MonthCounter <= 12 Then

                If DisplayTotalDaysPermissionFlag = False Then
                    tmpSTR = ""
                Else
                    tmpSTR = CStrSameWidth(DaysHeaderCounter, 3) + "/"
                End If

                OutPutTXT.Text = OutPutTXT.Text + tmpSTR +
                    CStrSameWidth(MonthCounter, 2) + "/" +
                    CStrSameWidth(DaysInEachMonth, 2) + "/" +
                    WeekDayKindSTR(WeekDayKindEachLocal) + " -----" + vbCrLf + vbCrLf
            Else
                DaysHeaderCounter = 500 ' more suitable .....
            End If

        Loop
        WTS = FSO.CreateTextFile("output.txt")
        WTS.Write(OutPutTXT.Text + vbCrLf)

        WTS.Close

    End Sub

    Private Function ASCCHK_AllNum(tmpSTR As String) As Boolean
        Dim TryCounter As Integer
        Dim tmpCHR As String
        Dim N As Integer
        Dim ASCCHK As Boolean

        If tmpSTR = "" Then
            ASCCHK = False
        Else
            ASCCHK = True

            TryCounter = Len(tmpSTR)
            For N = 1 To TryCounter
                tmpCHR = Mid(tmpSTR, N, 1)
                If Asc(tmpCHR) < Asc("0") Then ASCCHK = False
                If Asc("9") < Asc(tmpCHR) Then ASCCHK = False
            Next
        End If
        ASCCHK_AllNum = ASCCHK

    End Function

    Private Function AvoidSmallMonth31() As Integer
        MessageBox.Show("Small Month are not perimitted 31th day.")
        AvoidSmallMonth31 = -1

    End Function

    Private Function CStrSameWidth(Num As Integer, WN As Integer) As String 'samewidth
        'using pure integer num only
        'pitch num nochk
        Dim tmpSTR As String
        Dim RM As Integer
        tmpSTR = CStr(Num)
        RM = WN - Len(tmpSTR)
        If 0 < RM Then
            For i = 1 To RM
                tmpSTR = "0" + tmpSTR
            Next
        End If
        CStrSameWidth = tmpSTR

    End Function

    Private Sub ExitBTN_Click(sender As Object, e As EventArgs) Handles ExitBTN.Click
        Me.Close()

    End Sub
End Class

'=================================================================
'
' file end
'
'=================================================================