home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
drdobbs
/
1991
/
01
/
struc_p.asc
< prev
next >
Wrap
Text File
|
1990-12-07
|
12KB
|
376 lines
_STRUCTURED PROGRAMMING COLUMN_
by Jeff Duntemann
[LISTING ONE]
{---------------------------------------------------}
{ WHEN2.PAS }
{ A time-and-date stamp object for Turbo Pascal 6.0 }
{ by Jeff Duntemann }
{ From DDJ for Jan. 1991 }
{ NOTE: This unit should be good until December 31, }
{ 2043, when the long integer time/date stamp turns }
{ negative. }
{---------------------------------------------------}
UNIT When2;
INTERFACE
USES DOS;
TYPE
String9 = STRING[9];
String20 = STRING[20];
String50 = STRING[50];
When =
OBJECT
FUNCTION GetWhenStamp : LongInt; { Returns 32-bit time/date stamp }
FUNCTION GetTimeStamp : Word; { Returns DOS-format time stamp }
FUNCTION GetDateStamp : Word; { Returns DOS-format date dtamp }
FUNCTION GetYear : Word;
FUNCTION GetMonth : Word;
FUNCTION GetDay : Word;
FUNCTION GetDayOfWeek : Integer; { 0=Sunday; 1=Monday, etc. }
FUNCTION GetHours : Word;
FUNCTION GetMinutes : Word;
FUNCTION GetSeconds : Word;
PROCEDURE PutNow;
PROCEDURE PutWhenStamp(NewWhen : LongInt);
PROCEDURE PutTimeStamp(NewStamp : Word);
PROCEDURE PutDateStamp(NewStamp : Word);
PROCEDURE PutNewDate(NewYear,NewMonth,NewDay : Word);
PROCEDURE PutNewTime(NewHours,NewMinutes,NewSeconds : Word);
PRIVATE
WhenStamp : LongInt; { Combined time/date stamp }
TimeString : String9; { i.e., "12:45a" }
Hours,Minutes,Seconds : Word; { Seconds is always even! }
DateString : String20; { i.e., "06/29/89" }
LongDateString : String50; { i.e., "Thursday, June 29, 1989" }
Year,Month,Day : Word;
DayOfWeek : Integer; { 0=Sunday, 1=Monday, etc. }
FUNCTION CalcTimeStamp : Word;
FUNCTION CalcDateStamp : Word;
FUNCTION CalcDayOfWeek : Integer; { via Zeller's Congruence }
PROCEDURE CalcTimeString;
PROCEDURE CalcDateString;
PROCEDURE CalcLongDateString;
END;
IMPLEMENTATION
{ Keep in mind that all this stuff is PRIVATE to the unit! }
CONST
MonthTags : ARRAY [1..12] of String9 =
('January','February','March','April','May','June','July',
'August','September','October','November','December');
DayTags : ARRAY [0..6] OF String9 =
('Sunday','Monday','Tuesday','Wednesday',
'Thursday','Friday','Saturday');
TYPE
WhenUnion =
RECORD
TimePart : Word;
DatePart : Word;
END;
VAR
Temp1 : String50;
Dummy : Word;
{***********************************************}
{ PRIVATE method implementations for type When: }
{***********************************************}
FUNCTION When.CalcTimeStamp : Word;
BEGIN
CalcTimeStamp := (Hours SHL 11) OR (Minutes SHL 5) OR (Seconds SHR 1);
END;
FUNCTION When.CalcDateStamp : Word;
BEGIN
CalcDateStamp := ((Year - 1980) SHL 9) OR (Month SHL 5) OR Day;
END;
PROCEDURE When.CalcTimeString;
VAR
Temp1,Temp2 : String9;
AMPM : Char;
I : Integer;
BEGIN
I := Hours;
IF Hours = 0 THEN I := 12; { "0" hours = 12am }
IF Hours > 12 THEN I := Hours - 12;
IF Hours > 11 THEN AMPM := 'p' ELSE AMPM := 'a';
Str(I:2,Temp1); Str(Minutes,Temp2);
IF Length(Temp2) < 2 THEN Temp2 := '0' + Temp2;
TimeString := Temp1 + ':' + Temp2 + AMPM;
END;
PROCEDURE When.CalcDateString;
BEGIN
Str(Month,DateString);
Str(Day,Temp1);
DateString := DateString + '/' + Temp1;
Str(Year,Temp1);
DateString := DateString + '/' + Copy(Temp1,3,2);
END;
PROCEDURE When.CalcLongDateString;
VAR
Temp1 : String9;
BEGIN
LongDateString := DayTags[DayOfWeek] + ', ';
Str(Day,Temp1);
LongDateString := LongDateString +
MonthTags[Month] + ' ' + Temp1 + ', ';
Str(Year,Temp1);
LongDateString := LongDateString + Temp1;
END;
FUNCTION When.CalcDayOfWeek : Integer;
VAR
Century,Holder : Integer;
FUNCTION Modulus(X,Y : Integer) : Integer;
VAR
R : Real;
BEGIN
R := X/Y;
IF R < 0 THEN
Modulus := X-(Y*Trunc(R-1))
ELSE
Modulus := X-(Y*Trunc(R));
END;
BEGIN
{ First test for error conditions on input values: }
IF (Year < 0) OR
(Month < 1) OR (Month > 12) OR
(Day < 1) OR (Day > 31) THEN
CalcDayOfWeek := -1 { Return -1 to indicate an error }
ELSE
{ Do the Zeller's Congruence calculation as Zeller himself }
{ described it in "Acta Mathematica" #7, Stockhold, 1887. }
BEGIN
{ First we separate out the year and the century figures: }
Century := Year DIV 100;
Year := Year MOD 100;
{ Next we adjust the month such that March remains month #3, }
{ but that January and February are months #13 and #14, }
{ *but of the previous year*: }
IF Month < 3 THEN
BEGIN
Inc(Month,12);
IF Year > 0 THEN Dec(Year,1) { The year before 2000 is }
ELSE { 1999, not 20-1... }
BEGIN
Year := 99;
Dec(Century);
END
END;
{ Here's Zeller's seminal black magic: }
Holder := Day; { Start with the day of month }
Holder := Holder + (((Month+1) * 26) DIV 10); { Calc the increment }
Holder := Holder + Year; { Add in the year }
Holder := Holder + (Year DIV 4); { Correct for leap years }
Holder := Holder + (Century DIV 4); { Correct for century years }
Holder := Holder - Century - Century; { DON'T KNOW WHY HE DID THIS! }
Holder := Modulus(Holder,7); { Take Holder modulus 7 }
{ Here we "wrap" Saturday around to be the last day: }
IF Holder = 0 THEN Holder := 7;
{ Zeller kept the Sunday = 1 origin; computer weenies prefer to }
{ start everything with 0, so here's a 20th century kludge: }
Dec(Holder);
CalcDayOfWeek := Holder; { Return the end product! }
END;
END;
{**********************************************}
{ PUBLIC method implementations for type When: }
{**********************************************}
FUNCTION When.GetWhenStamp : LongInt;
BEGIN
GetWhenStamp := WhenStamp;
END;
FUNCTION When.GetTimeStamp : Word;
BEGIN
GetTimeStamp := WhenUnion(WhenStamp).TimePart;
END;
FUNCTION When.GetDateStamp : Word;
BEGIN
GetDateStamp := WhenUnion(WhenStamp).DatePart;
END;
FUNCTION When.GetYear : Word;
BEGIN
GetYear := Year;
END;
FUNCTION When.GetMonth : Word;
BEGIN
GetMonth := Month;
END;
FUNCTION When.GetDay : Word;
BEGIN
GetDay := Day;
END;
FUNCTION When.GetDayOfWeek : Integer;
BEGIN
GetDayOfWeek := DayOfWeek;
END;
FUNCTION When.GetHours : Word;
BEGIN
GetHours := Hours;
END;
FUNCTION When.GetMinutes : Word;
BEGIN
GetMinutes := Minutes;
END;
FUNCTION When.GetSeconds : Word;
BEGIN
GetSeconds := Seconds;
END;
{---------------------------------------------------------------------}
{ To fill a When record with the current time and date as maintained }
{ by the system clock, execute this method: }
{---------------------------------------------------------------------}
PROCEDURE When.PutNow;
BEGIN
{ Get current clock time. Note that we ignore hundredths figure: }
GetTime(Hours,Minutes,Seconds,Dummy);
{ Calculate a new time stamp and update object fields: }
PutTimeStamp(CalcTimeStamp);
GetDate(Year,Month,Day,Dummy); { Get current clock date }
{ Calculate a new date stamp and update object fields: }
PutDateStamp(CalcDateStamp);
END;
{---------------------------------------------------------------------}
{ This method allows us to apply a whole long integer time/date stamp }
{ such as that returned by the DOS unit's GetFTime procedure to the }
{ When object. The object divides the stamp into time and date }
{ portions and recalculates all other fields in the object. }
{---------------------------------------------------------------------}
PROCEDURE When.PutWhenStamp(NewWhen : LongInt);
BEGIN
WhenStamp := NewWhen;
{ We've actually updated the stamp proper, but we use the two }
{ "put" routines for time and date to generate the individual }
{ field and string representation forms of the time and date. }
{ I know that the "put" routines also update the long integer }
{ stamp, but while unnecessary it does no harm. }
PutTimeStamp(WhenUnion(WhenStamp).TimePart);
PutDateStamp(WhenUnion(WhenStamp).DatePart);
END;
{---------------------------------------------------------------------}
{ We can choose to update only the time stamp, and the object will }
{ recalculate only its time-related fields. }
{---------------------------------------------------------------------}
PROCEDURE When.PutTimeStamp(NewStamp : Word);
BEGIN
WhenUnion(WhenStamp).TimePart := NewStamp;
{ The time stamp is actually a bitfield, and all this shifting left }
{ and right is just extracting the individual fields from the stamp:}
Hours := NewStamp SHR 11;
Minutes := (NewStamp SHR 5) AND $003F;
Seconds := (NewStamp SHL 1) AND $001F;
{ Derive a string version of the time: }
CalcTimeString;
END;
{---------------------------------------------------------------------}
{ Or, we can choose to update only the date stamp, and the object }
{ will then recalculate only its date-related fields. }
{---------------------------------------------------------------------}
PROCEDURE When.PutDateStamp(NewStamp : Word);
BEGIN
WhenUnion(WhenStamp).DatePart := NewStamp;
{ Again, the date stamp is a bit field and we shift the values out }
{ of it: }
Year := (NewStamp SHR 9) + 1980;
Month := (NewStamp SHR 5) AND $000F;
Day := NewStamp AND $001F;
{ Calculate the day of the week value using Zeller's Congruence: }
DayOfWeek := CalcDayOfWeek;
{ Calculate the short string version of the date; as in "06/29/89": }
CalcDateString;
{ Calculate a long version, as in "Thursday, June 29, 1989": }
CalcLongDateString;
END;
PROCEDURE When.PutNewDate(NewYear,NewMonth,NewDay : Word);
BEGIN
{ The "boss" field is the date stamp. Everything else is figured }
{ from the stamp, so first generate a new date stamp, and then }
{ (odd as it may seem) regenerate everything else, *including* }
{ the Year, Month, and Day fields: }
PutDateStamp(CalcDateStamp);
{ Calculate the short string version of the date; as in "06/29/89": }
CalcDateString;
{ Calculate a long version, as in "Thursday, June 29, 1989": }
CalcLongDateString;
END;
PROCEDURE When.PutNewTime(NewHours,NewMinutes,NewSeconds : Word);
BEGIN
{ The "boss" field is the time stamp. Everything else is figured }
{ from the stamp, so first generate a new time stamp, and then }
{ (odd as it may seem) regenerate everything else, *including* }
{ the Hours, Minutes, and Seconds fields: }
PutTimeStamp(CalcTimeStamp);
{ Derive the string version of the time: }
CalcTimeString;
END;
END.