月数・日数計算 <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