月数・日数計算             <TOP>


開始年月日〜終了年月日をyyyymmdd(19980512)のように入力し、日数計算ボタンをクリックします。

月(1〜12)、日(1〜31)の範囲をはずれた場合再入力、月末日はEndOfMonth部でチェックしており、

月末日を超えた数字を入力した場合は修正されます。例:20040230 → 20040229

丸1ヶ月、丸1日を表しており開始月、開始日は計算に入っていません。

'================================================================
'= 月数・日数計算
'=    (DaysCalc.bas)
'================================================================
#include "Windows.bi"

Var shared Text(5) As Object
Var shared Edit(1) As Object
Var shared Button1 As Object

For i = 0 To 5
    Text(i).Attach GetDlgItem("Text" & Trim$(Str$(i + 1)))
    Text(i).SetFontSize 14
Next
For i = 0 To 1
    Edit(i).Attach GetDlgItem("Edit" & Trim$(Str$(i + 1)))
    Edit(i).SetFontSize 14
Next
Button1.Attach GetDlgItem("Button1")
Button1.SetFontSize 14

' 月数・日数判定用
def fnN(Y, M, D) = Int(365.25 * Y) + Int(Y / 400) - int(Y / 1000) + Int(30.59 * (M - 2)) + D + 678912!
def fnL(Y1, M1, D1, Y2, M2, D2) = fnN(Y2, M2, D2) - fnN(Y1, M1, D1)

Var shared SY1 As Long                    '指定開始年
Var shared SM1 As Long                    '  〃 月
Var shared SD1 As Long                    '  〃 日
Var shared SY2 As Long                    '指定終了年
Var shared SM2 As Long                    '  〃 月
Var shared SD2 As Long                    '  〃 日
Var shared SY As Long                     '月末日用年
Var shared SM As Long                     '  〃 月
Var shared SD As Long                     '  〃 日
Var shared SMM As Long                    '月数(結果)
Var shared SDD As Long                    '日数(結果)
Var shared SE As Long                     '月末日(結果)
Var shared WYM As Long                    '月数ワーク
Var shared CrLf As String

'================================================================
'= 月末(月の最終日取得)
'================================================================
Declare Sub EndOfMonth edecl ()
Sub EndOfMonth()
    If SM <> 2 Then SE = Abs(7.5 - SM) Mod 2 + 30 : Exit Sub

    If SY Mod 4 <> 0 Then
        SE = 28
    Else If SY Mod 100 <> 0 Then
        SE = 29
    Else If SY Mod 400 <> 0 Then
        SE = 28
    Else
        SE = 29
    End If
End Sub

'================================================================
'= 日数計算
'================================================================
Declare Sub DaysCalc edecl ()
Sub DaysCalc()
    If SD1 = 0 Or SD2 = 0 Then Exit Sub

    ZYM = WYM
    WYM = (SY2 -SY1 ) * 12
    SMM = WYM + SM2 - SM1
    If SD1 > SD2 Then
        SY = SY2
        SM = SM2
        EndOfMonth
        If SE <> SD2 Then
            SMM = SMM - 1
        End If
    End If

    SM3 = Int(SMM / 6)
    SY5 = SY1 + Int(SM3 / 2)
    SM5 = SM1 + (SM3 Mod 2) * 6
    If SM5 > 12 Then
        SY5 = SY5 + 1
        SM5 = SM5 - 12
    End If

    SY = SY5
    SM = SM5
    EndOfMonth
    SD5 = SE
    If SD5 > SD1 Then SD5 = SD1
    WY1 = SY1
    WM1 = SM1
    WY2 = SY2
    WM2 = SM2
    WY5 = SY5
    WM5 = SM5
    If SM1 = 1 Or SM1 = 2 Then WM1 = SM1 + 12 : WY1 = SY1 - 1
    If SM2 = 1 Or SM2 = 2 Then WM2 = SM2 + 12 : WY2 = SY2 - 1
    If SM5 = 1 Or SM5 = 2 Then WM5 = SM5 + 12 : WY5 = SY5 - 1
    SDN = fnL(WY5, WM5, SD5, WY2, WM2, SD2)
    SDD = fnL(WY1, WM1, SD1, WY2, WM2, SD2)
    WYM = ZYM
End Sub

'================================================================
'=    
'================================================================
Declare Sub MainForm_Start edecl ()
sub MainForm_Start()
    CrLf = Chr$(13, 10)
    Edit(1).SetFocus
End Sub

'================================================================
'=    
'================================================================
Declare Sub Button1_On edecl ()
sub Button1_On()
    SY1 = Val(Left$(GetDlgItemText("Edit1"), 4))
    SM1 = Val(Mid$(GetDlgItemText("Edit1"), 5, 2))
    SD1 = Val(Right$(GetDlgItemText("Edit1"), 2))

    SY2 = Val(Left$(GetDlgItemText("Edit2"), 4))
    SM2 = Val(Mid$(GetDlgItemText("Edit2"), 5, 2))
    SD2 = Val(Right$(GetDlgItemText("Edit2"), 2))

    DaysCalc

    Text(3).SetWindowText Trim$(Str$(SMM)) & "ヶ月"
    Text(5).SetWindowText Trim$(Str$(SDD)) & "日"
End Sub

'================================================================
'= Edit1
'================================================================
Declare Sub Edit1_Change edecl ()
Sub Edit1_Change()
    ED1$ = GetDlgItemText("Edit1")
    ePos = InStr(ED1$, CrLf)
    If ePos <> 0 Then
        ED1$ = Mid$(ED1$, 1, ePos - 1) & Mid$(ED1$, ePos + 2)
        Edit(0).SetWindowText ED1$
        SY1 = Val(Left$(ED1$, 4))
        SM1 = Val(Mid$(ED1$, 5, 2))
        SD1 = Val(Right$(ED1$, 2))

        SY = SY1
        SM = SM1
        SD = SD1
        EndOfMonth

        If SM1 < 1 Or SM1 > 12 Or SD1 < 1 Then
            Edit(1).SetWindowText ""
            Edit(1).SetFocus
        Else If SD1 > SE Then
            ED1$ = Left$(ED1$, 6) & Right$(Str$(100 + SE), 2)
            Edit(0).SetWindowText ED1$
        End If

        Edit(1).SetWindowText ""
        Edit(1).SetFocus
     end if
End Sub

'================================================================
'= Edit2
'================================================================
Declare Sub Edit2_Change edecl ()
Sub Edit2_Change()
    ED2$ = GetDlgItemText("Edit2")
    ePos = InStr(ED2$, CrLf)

    If ePos <> 0 Then
        ED2$ = Mid$(ED2$, 1, ePos - 1) & Mid$(ED2$, ePos + 2)
        Edit(1).SetWindowText ED2$
        SY2 = Val(Left$(ED2$, 4))
        SM2 = Val(Mid$(ED2$, 5, 2))
        SD2 = Val(Right$(ED2$, 2))

        SY = SY2
        SM = SM2
        SD = SD2
        EndOfMonth
    
        If SM2 < 1 Or SM2 > 12 Or SD2 < 1 Then
            Edit(1).SetWindowText ""
            Edit(1).SetFocus
        Else If SD2 > SE Then
            ED2$ = Left$(ED2$, 6) & Right$(Str$(100 + SE), 2)
            Edit(1).SetWindowText ED2$
        End If
        Button1.SetFocus
     End If
End Sub

'================================================================
'=    
'================================================================
While 1
    WaitEvent
Wend
Stop
End