+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Utilities (https://staging.qb64phoenix.com/forumdisplay.php?fid=8)
+---- Thread: Time - Not a Library (/showthread.php?tid=430)
Time - Not a Library - TarotRedhand - 05-18-2022
If it wasn't for the fact that of the 26 routines contained in this only 2 of them are public, this would have gone in the libraries section. This is a reworking of something I made years ago. Originally it made use of DOS calls in order to get the information that it uses. Fortunately, after considering what is available in QB64 I was able to get this information via a different method. In the end I only had to change 2 SUBs but there was a single piece of information that I got from the DOS calls that wasn't easily available in QB64. In the end it meant an additional function using an algorithm I found online. So what is it?
What I am posting this time is just a pair of public functions and all that one of the pair does is to get the current date and time from the system. The second function is I hope worthy of your attention. What it does is similar to one of the functions that comes as standard with ANSI C - I've just extended it a little. Basically, what this second function does is to take a string that contains codes embedded in it and it uses this string to produce a second string with dates/times expanded at the point where the codes were in the template string. With this routine you can have the dates/times in whatever format you wish (this includes the year being in Roman numerals. It is at this point that I realise that actions definitely speak louder than words and so suggest you look at the comments contained in the original TIME.BI for an explanation of what these routines do and to run TIMETEST.BAS.
For additional information, read the comments in the original BI file (but don't use it, it won't work!)
TIMid.BI (obsolete)
Code: (Select All)
REM ******************************************************
REM * Filespec : time.bas time.bi testtime.bas *
REM * Date : August 8 1997 *
REM * Time : 19:01 *
REM * Revision : 1.00B *
REM * Update : *
REM ******************************************************
REM * Released to the Public Domain *
REM ******************************************************
CONST FALSE% = 0, TRUE% = -1
TYPE When
Second AS INTEGER '| 0..59
Minute AS INTEGER '| 0..59
Hour AS INTEGER '| 0..23
WeekDay AS INTEGER '| 1..7
MonthDay AS INTEGER '| 1..[28 or 29 or 30 or 31]
YearDay AS INTEGER '| 1..[365 or 366]
YearWeek AS INTEGER '| 1..52
Month AS INTEGER '| 1..12
Year AS INTEGER
IsLeapYear AS INTEGER '| TRUE% or FALSE%
END TYPE
REM ******************************************************************
REM * The following 2 routines rely upon the accuracy of the PC's *
REM * internal clock and calendar. i.e. if your PC's clock or *
REM * calendar are inaccurate then the output from these routines *
REM * will be inaccurate to the same degree. *
REM ******************************************************************
DECLARE SUB ThisInstant(Now AS When)
REM ******************************************************************
REM * This routine produces a snapshot of the time and date at the *
REM * instant that it is called and fills the variable Now with the *
REM * information obtained. It uses DOS routines to gather the *
REM * information and so works from 1/1/80 to 31st December 2099. *
REM ******************************************************************
DECLARE SUB FTString(FormatString$, OutputString$, Now AS When)
REM ******************************************************************
REM * This routine produces a string (OutputString$) with time and *
REM * date information embedded within it, as specified by the *
REM * information encoded within FormatString$. The variable Now *
REM * may be used to specify a specific time and date or Now may be *
REM * updated as part of this routine so that the current time and *
REM * date are used instead. *
REM * *
REM * If FormatString$ contains no temporal codes it will simply be *
REM * copied to OutputString$. If during processing of *
REM * FormatString$ an invalid code is encountered, processing will *
REM * cease and an immediate return to SYSTEM occurs with an *
REM * appropriate error message displayed. *
REM * *
REM * There are 29 different temporal codes in all, each of which *
REM * starts with the tilde (CHR$(126), '~') character. The action *
REM * of this routine is to copy everything contained in *
REM * FormatString, except the codes, to OutputString. When a code *
REM * is encountered, it is replaced in OutputString by the *
REM * sub-string that corresponds to that code. In the following *
REM * explanation of the codes and their meanings I have, for *
REM * reasons of brevity, used the word output to signify the *
REM * replacement of a particular code by the sub-string that is *
REM * described immediately following the usage of the word output. *
REM * The codes and their meanings follow hereafter. *
REM * *
REM *----------------------------------------------------------------*
REM * *
REM * ~1 - Set all time output after this to be in 12 hour *
REM * format. *
REM * *
REM * ~2 - Set all time output after this to be in 24 hour *
REM * format. *
REM * *
REM * ~A - Output either am or pm depending on the time. *
REM * *
REM * ~B - Output the month in abbreviated form *
REM * (Jan, Feb etc.). *
REM * *
REM * ~C - Output the full month name *
REM * (January, February etc.). *
REM * *
REM * ~D - Output full date as January 1 1996 etc. *
REM * *
REM * ~E - Output numeric date in dd/mm/yy form. *
REM * *
REM * ~F - Output full date as 1 January 1996 etc. *
REM * *
REM * ~G - Output numeric date in mm/dd/yy form. *
REM * *
REM * ~H - Output the Hour. *
REM * *
REM * ~I - Output the day of the week in abbreviated form. *
REM * (Mon, Tue etc.) *
REM * *
REM * ~J - Output the full name of the day of the week. *
REM * (Monday, Tuesday etc.) *
REM * *
REM * ~K - Output the time in short form HH:MM. *
REM * *
REM * ~L - Output the time in long form HH:MM:SS. *
REM * *
REM * ~M - Output the Minute. *
REM * *
REM * ~N - Output the Numeric day of week (1 = Sunday). *
REM * *
REM * ~O - Output the Numeric day of the month (1, 2, 3 etc.).*
REM * *
REM * ~P - Output the Numeric Month (1 = January). *
REM * *
REM * ~Q - Output the Numeric day of the month with the *
REM * appropriate suffix (1st, 2nd, 3rd, 4th etc.). *
REM * *
REM * ~R - Output the year in ROMAN numerals - MCMXCVI. *
REM * *
REM * ~S - Output the Second. *
REM * *
REM * ~T - Output the total date in the form - *
REM * Sunday 18th February 1996. *
REM * *
REM * ~U - Update (or get new) the information in the *
REM * variable 'Now'. *
REM * *
REM * ~V - Output the date in the form - 18th Feb 96. *
REM * *
REM * ~W - Output the week of the year - 1 to 52. *
REM * *
REM * ~X - Output the day of the year - *
REM * 1 to 365 or 366 in leap year. *
REM * *
REM * ~Y - Output the year in the form 1996. *
REM * *
REM * ~Z - Output the year in the form 96. *
REM * *
REM * ~r - Output the total date in the form - *
REM * Sun 18th Feb 96. *
REM * *
REM * ~~ - Output the character ~ (CHR$(126), '~'). *
REM * *
REM *----------------------------------------------------------------*
REM * *
REM * An example of the usage of this routine is as follows:- *
REM * *
REM * FT$ = "~U~1Today, ~T, at precisely ~L~A, I resigned." *
REM * FTString FT$, Out$, Now *
REM * *
REM * Which should result in Out$ containing the following (assuming *
REM * the dates and times contained) :- *
REM * *
REM * Today, Sunday 18th February 1996, at precisely 12:40pm, I *
REM * resigned. *
REM ******************************************************************Here is the actual working BI file -
TIME.BI
Code: (Select All)
REM ******************************************************
REM * Filespec : time.bas time.bi testtime.bas *
REM * Date : August 8 1997 *
REM * Time : 19:01 *
REM * Revision : 1.00B *
REM * Update : *
REM ******************************************************
REM * Released to the Public Domain *
REM ******************************************************
CONST FALSE% = 0, TRUE% = -1
COMMON SHARED Hours24%
Hours24% = FALSE%
TYPE When
Second AS INTEGER '| 0..59
Minute AS INTEGER '| 0..59
Hour AS INTEGER '| 0..23
WeekDay AS INTEGER '| 1..7
MonthDay AS INTEGER '| 1..[28 or 29 or 30 or 31]
YearDay AS INTEGER '| 1..[365 or 366]
YearWeek AS INTEGER '| 1..52
Month AS INTEGER '| 1..12
Year AS INTEGER
IsLeapYear AS INTEGER '| TRUE% or FALSE%
END TYPENow the BM file
TIME.BM
Code: (Select All)
REM ******************************************************
REM * Private SUB - Do not call directly *
REM ******************************************************
FUNCTION DayOfWeek(Year$, Month%, Day%)
DIM Year%, Code%
Year% = VAL(Year$)
Code% = VAL(RIGHT$(YEAR$, 2))
Code% = (Code% + (Code% \ 4)) Mod 7
Code% = Code% + VAL(MID$("033614625035", Month%, 1))
IF (YEAR% >= 2000) THEN
Code% = Code% + 6
END IF
IF (((Year% MOD 400) = 0) AND (Month% > 2))THEN
Code% = Code% + 1
ELSEIF (((Year% MOD 4) = 0) AND ((Year% MOD 100) <> 0) AND (Month% > 2)) THEN
Code% = Code% + 1
END IF
Code% = Code% + Day%
DayOfWeek = 1 + (Code% MOD 7)
END FUNCTION
REM ******************************************************
REM * Private SUB - Do not call directly *
REM ******************************************************
SUB GetDate(Year%, Month%, Day%, WeekDay%)
DIM TempDate$
TempDate$ = DATE$
Year% = VAL(RIGHT$(TempDate$, 4))
Month% = VAL(LEFT$(TempDate$, 2))
Day% = VAL(MID$(TempDate$, 4, 2))
WeekDay% = DayOfWeek(LTRIM$(STR$(Year%)), Month%, Day%)
END SUB
REM ******************************************************
REM * Private SUB - Do not call directly *
REM ******************************************************
SUB GetTime(Hours%, Minutes%, Seconds%)
DIM AllSeconds AS LONG
AllSeconds = TIMER
Hours% = AllSeconds \ 3600
AllSeconds = AllSeconds MOD 3600
Minutes% = AllSeconds \ 60
Seconds% = AllSeconds MOD 60
END SUB
REM ******************************************************************
REM * This routine produces a snapshot of the time and date at the *
REM * instant that it is called and fills the variable Now with the *
REM * information obtained. It uses DOS routines to gather the *
REM * information and so works from 1/1/80 to 31st December 2099. *
REM ******************************************************************
SUB ThisInstant(Now AS When)
GetDate Now.Year, Now.Month, Now.MonthDay, Now.WeekDay
Now.IsLeapYear = FALSE%
IF (Now.Year MOD 400) = 0 THEN
Now.IsLeapYear = TRUE%
ELSEIF ((Now.Year MOD 4) = 0) AND ((Now.Year MOD 100) <> 0) THEN
Now.IsLeapYear = TRUE%
END IF
DayOfYear Now.Month, Now.MonthDay, Now.IsLeapYear, Now.YearDay
WeekOfYear Now.YearDay, Now.YearWeek
GetTime Now.Hour, Now.Minute, Now.Second
END SUB
REM ******************************************************
REM * Private SUB - Do not call directly *
REM ******************************************************
SUB DayOfYear(Month%, Day%, LeapYear%, YearDay%)
YearDay% = Day%
IF Month% > 1 THEN
SELECT CASE (Month% - 1)
CASE 1
YearDay% = YearDay% + 31
CASE 2
YearDay% = YearDay% + 59
CASE 3
YearDay% = YearDay% + 90
CASE 4
YearDay% = YearDay% + 120
CASE 5
YearDay% = YearDay% + 151
CASE 6
YearDay% = YearDay% + 181
CASE 7
YearDay% = YearDay% + 212
CASE 8
YearDay% = YearDay% + 243
CASE 9
YearDay% = YearDay% + 273
CASE 10
YearDay% = YearDay% + 304
CASE 11
YearDay% = YearDay% + 334
END SELECT
IF ((Month% > 2) AND LeapYear%) THEN
YearDay% = YearDay% + 1
END IF
END IF
END SUB
REM ******************************************************
REM * Private SUB - Do not call directly *
REM ******************************************************
SUB WeekOfYear(YearDay%, Week%)
Week% = YearDay% \ 7
IF ((YearDay% MOD 7) <> 0) THEN
Week% = Week% + 1
END IF
END SUB
REM ******************************************************
REM * Private SUB - Do not call directly *
REM ******************************************************
SUB StringWeekDay(DayCode%, DayString$)
SELECT CASE DayCode%
CASE 1
DayString$ = "Sunday"
CASE 2
DayString$ = "Monday"
CASE 3
DayString$ = "Tuesday"
CASE 4
DayString$ = "Wednesday"
CASE 5
DayString$ = "Thursday"
CASE 6
DayString$ = "Friday"
CASE 7
DayString$ = "Saturday"
END SELECT
END SUB
REM ******************************************************
REM * Private SUB - Do not call directly *
REM ******************************************************
SUB StringShortDay(DayCode%, DayString$)
SELECT CASE DayCode%
CASE 1
DayString$ = "Sun"
CASE 2
DayString$ = "Mon"
CASE 3
DayString$ = "Tue"
CASE 4
DayString$ = "Wed"
CASE 5
DayString$ = "Thu"
CASE 6
DayString$ = "Fri"
CASE 7
DayString$ = "Sat"
END SELECT
END SUB
REM ******************************************************
REM * Private SUB - Do not call directly *
REM ******************************************************
SUB StringMonth(MonthCode%, MonthString$)
SELECT CASE MonthCode%
CASE 1
MonthString$ = "January"
CASE 2
MonthString$ = "February"
CASE 3
MonthString$ = "March"
CASE 4
MonthString$ = "April"
CASE 5
MonthString$ = "May"
CASE 6
MonthString$ = "June"
CASE 7
MonthString$ = "July"
CASE 8
MonthString$ = "August"
CASE 9
MonthString$ = "September"
CASE 10
MonthString$ = "October"
CASE 11
MonthString$ = "November"
CASE 12
MonthString$ = "December"
END SELECT
END SUB
REM ******************************************************
REM * Private SUB - Do not call directly *
REM ******************************************************
SUB StringShortMonth(MonthCode%, MonthString$)
SELECT CASE MonthCode%
CASE 1
MonthString$ = "Jan"
CASE 2
MonthString$ = "Feb"
CASE 3
MonthString$ = "Mar"
CASE 4
MonthString$ = "Apr"
CASE 5
MonthString$ = "May"
CASE 6
MonthString$ = "Jun"
CASE 7
MonthString$ = "Jul"
CASE 8
MonthString$ = "Aug"
CASE 9
MonthString$ = "Sep"
CASE 10
MonthString$ = "Oct"
CASE 11
MonthString$ = "Nov"
CASE 12
MonthString$ = "Dec"
END SELECT
END SUB
REM ******************************************************
REM * Private SUB - Do not call directly *
REM ******************************************************
SUB GetHour(Hour%, TempString$)
TempString$ = ""
IF NOT Hours24% THEN
IF Hour% = 0 THEN
TempString$ = "12"
ELSE
IF Hour% > 12 THEN
Hour% = Hour% - 12
END IF
END IF
END IF
IF TempString$ = "" THEN
TempString$ = LTRIM$(RTRIM$(STR$(Hour%)))
DO WHILE LEN(TempString$) < 2
TempString$ = "0" + TempString$
LOOP
END IF
END SUB
REM ******************************************************
REM * Private SUB - Do not call directly *
REM ******************************************************
SUB ShortYear(Year%, TempString$)
TempYear% = (Year% MOD 100)
TempString$ = LTRIM$(RTRIM$(STR$(TempYear%)))
DO WHILE LEN(TempString$) < 2
TempString$ = "0" + TempString$
LOOP
END SUB
REM ******************************************************
REM * Private SUB - Do not call directly *
REM ******************************************************
SUB GetSuffix(MonthDay%, TempString$)
IF ((MonthDay% > 3) AND (MonthDay% < 21))THEN
TempString$ = "th"
ELSE
TempMonthDay% = MonthDay% MOD 10
SELECT CASE TempMonthDay%
CASE 0
TempString$ = "th"
CASE 1
TempString$ = "st"
CASE 2
TempString$ = "nd"
CASE 3
TempString$ = "rd"
CASE ELSE
TempString$ = "th"
END SELECT
END IF
END SUB
REM ******************************************************
REM * Private SUB - Do not call directly *
REM ******************************************************
SUB GetTwoDigits(Number%, TempString$)
TempString$ = LTRIM$(RTRIM$(STR$(Number% MOD 100)))
DO WHILE LEN(TempString$) < 2
TempString$ = "0" + TempString$
LOOP
END SUB
REM ******************************************************
REM * Private SUB - Do not call directly *
REM ******************************************************
SUB GetShortTime(Now AS When, TempString$)
GetHour Now.Hour, TempString$
GetTwoDigits Now.Minute, Minute$
TempString$ = TempString$ + ":" + Minute$
END SUB
REM ******************************************************
REM * Private SUB - Do not call directly *
REM ******************************************************
SUB GetLongTime(Now AS When, TempString$)
GetShortTime Now, TempString$
GetTwoDigits Now.Second, Second$
TempString$ = TempString$ + ":" + Second$
END SUB
REM ******************************************************
REM * Private SUB - Do not call directly *
REM ******************************************************
SUB GetNumericDateUK(Now AS When, TempString$)
GetTwoDigits Now.MonthDay, MonthDay$
GetTwoDigits Now.Month, Month$
ShortYear Now.Year, Year$
TempString$ = MonthDay$ + "/" + Month$ + "/" + Year$
END SUB
REM ******************************************************
REM * Private SUB - Do not call directly *
REM ******************************************************
SUB GetNumericDateUSA(Now AS When, TempString$)
GetTwoDigits Now.MonthDay, MonthDay$
GetTwoDigits Now.Month, Month$
ShortYear Now.Year, Year$
TempString$ = Month$ + "/" + MonthDay$ + "/" + Year$
END SUB
REM ******************************************************
REM * Private SUB - Do not call directly *
REM ******************************************************
SUB GetFullDateUK(Now AS When, TempString$)
MonthDay$ = LTRIM$(RTRIM$(STR$(Now.MonthDay MOD 100)))
StringMonth Now.Month, Month$
Year$ = LTRIM$(RTRIM$(STR$(Now.Year MOD 10000)))
TempString$ = MonthDay$ + " " + Month$ + " " + Year$
END SUB
REM ******************************************************
REM * Private SUB - Do not call directly *
REM ******************************************************
SUB GetFullDateUSA(Now AS When, TempString$)
MonthDay$ = LTRIM$(RTRIM$(STR$(Now.MonthDay MOD 100)))
StringMonth Now.Month, Month$
Year$ = LTRIM$(RTRIM$(STR$(Now.Year MOD 10000)))
TempString$ = Month$ + " " + MonthDay$ + " " + Year$
END SUB
REM ******************************************************
REM * Private SUB - Do not call directly *
REM ******************************************************
SUB GetTotalDateUK(Now AS When, TempString$)
StringWeekDay Now.WeekDay, WeekDay$
MonthDay$ = LTRIM$(RTRIM$(STR$(Now.MonthDay MOD 100)))
GetSuffix Now.MonthDay, Suffix$
StringMonth Now.Month, Month$
Year$ = LTRIM$(RTRIM$(STR$(Now.Year MOD 10000)))
TempString$ = WeekDay$ + " " + MonthDay$ + Suffix$ + " " + Month$ + " " + Year$
END SUB
REM ******************************************************
REM * Private SUB - Do not call directly *
REM ******************************************************
SUB GetShortDateUK(Now AS When, TempString$)
MonthDay$ = LTRIM$(RTRIM$(STR$(Now.MonthDay MOD 100)))
GetSuffix Now.MonthDay, Suffix$
StringShortMonth Now.Month, Month$
ShortYear Now.Year, Year$
TempString$ = MonthDay$ + Suffix$ + " " + Month$ + " '" + Year$
END SUB
REM ******************************************************
REM * Private SUB - Do not call directly *
REM ******************************************************
SUB GetTotalShortDateUK(Now AS When, TempString$)
StringShortDay Now.WeekDay, WeekDay$
MonthDay$ = LTRIM$(RTRIM$(STR$(Now.MonthDay MOD 100)))
GetSuffix Now.MonthDay, Suffix$
StringShortMonth Now.Month, Month$
ShortYear Now.Year, Year$
TempString$ = WeekDay$ + " " + MonthDay$ + Suffix$ + " " + Month$ + " '" + Year$
END SUB
REM ******************************************************
REM * Private SUB - Do not call directly *
REM ******************************************************
SUB GetRomanYear(TheYear%, TempString$)
IF TheYear% <> 0 THEN
TempString$ = ""
TempYear% = TheYear%
DO WHILE TempYear% >= 1000
TempString$ = TempString$ + "M"
TempYear% = TempYear% - 1000
LOOP
IF TempYear% >= 900 THEN
TempString$ = TempString$ + "CM"
TempYear% = TempYear% - 900
END IF
DO WHILE TempYear% >= 500
TempString$ = TempString$ + "D"
TempYear% = TempYear% - 500
LOOP
IF TempYear% >= 400 THEN
TempString$ = TempString$ + "CD"
TempYear% = TempYear% - 400
END IF
DO WHILE TempYear% >= 100
TempString$ = TempString$ + "C"
TempYear% = TempYear% - 100
LOOP
IF TempYear% >= 90 THEN
TempString$ = TempString$ + "XC"
TempYear% = TempYear% - 90
END IF
DO WHILE TempYear% >= 50
TempString$ = TempString$ + "L"
TempYear% = TempYear% - 50
LOOP
IF TeYear% >= 40 THEN
TempString$ = TempString$ + "XL"
TempYear% = TempYear% - 40
END IF
DO WHILE TempYear% >= 10
TempString$ = TempString$ + "X"
TempYear% = TempYear% - 10
LOOP
IF TempYear% >= 9 THEN
TempString$ = TempString$ + "IX"
TempYear% = TempYear% - 9
END IF
DO WHILE TempYear% >= 5
TempString$ = TempString$ + "V"
TempYear% = TempYear% - 5
LOOP
IF TempYear% >= 4 THEN
TempString$ = TempString$ + "IV"
TempYear% = TempYear% - 4
END IF
DO WHILE TempYear% > 0
TempString$ = TempString$ + "I"
TempYear% = TempYear% - 1
LOOP
END IF
END SUB
REM ******************************************************
REM * Private SUB - Do not call directly *
REM ******************************************************
SUB GetTemporalString(FormatChar$, Now AS When, TempString$)
SELECT CASE LEFT$(FormatChar$, 1)
CASE "1"
Hours24% = FALSE
CASE "2"
Hours24% = TRUE
CASE "A"
IF Now.Hour > 11 THEN
TempString$ = "pm"
ELSE
TempString$ = "am"
END IF
CASE "B"
StringShortMonth Now.Month, TempString$
CASE "C"
StringMonth Now.Month, TempString$
CASE "D"
GetFullDateUSA Now, TempString$
CASE "E"
GetNumericDateUK Now, TempString$
CASE "F"
GetFullDateUK Now, TempString$
CASE "G"
GetNumericDateUSA Now, TempString$
CASE "H"
GetHour Now.Hour, TempString$
CASE "I"
StringShortDay Now.WeekDay, TempString$
CASE "J"
StringWeekDay Now.WeekDay, TempString$
CASE "K"
GetShortTime Now, TempString$
CASE "L"
GetLongTime Now, TempString$
CASE "M"
GetTwoDigits Now.Minute, TempString$
CASE "N"
TempString$ = LTRIM$(RTRIM$(STR$(Now.WeekDay MOD 10)))
CASE "O"
TempString$ = LTRIM$(RTRIM$(STR$(Now.MonthDay MOD 100)))
CASE "P"
TempString$ = LTRIM$(RTRIM$(STR$(Now.Month MOD 100)))
CASE "Q"
TempString$ = LTRIM$(RTRIM$(STR$(Now.MonthDay MOD 100)))
GetSuffix Now.MonthDay, Suffix$
TempString$ = TempString$ + Suffix$
CASE "R"
GetRomanYear Now.Year, TempString$
CASE "S"
GetTwoDigits Now.Second, TempString$
CASE "T"
GetTotalDateUK Now, TempString$
CASE "U"
ThisInstant Now
CASE "V"
GetShortDateUK Now, TempString$
CASE "W"
TempString$ = LTRIM$(RTRIM$(STR$(Now.YearWeek MOD 100)))
CASE "X"
TempString$ = LTRIM$(RTRIM$(STR$(Now.YearDay MOD 1000)))
CASE "Y"
TempString$ = LTRIM$(RTRIM$(STR$(Now.Year MOD 10000)))
CASE "Z"
ShortYear Now.Year, TempString$
CASE "r"
GetTotalShortDateUK Now, TempString$
CASE "~"
TempString$ = "~"
END SELECT
END SUB
REM ******************************************************************
REM * This routine produces a string (OutputString$) with time and *
REM * date information embedded within it, as specified by the *
REM * information encoded within FormatString$. The variable Now *
REM * may be used to specify a specific time and date or Now may be *
REM * updated as part of this routine so that the current time and *
REM * date are used instead. *
REM * *
REM * If FormatString$ contains no temporal codes it will simply be *
REM * copied to OutputString$. If during processing of *
REM * FormatString$ an invalid code is encountered, processing will *
REM * cease and an immediate return to SYSTEM occurs with an *
REM * appropriate error message displayed. *
REM * *
REM * There are 29 different temporal codes in all, each of which *
REM * starts with the tilde (CHR$(126), '~') character. The action *
REM * of this routine is to copy everything contained in *
REM * FormatString, except the codes, to OutputString. When a code *
REM * is encountered, it is replaced in OutputString by the *
REM * sub-string that corresponds to that code. In the following *
REM * explanation of the codes and their meanings I have, for *
REM * reasons of brevity, used the word output to signify the *
REM * replacement of a particular code by the substring that is *
REM * described immediately following the usage of the word output. *
REM * The codes and their meanings follow hereafter. *
REM * *
REM *----------------------------------------------------------------*
REM * *
REM * ~1 - Set all time output after this to be in 12 hour *
REM * format. *
REM * *
REM * ~2 - Set all time output after this to be in 24 hour *
REM * format. *
REM * *
REM * ~A - Output either am or pm depending on the time. *
REM * *
REM * ~B - Output the month in abbreviated form *
REM * (Jan, Feb etc.). *
REM * *
REM * ~C - Output the full month name *
REM * (January, February etc.). *
REM * *
REM * ~D - Output full date as January 1 1996 etc. *
REM * *
REM * ~E - Output numeric date in dd/mm/yy form. *
REM * *
REM * ~F - Output full date as 1 January 1996 etc. *
REM * *
REM * ~G - Output numeric date in mm/dd/yy form. *
REM * *
REM * ~H - Output the Hour. *
REM * *
REM * ~I - Output the day of the week in abbreviated form. *
REM * (Mon, Tue etc.) *
REM * *
REM * ~J - Output the full name of the day of the week. *
REM * (Monday, Tuesday etc.) *
REM * *
REM * ~K - Output the time in short form HH:MM. *
REM * *
REM * ~L - Output the time in long form HH:MM:SS. *
REM * *
REM * ~M - Output the Minute. *
REM * *
REM * ~N - Output the Numeric day of week (1 = Sunday). *
REM * *
REM * ~O - Output the Numeric day of the month (1, 2, 3 etc). *
REM * *
REM * ~P - Output the Numeric Month (1 = January). *
REM * *
REM * ~Q - Output the Numeric day of the month with the *
REM * appropriate suffix (1st, 2nd, 3rd, 4th etc.). *
REM * *
REM * ~R - Output the year in ROMAN numerals - MCMXCVI. *
REM * *
REM * ~S - Output the Second. *
REM * *
REM * ~T - Output the total date in the form - *
REM * Sunday 18th February 1996. *
REM * *
REM * ~U - Update (or get new) the information in the *
REM * variable 'Now'. *
REM * *
REM * ~V - Output the date in the form - 18th Feb 96. *
REM * *
REM * ~W - Output the week of the year - 1 to 52. *
REM * *
REM * ~X - Output the day of the year - *
REM * 1 to 365 or 366 in leap year. *
REM * *
REM * ~Y - Output the year in the form 1996. *
REM * *
REM * ~Z - Output the year in the form 96. *
REM * *
REM * ~r - Output the total date in the form - *
REM * Sun 18th Feb 96. *
REM * *
REM * ~~ - Output the character ~ (CHR$(126), '~'). *
REM * *
REM *----------------------------------------------------------------*
REM * *
REM * An example of the usage of this routine is as follows:- *
REM * *
REM * FT$ = "~U~1Today, ~T, at precisely ~L~A, I resigned." *
REM * FTString FT$, Out$, Now *
REM * *
REM * Which should result in Out$ containing the following (assuming *
REM * the dates and times contained) :- *
REM * *
REM * Today, Sunday 18th February 1996, at precisely 12:40pm, I *
REM * resigned. *
REM ******************************************************************
SUB FTString(FormatString$, OutputString$, Now AS When)
ValidChars$ = "12ABCDEFGHIJKLMNOPQRSTUVWXYZr~"
IF INSTR(FormatString$, "~") THEN
OutputString$ = ""
FOR Index% = 1 TO LEN(FormatString$)
ch$ = MID$(FormatString$, Index%, 1)
IF ch$ <> "~" THEN
OutputString$ = OutputString$ + ch$
ELSE
Index% = Index% + 1
ch$ = MID$(FormatString$, Index%, 1)
IF INSTR(ValidChars$, ch$) THEN
GetTemporalString ch$, Now, TempString$
IF ch$ <> "U" THEN
OutputString$ = OutputString$ + TempString$
END IF
ELSE
PRINT "Fatal Error in SUB FTString -"
PRINT "Invalid Format character ";ch$;" in "+"";FormatString$
PRINT "Terminating program now!
SYSTEM
END IF
END IF
NEXT
ELSE
OutputString$ = FormatString$
END IF
END SUBNote - the FUNCTION DayOfWeek() is only valid from the year 1900 onwards.
Finally the test BAS file -
TESTTIME.BAS
Code: (Select All)
'$INCLUDE: 'TIME.BI'
DIM Now AS When
ThisInstant Now
CLS
PRINT "Testing ThisInstant"
PRINT
PRINT "It is ";Now.Hour;":";Now.Minute;":";Now.Second
PRINT "On day ";Now.WeekDay;" of week ";Now.YearWeek;" of year ";Now.Year
PRINT "On day ";Now.MonthDay;" of month ";Now.Month", day ";Now.YearDay;
PRINT " of the year"
PRINT Now.Year;" is ";
IF Now.IsLeapYear THEN
PRINT"a leapyear"
ELSE
PRINT"not a leapyear"
END IF
AnyKey
CLS
A$ = "Testing option A - ~A"
B$ = "Testing option B - ~B"
C$ = "Testing option C - ~C"
D$ = "Testing option D - ~D"
E$ = "Testing option E - ~E"
F$ = "Testing option F - ~F"
G$ = "Testing option G - ~G"
H$ = "Testing option H - ~H"
I$ = "Testing option I - ~I"
J$ = "Testing option J - ~J"
K$ = "Testing option K - ~K"
L$ = "Testing option L - ~L"
M$ = "Testing option M - ~M"
N$ = "Testing option N - ~N"
O$ = "Testing option O - ~O"
P$ = "Testing option P - ~P"
Q$ = "Testing option Q - ~Q"
R$ = "Testing option R - ~R"
R2$ = "Testing option r - ~r"
S$ = "Testing option S - ~S"
T$ = "Testing option T - ~T"
V$ = "Testing option V - ~V"
W$ = "Testing option W - ~W"
X$ = "Testing option X - ~X"
Y$ = "Testing option Y - ~Y"
Z$ = "Testing option Z - ~Z"
T1$ = "~1"
T2$ = "~2"
UP$ = "~U"
Start1$ = UP$ + T1$
Start2$ = UP$ + T2$
FTString T2$, Out1$, Now
CLS
FTString A$, Out1$, Now
PRINT Out1$
FTString B$, Out1$, Now
PRINT Out1$
FTString C$, Out1$, Now
PRINT Out1$
FTString D$, Out1$, Now
PRINT Out1$
FTString E$, Out1$, Now
PRINT Out1$
FTString F$, Out1$, Now
PRINT Out1$
FTString G$, Out1$, Now
PRINT Out1$
FTString H$, Out1$, Now
PRINT Out1$
FTString I$, Out1$, Now
PRINT Out1$
FTString J$, Out1$, Now
PRINT Out1$
FTString K$, Out1$, Now
PRINT Out1$
FTString L$, Out1$, Now
PRINT Out1$
FTString M$, Out1$, Now
PRINT Out1$
AnyKey
CLS
FTString N$, Out1$, Now
PRINT Out1$
FTString O$, Out1$, Now
PRINT Out1$
FTString P$, Out1$, Now
PRINT Out1$
FTString Q$, Out1$, Now
PRINT Out1$
FTString R$, Out1$, Now
PRINT Out1$
FTString R2$, Out1$, Now
PRINT Out1$
FTString S$, Out1$, Now
PRINT Out1$
FTString T$, Out1$, Now
PRINT Out1$
FTString V$, Out1$, Now
PRINT Out1$
FTString W$, Out1$, Now
PRINT Out1$
FTString X$, Out1$, Now
PRINT Out1$
FTString Y$, Out1$, Now
PRINT Out1$
FTString Z$, Out1$, Now
PRINT Out1$
AnyKey
CLS
FTString T1$, Out1$, Now
FTString A$, Out1$, Now
PRINT Out1$
FTString B$, Out1$, Now
PRINT Out1$
FTString C$, Out1$, Now
PRINT Out1$
FTString D$, Out1$, Now
PRINT Out1$
FTString E$, Out1$, Now
PRINT Out1$
FTString F$, Out1$, Now
PRINT Out1$
FTString G$, Out1$, Now
PRINT Out1$
FTString H$, Out1$, Now
PRINT Out1$
FTString I$, Out1$, Now
PRINT Out1$
FTString J$, Out1$, Now
PRINT Out1$
FTString K$, Out1$, Now
PRINT Out1$
FTString L$, Out1$, Now
PRINT Out1$
FTString M$, Out1$, Now
PRINT Out1$
AnyKey
CLS
FTString N$, Out1$, Now
PRINT Out1$
FTString O$, Out1$, Now
PRINT Out1$
FTString P$, Out1$, Now
PRINT Out1$
FTString Q$, Out1$, Now
PRINT Out1$
FTString R$, Out1$, Now
PRINT Out1$
FTString R2$, Out1$, Now
PRINT Out1$
FTString S$, Out1$, Now
PRINT Out1$
FTString T$, Out1$, Now
PRINT Out1$
FTString V$, Out1$, Now
PRINT Out1$
FTString W$, Out1$, Now
PRINT Out1$
FTString X$, Out1$, Now
PRINT Out1$
FTString Y$, Out1$, Now
PRINT Out1$
FTString Z$, Out1$, Now
PRINT Out1$
AnyKey
CLS
FTString Start2$, Out1$, Now
FTString A$, Out1$, Now
PRINT Out1$
FTString B$, Out1$, Now
PRINT Out1$
FTString C$, Out1$, Now
PRINT Out1$
FTString D$, Out1$, Now
PRINT Out1$
FTString E$, Out1$, Now
PRINT Out1$
FTString F$, Out1$, Now
PRINT Out1$
FTString G$, Out1$, Now
PRINT Out1$
FTString H$, Out1$, Now
PRINT Out1$
FTString I$, Out1$, Now
PRINT Out1$
FTString J$, Out1$, Now
PRINT Out1$
FTString K$, Out1$, Now
PRINT Out1$
FTString L$, Out1$, Now
PRINT Out1$
FTString M$, Out1$, Now
PRINT Out1$
AnyKey
CLS
FTString N$, Out1$, Now
PRINT Out1$
FTString O$, Out1$, Now
PRINT Out1$
FTString P$, Out1$, Now
PRINT Out1$
FTString Q$, Out1$, Now
PRINT Out1$
FTString R$, Out1$, Now
PRINT Out1$
FTString R2$, Out1$, Now
PRINT Out1$
FTString S$, Out1$, Now
PRINT Out1$
FTString T$, Out1$, Now
PRINT Out1$
FTString V$, Out1$, Now
PRINT Out1$
FTString W$, Out1$, Now
PRINT Out1$
FTString X$, Out1$, Now
PRINT Out1$
FTString Y$, Out1$, Now
PRINT Out1$
FTString Z$, Out1$, Now
PRINT Out1$
AnyKey
CLS
FTString Start1$, Out1$, Now
FTString A$, Out1$, Now
PRINT Out1$
FTString B$, Out1$, Now
PRINT Out1$
FTString C$, Out1$, Now
PRINT Out1$
FTString D$, Out1$, Now
PRINT Out1$
FTString E$, Out1$, Now
PRINT Out1$
FTString F$, Out1$, Now
PRINT Out1$
FTString G$, Out1$, Now
PRINT Out1$
FTString H$, Out1$, Now
PRINT Out1$
FTString I$, Out1$, Now
PRINT Out1$
FTString J$, Out1$, Now
PRINT Out1$
FTString K$, Out1$, Now
PRINT Out1$
FTString L$, Out1$, Now
PRINT Out1$
FTString M$, Out1$, Now
PRINT Out1$
AnyKey
CLS
FTString N$, Out1$, Now
PRINT Out1$
FTString O$, Out1$, Now
PRINT Out1$
FTString P$, Out1$, Now
PRINT Out1$
FTString Q$, Out1$, Now
PRINT Out1$
FTString R$, Out1$, Now
PRINT Out1$
FTString R2$, Out1$, Now
PRINT Out1$
FTString S$, Out1$, Now
PRINT Out1$
FTString T$, Out1$, Now
PRINT Out1$
FTString V$, Out1$, Now
PRINT Out1$
FTString W$, Out1$, Now
PRINT Out1$
FTString X$, Out1$, Now
PRINT Out1$
FTString Y$, Out1$, Now
PRINT Out1$
FTString Z$, Out1$, Now
PRINT Out1$
AnyKey
END
SUB AnyKey
DO
QQ$ = INKEY$
LOOP UNTIL QQ$ <> ""
END SUB
'$INCLUDE: 'TIME.BM'TR
RE: Time - Not a Library - TarotRedhand - 05-18-2022
In case anyone is thinking of grabbing bits for use in their own code, I would say that there are probably only 3 routines that really have a use outside of the package. So to save you time I have copied them out and pasted them below -
Code: (Select All)
FUNCTION DayOfWeek(Year$, Month%, Day%)
DIM Year%, Code%
Year% = VAL(Year$)
Code% = VAL(RIGHT$(YEAR$, 2))
Code% = (Code% + (Code% \ 4)) Mod 7
Code% = Code% + VAL(MID$("033614625035", Month%, 1))
IF (YEAR% >= 2000) THEN
Code% = Code% + 6
END IF
IF (((Year% MOD 400) = 0) AND (Month% > 2))THEN
Code% = Code% + 1
ELSEIF (((Year% MOD 4) = 0) AND ((Year% MOD 100) <> 0) AND (Month% > 2)) THEN
Code% = Code% + 1
END IF
Code% = Code% + Day%
DayOfWeek = 1 + (Code% MOD 7)
END FUNCTION
SUB GetDate(Year%, Month%, Day%, WeekDay%)
DIM TempDate$
TempDate$ = DATE$
Year% = VAL(RIGHT$(TempDate$, 4))
Month% = VAL(LEFT$(TempDate$, 2))
Day% = VAL(MID$(TempDate$, 4, 2))
WeekDay% = DayOfWeek(LTRIM$(STR$(Year%)), Month%, Day%)
END SUBand
Code: (Select All)
SUB GetTime(Hours%, Minutes%, Seconds%)
DIM AllSeconds AS LONG
AllSeconds = TIMER
Hours% = AllSeconds \ 3600
AllSeconds = AllSeconds MOD 3600
Minutes% = AllSeconds \ 60
Seconds% = AllSeconds MOD 60
END SUBenjoy.
TR