日にち計算法

[音太]

件名通り「日にち計算法」についてなんですが、検索してたら
VBだとDateValueやDateSerial等の便利な関数があり
日時の値同士を計算する事もできるらしいのですが、
ABではそういった関数もなく、日時の値同士を計算する事も出来ません。

ただ、ある年月日から次の日の年月日を取得したいのです。
（その後、それを使って比較したりする）

条件文をズラズラと書けば何とか可能かもしれませんが
もっと簡単にやる方法はないのでしょうか？
この事に関して知っている事があったら教えてください。

[淡幻星]

> ABではそういった関数もなく、日時の値同士を計算する事も出来ません。
Date$ で日付が、 Time$ で時間が得られます。
計算（比較）方法としては、ある点を基準とした値で比較すればよいと思います。

コード: 全て選択

'時刻比較のための一例：０時０分０秒を起点とした秒数を返す関数。
Function GetTimeFormSec() As Long
    Dim strBuf As String
    Dim nSec As Long
    strBuf = Time$
    nSec = Val( Right$( strBuf, 2 ) )
    nSec = nSec + Val( Mid$( strBuf, 4, 2 ) )*60
    nSec = nSec + Val( Left$(strBuf,2) )*3600
    GetTimeFormSec = nSec
EndFunction

Win32APIでやるなら GetLocalTime() で日付も時間も一緒に取得できます。
こちらは
GetLocalTime() + SystemTimeToFileTime()
で1601年1月1日を起点とした 100 ナノ秒単位の数値を
得られますので、これで比較すれば楽かと思います。
（QWord型を使えばif文無しで一発比較できそう。）
逆変換も FileTimeToSystemTime() ですぐできます。
詳しくはHELPを読んでください。

[音太]

ずーっと検索してて、その中でFileTimeは知ってたのですが
ファイル関連で使う物で日にち計算には使えないのかと思ってました。

今もう一度調べなおしたら、やろうとしてた事が出来そうです。
淡幻星さん、本当に有難う御座います。めちゃくちゃ助かりました。

[音太]

ある年月日を入力。↓
それをFILETIMEに直して1601年1月1日を起点とした 100 ナノ秒単位の数値を得る。↓
24時間分の100 ナノ秒をたす。↓
それをSystemTimeに直して、次の日の年月日を得る。

とやろうと思ってたのですが、FILETIMEが、上位・下位32ビットに分かれてて計算できない。
MAKELONGみたいに64ビット整数値を作成する関数もない。
検索しても、そういう事をするのはスマートじゃないと言うのはあったが、有用な情報が見つかりません。
なので、64ビット整数値に直す方法を教えてください。
それともこういうやり方はスマートじゃないのでしょうか？

[淡幻星]

コード: 全て選択

Dim lpSysTime As SYSTEMTIME
Dim lpFileTime As FILETIME
Dim nYear As Long
Dim nMonth As Long
Dim nDay As Long

Dim q As QWord
Const OneDayOnFileTime = &HC92A69C000 ' 24h = 86400 * 10^7 [100ns]

Dim retAns As Long

'日時の入力の例
nYear = 2005
nMonth = 8
nDay = 8

'システム時間へ代入
With lpSysTime
    .wYear = nYear
    .wMonth = nMonth
    .wDay = nDay
EndWith

'ファイル時間へ変換
retAns = SystemTimeToFileTime( lpSysTime, lpFileTime )

'QWord型への変換
q = lpFileTime.dwHighDateTime
q = q << 32
q = q + lpFileTime.dwLowDateTime

'一日分の加算
q = q + OneDayOnFileTime

'DWord型×２への変換と代入
lpFileTime.dwLowDateTime = q and &HFFFFFFFF
q = q and &HFFFFFFFF00000000
q = q >> 32
lpFileTime.dwHighDateTime = q

'システム時間への変換
retAns = FileTimeToSystemTime( lpFileTime, lpSysTime )

'変化の反映
With lpSysTime
	nYear = .wYear
	nMonth = .wMonth
	nDay = .wDay
EndWith

'動作チェック
Debug

Ver4.04.00で確認

こんな感じでしょうか。
実際に組んでみて思ったんですが、時間を含まない日付計算であれば、
FILETIMEなんぞ使わずにIf文で組んだ方がよっぽどスマートな気がしてきました。
このへんは好みの問題でしょうけども。

コードを見れば分かると思いますが、ついでなので。

コード: 全て選択

'QWord型への変換
Function MakeQWord( LowDWord As DWord, HighDWord As DWord ) As QWord
	Dim q As QWord
	q = HighDWord
	q = q << 32
	q = q + LowDWord
	MakeQWord = q
EndFunction

'DWord型への分解
Function HiDWord( q As QWord ) As DWord
	q = q and &HFFFFFFFF00000000
	q = q >> 32
	HiDWord = q
EndFunction
Function LoDWord( q As QWord ) As DWord
	LoDWord = q and &HFFFFFFFF
EndFunction

そのうち、山本様にデフォルトで対応していただけると思いますので、
それまでの場つなぎ関数ですね。･･･滅多に使わなさそう（＾＾；）

[音太]

検索してて、シフトをつかえば64ビットにできるのかも、でもその先どうすればいいんだろ、と思ってましたが意外と簡単にQWord型への変換が出来るんですね。

色々実験して行く内に、システムタイムはありえない日にちを入れることが出来るのですが（例えば8月32日）、それをファイルタイムにするとDateTimeに0が入る事を発見。それを利用して、ありえない日にちが来たら、月や年を増やす方法で「ある日の次の日を取得するコード」を自分でも考えてみました。

コード: 全て選択

Dim st As SYSTEMTIME
Dim ft As FILETIME
Dim buffer As String

GetLocalTime(st)  '例　現在から次の日（つまり明日）の日時を知る
st.wDay=st.wDay+1

SystemTimeToFileTime(st,ft)

If Str$(ft.dwHighDateTime)+Str$(ft.dwLowDateTime) ="00" AND st.wMonth=12 Then
    'ありえない日にち、かつ12月の時

	st.wDay=1
	st.wMonth=1
	st.wYear=st.wYear+1

ElseIf Str$(ft.dwHighDateTime)+Str$(ft.dwLowDateTime) ="00" Then  'ありえない日にちの時

	st.wDay=1
	st.wMonth=st.wMonth+1

End If

buffer=Str$(st.wYear)+"/"+_              '確認のため一応表示
    Right$("0"+Str$(st.wMonth),2)+"/"+_
    Right$("0"+Str$(st.wDay),2)

MessageBox(hMainWnd, buffer, "Test", MB_OK)

試しに色んな日を入れてやってみましたが、年が変わる時も、閏年もばっちりです。

今回の日にち計算以外でもファイルタイムやQWord型への変換を使いたいと思っていたので凄く参考になりました。
それと、自分以外の人のコードを見るのは大変勉強になります。
重ね重ね有難う御座います。

[音太]

システムタイムはありえない日にちを入れることが出来るのですが（例えば8月32日）、それをファイルタイムにするとDateTimeに0が入る
というのは間違いでした。

今日は8/31ですが8/32にしても0が入らない。
前に色々な数を入れて実験した時は大丈夫だったのですが…。
理由は分かりませんが、とにかく間違いですので、使わないように。
そもそも、誰も見てないし、使わないかもしれないけど。

淡幻星さんのコードを使ってください。

大変失礼しました。