source: Include/Classes/System/DateTime.ab@ 38

Last change on this file since 38 was 38, checked in by OverTaker, 19 years ago

ケアレスミス修正
File size: 10.4 KB
Line 
1' Classes/System/DateTime.ab
2
3#ifndef __SYSTEM_DATETIME_AB__
4#define __SYSTEM_DATETIME_AB__
5
6
7Class DateTime
8 m_Date As Int64
9Public
10 Static MaxValue = 3162240000000000000000 As Int64 'Const
11 Static MinValue = 316224000000000000 As Int64 'Const
12
13 Sub DateTime(ticks As Int64)
14 Ticks = ticks
15 Kind = DateTimeKind.Unspecified
16 End Sub
17
18 Sub DateTime(ticks As Int64, kind As DateTimeKind)
19 DateTime(ticks)
20 Kind = kind
21 End Sub
22
23 Sub DateTime(year As Long, month As Long, day As Long)
24 If year < 1 Or year > 9999 Or month < 1 Or month > 12 Or day < 1 Or day > DaysInMonth(year, month) Then
25 'ArgumentOutOfRangeException
26 debug
27 End If
28 DateTime(316224000000000)
29 AddYears(year - 1)
30
31 Dim days As Long
32 Dim i As Long
33 For i = 1 To month - 1
34 days += DaysInMonth(Year, i)
35 Next
36 days += day
37 AddDays(days - 1)
38 End Sub
39
40 Sub DateTime(year As Long, month As Long, day As Long, kind As DateTimeKind)
41 DateTime(year, month, day)
42 Kind = kind
43 End Sub
44
45 Sub DateTime(year As Long, month As Long, day As Long, hour As Long, minute As Long, second As Long)
46 If hour < 0 Or hour > 23 Or minute < 0 Or minute > 59 Or second < 0 Or second > 59 Then
47 'ArgumentOutOfRangeException
48 debug
49 End If
50 DateTime(year, month, day)
51 AddHours(hour)
52 AddMinutes(minute)
53 AddSeconds(second)
54 End Sub
55
56 Sub DateTime(year As Long, month As Long, day As Long, hour As Long, minute As Long, second As Long, kind As DateTimeKind)
57 DateTime(year, month, day, hour, minute, second)
58 Kind = kind
59 End Sub
60
61 Sub DateTime(year As Long, month As Long, day As Long, hour As Long, minute As Long, second As Long, millisecond As Long)
62 DateTime(year, month, day, hour, minute, second)
63 AddMilliseconds(millisecond)
64 End Sub
65
66 Sub DateTime(year As Long, month As Long, day As Long, hour As Long, minute As Long, second As Long, millisecond As Long, kind As DateTimeKind)
67 DateTime(year, month, day, hour, minute, second, millisecond)
68 Kind = kind
69 End Sub
70
71 Sub DateTime(ByRef time As SYSTEMTIME)
72 DateTime(time.wYear, time.wMonth, time.wDay, time.wHour, time.wMinute, time.wSecond, time.wMilliseconds)
73 End Sub
74
75 Sub DateTime(ByRef time As SYSTEMTIME, kind As DateTimeKind)
76 DateTime(time.wYear, time.wMonth, time.wDay, time.wHour, time.wMinute, time.wSecond, time.wMilliseconds, kind)
77 End Sub
78
79 Sub ~DateTime()
80 End Sub
81
82 Function Operator == (ByRef value As DateTime) As BOOL
83 Return Equals(value)
84 End Function
85
86 Function Operator <> (ByRef value As DateTime) As BOOL
87 Return Not Equals(value)
88 End Function
89
90 Function Operator > (ByRef value As DateTime) As BOOL
91 If DateTime.Compare(This, value) > 0 Then
92 Return _System_TRUE
93 Else
94 Return _System_FALSE
95 End If
96 End Function
97
98 Function Operator < (ByRef value As DateTime) As BOOL
99 If DateTime.Compare(This, value) < 0 Then
100 Return _System_TRUE
101 Else
102 Return _System_FALSE
103 End If
104 End Function
105
106 Function Operator >= (ByRef value As DateTime) As BOOL
107 If DateTime.Compare(This, value) => 0 Then
108 Return _System_TRUE
109 Else
110 Return _System_FALSE
111 End If
112 End Function
113
114 Function Operator <= (ByRef value As DateTime) As BOOL
115 If DateTime.Compare(This, value) <= 0 Then
116 Return _System_TRUE
117 Else
118 Return _System_FALSE
119 End If
120 End Function
121
122 'Property
123 Function Ticks() As Int64
124 Return (m_Date And &H3FFFFFFFFFFFFFFF)
125 End Function
126
127 Function Millisecond() As Long
128 Return (Ticks \ 10000 Mod 1000) As Long
129 End Function
130
131 Function Second() As Long
132 Return (Ticks \ 10000000 Mod 60) As Long
133 End Function
134
135 Function Minute() As Long
136 Return (Ticks \ 600000000 Mod 60) As Long
137 End Function
138
139 Function Hour() As Long
140 Return (Ticks \ 36000000000 Mod 24) As Long
141 End Function
142
143 Function Day() As Long
144 Dim day As Long
145 day = DayOfYear
146
147 Dim i As Long
148 For i = 1 To Month - 1
149 day -= DaysInMonth(Year, i)
150 Next
151 Return day
152 End Function
153
154 Function Month() As Long
155 Dim year As Long
156 Dim day As Long
157 year = Year
158 day = DayOfYear
159
160 Dim i As Long
161 For i = 1 To 12
162 day -= DaysInMonth(year, i)
163 If day < 0 Then Return i
164 Next
165 Return 12
166 End Function
167
168 Function Year() As Long
169 Dim day As Long
170 day = totalDays()
171 Return Int((day + day \ 36523 - day \ 146097) / 365.25)
172 End Function
173
174 Function DayOfWeek() As Long
175 Return totalDays() Mod 7 - 1
176 End Function
177
178 Function Kind() As Long
179 Return kindFromBinary(m_Date)
180 End Function
181
182 Function DayOfYear() As Long
183 Dim day As Long
184 day = totalDays()
185 Return day - Int(Year * 365.25 - day \ 36523 + day \ 146097)
186 End Function
187
188 Function Date() As DateTime
189 Dim date As DateTime(Year, Month, Day, Kind)
190 Return date
191 End Function
192
193 Static Function Now() As DateTime
194 Dim time As SYSTEMTIME
195 GetLocalTime(time)
196 Dim date As DateTime(time, DateTimeKind.Local)
197 Return date
198 End Function
199
200 Static Function ToDay() As DateTime
201 Dim time As SYSTEMTIME
202 GetLocalTime(time)
203 Dim date As DateTime(time.wYear, time.wMonth, time.wDay, DateTimeKind.Local)
204 Return date
205 End Function
206
207 Static Function UtcNow() As DateTime
208 Dim time As SYSTEMTIME
209 GetSystemTime(time)
210 Dim date As DateTime(time, DateTimeKind.Utc)
211 Return date
212 End Function
213
214 'method
215 Static Function Compare(ByRef t1 As DateTime, ByRef t2 As DateTime) As Int64
216 Return t1.Ticks - t2.Ticks
217 End Function
218
219 Function Equals(ByRef value As DateTime) As BOOL
220 If value.m_Date = m_Date Then
221 Return _System_TRUE
222 Else
223 Return _System_FALSE
224 End If
225 End Function
226
227 Static Function Equals(ByRef t1 As DateTime, ByRef t2 As DateTime) As BOOL
228 If t1.m_Date = t2.m_Date Then
229 Return _System_TRUE
230 Else
231 Return _System_FALSE
232 End If
233 End Function
234
235 Sub AddTicks(value As Int64)
236 Dim ticks As Int64
237 ticks = Ticks
238 If (ticks > DateTime.MaxValue - value) Or (ticks < DateTime.MinValue - value) Then
239 'ArgumentOutOfRangeException
240 debug
241 End If
242 Ticks = ticks + value
243 End Sub
244
245 Sub AddMilliseconds(value As Double)
246 AddTicks((value * 10000) As Int64)
247 End Sub
248
249 Sub AddSeconds(value As Double)
250 AddTicks((value * 10000000) As Int64)
251 End Sub
252
253 Sub AddMinutes(value As Double)
254 AddTicks((value * 600000000) As Int64)
255 End Sub
256
257 Sub AddHours(value As Double)
258 AddTicks((value * 36000000000) As Int64)
259 End Sub
260
261 Sub AddDays(value As Double)
262 AddTicks((value * 864000000000) As Int64)
263 End Sub
264
265 Sub AddYears(value As Double)
266 Dim year As Long
267 Dim intValue As Long
268 year = Year
269 intValue = Int(value)
270 AddTicks(intValue * 315360000000000 + 864000000000 * ((year Mod 4 + intValue) \ 4 - (year Mod 100 + intValue) \ 100 + (year Mod 400 + intValue) \ 400))
271 If value < 0 Then
272 If year Mod 4 + intValue <= 0 And year Mod 100 > 4 Then
273 AddTicks(-864000000000)
274 End If
275 End If
276
277 If IsLeapYear(year) = TRUE Then
278 AddTicks(((value - intValue) * 316224000000000) As Int64)
279 Else
280 AddTicks(((value - intValue) * 315360000000000) As Int64)
281 End If
282 End Sub
283
284 Function DaysInMonth(year As Long, month As Long) As Long
285 If year < 1 Or year > 9999 Or month < 1 Or month > 12 Then
286 'ArgumentOutOfRangeException
287 debug
288 End If
289 Select Case month
290 Case 1
291 Return 31
292 Case 2
293 If IsLeapYear(year) = TRUE Then
294 Return 29
295 Else
296 Return 28
297 End If
298 Case 3
299 Return 31
300 Case 4
301 Return 30
302 Case 5
303 Return 31
304 Case 6
305 Return 30
306 Case 7
307 Return 31
308 Case 8
309 Return 31
310 Case 9
311 Return 30
312 Case 10
313 Return 31
314 Case 11
315 Return 30
316 Case 12
317 Return 31
318 End Select
319 End Function
320
321 Function IsLeapYear(year As Long) As BOOL
322 If (year Mod 4) = 0 Then
323 If (year Mod 100) = 0 Then
324 If (year Mod 400) = 0 Then
325 Return _System_TRUE
326 End If
327 Return _System_FALSE
328 Else
329 Return _System_TRUE
330 End If
331 End If
332 Return _System_FALSE
333 End Function
334
335 'まだ適当です
336 Function GetDateTimeFormats() As String
337 Return Str$(Year) + "/" + Str$(Month) + "/" + Str$(Day) + " " + Str$(Hour) + ":" + Str$(Minute) + ":" + Str$(Second)
338 End Function
339
340 Static Function FromBinary(dateData As Int64) As DateTime
341 Dim date As DateTime((dateData And &H3FFFFFFFFFFFFFFF), kindFromBinary(dateData))
342 Return date
343 End Function
344
345 Function ToBinary() As Int64
346 Return m_Date
347 End Function
348
349 Static Function FromFileTime(fileTime As FILETIME) As DateTime
350 Dim localTime As FILETIME
351 FileTimeToLocalFileTime(fileTime, localTime)
352 Dim time As SYSTEMTIME
353 FileTimeToSystemTime(localTime, time)
354 Dim date As DateTime(time, DateTimeKind.Local)
355 Return date
356 End Function
357
358 Function ToFileTime() As FILETIME
359 Dim time As SYSTEMTIME
360 With time
361 .wYear = Year As Word
362 .wMonth = Month As Word
363 .wDay = Day As Word
364 .wHour = Hour As Word
365 .wMinute = Minute As Word
366 .wSecond = Second As Word
367 .wMilliseconds = Millisecond As Word
368 End With
369 Dim fileTime As FILETIME
370 SystemTimeToFileTime(time, fileTime)
371 Return fileTime
372 End Function
373
374 Static Function FromFileTimeUtc(fileTime As FILETIME) As DateTime
375 Dim time As SYSTEMTIME
376 FileTimeToSystemTime(fileTime, time)
377 Dim date As DateTime(time, DateTimeKind.Utc)
378 Return date
379 End Function
380
381 Function ToFileTimeUtc() As FILETIME
382 Dim fileTime As FILETIME
383 fileTime = ToFileTime()
384 If Kind = 1 Then
385 Dim utcTime As FILETIME
386 LocalFileTimeToFileTime(fileTime, ToFileTimeUtc)'Return
387 Else
388 Return fileTime
389 End If
390 End Function
391
392 Function ToLocalTime() As DateTime
393 ToLocalTime = DateTime.FromFileTime(ToFileTimeUtc())
394 ToLocalTime.Kind = DateTimeKind.Local
395 End Function
396Private
397 Sub Ticks(value As Int64)
398 Dim kind As DateTimeKind
399 kind = Kind
400 m_Date = value
401 Kind = kind
402 End Sub
403
404 Sub Kind(kind As DateTimeKind)
405 Dim temp As Int64
406 temp = kind
407 temp = (temp << 62) And &HC000000000000000
408 m_Date = (m_Date And &H3FFFFFFFFFFFFFFF) Or temp
409 End Sub
410
411 Function totalDays() As Long
412 Return (Ticks \ 864000000000) As Long
413 End Function
414
415 Function kindFromBinary(dateData As Int64) As Long
416 dateData = (dateData >> 62) And &H03
417 If dateData = &H01 Then
418 Return DateTimeKind.Local
419 ElseIf dateData = &H02 Then
420 Return DateTimeKind.Unspecified
421 ElseIf dateData = &H03 Then
422 Return DateTimeKind.Utc
423 End If
424 End Function
425End Class
426
427Enum DateTimeKind
428 Local
429 Unspecified
430 Utc
431End Enum
432
433Enum DayOfWeek
434 Sunday = 0
435 Monday
436 Tuesday
437 Wednesday
438 Thursday
439 Friday
440 Saturday
441End Enum
442
443#endif '__SYSTEM_DATETIME_AB__
Note: See TracBrowser for help on using the repository browser.