[Back to DATETIME SWAG index] [Back to Main SWAG index] [Original]
unit Dates;
{Gives time and date passed in DateTime format (defined by the DOS unit)
as a fully formatted string. DFormat is a word type variable that tells
the code how to handle the time and date:
Bit Function: If 0: If 1:
--- -------------------- -------------------- --------------------
15 ShowDOW Don't show day name Show day name
14 Century Show year as XX Show year as XXXX
13 SpaceDate No spaces in date Space between fields
12 CommaSep Use comma in date don't use comma
11 MonthType Numerical English name
10 > DateOrder | 00 -- DDMMYY | 10 -- YYMMDD
9 > | 01 -- MMDDYY | 11 -- YYDDMM
8 MonthName 3 letters only Full name of month
7 DateSep Space date with " " Space date with "-"
6 DTOrder time then date date then time
5 > TDSpace 00 - 11 : 1 - 4 spaces, respectively
4 >
3 HourPad Use needed spaces Always uses 2 spaces
2 HPadMeth Pad hour with " " Pad hour with "0"
1 MSPadMeth Pad min/sec with " " Pad min/sec with "0"
0 Show12_24 Use 12 hr. & am/pm 24-hour (military)
Some fields require others to be set/clear to have any affect. I never
got around to defining any constants for the fields, but that's easy
enough to take care of in the interface section, if needed.
Use freely in any venture, private or public, but if you use it in anything
that makes money, please at the very least, let me the author of this unit,
know about it! :-)
Standard disclaimers apply.
Written (and Submitted) by Scott Earnest, some time in 1994
e-mail (Internet): scott@whiplash.pc.cc.cmu.edu
}
interface
uses DOS;
var
lastdate : string;
function DateTimeString (Chron : DateTime; DFormat : word) : string;
implementation
const
Month3 : array [1 .. 12] of string[3] =
('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
MonthF : array [1 .. 12] of string [6] =
('uary', 'ruary', 'ch', 'il', '', 'e',
'y', 'ust', 'tember', 'ober', 'ember', 'ember');
DayName : array [0 .. 6] of string[9] =
('Sunday', 'Monday', 'Tuesday', 'Wednesday',
'Thursday', 'Friday', 'Saturday');
PadSpace = ' ';
PadDash = '-';
PadZero = '0';
type
TDateTimeFormat = record
ShowDOW,
Century,
SpaceDate,
CommaSep,
MonthType,
MonthName,
DateSep,
DTOrder,
HourPad,
HPadMeth,
MSPadMeth,
Show12_24 : boolean;
DateOrder,
TDSpace : byte;
end;
var
df : TDateTimeFormat;
procedure SetFlags_df (fvar : word);
procedure shiftr;
begin
fvar := fvar shr 1;
end;
begin
df.DateOrder := (fvar and $0600) shr 9;
df.TDSpace := (fvar and $0030) shr 4;
df.Show12_24 := odd (fvar); shiftr;
df.MSPadMeth := odd (fvar); shiftr;
df.HPadMeth := odd (fvar); shiftr;
df.HourPad := odd (fvar); shiftr;
shiftr; shiftr;
df.DTOrder := odd (fvar); shiftr;
df.DateSep := odd (fvar); shiftr;
df.MonthName := odd (fvar); shiftr;
shiftr; shiftr;
df.MonthType := odd (fvar); shiftr;
df.CommaSep := odd (fvar); shiftr;
df.SpaceDate := odd (fvar); shiftr;
df.Century := odd (fvar); shiftr;
df.ShowDow := odd (fvar); shiftr;
end;
function CalcDOW (d, m, y : word) : byte;
var
t1, t2, t3, t4, t5, t6, t7 : integer;
begin
t1 := m + 12 * trunc (0.6 + 1 / m);
t2 := y - trunc (0.6 + 1 / m);
t3 := trunc (13 * (t1 + 1) / 5);
t4 := trunc (5 * t2 / 4);
t5 := trunc (t2 / 100);
t6 := trunc (t2 / 400);
t7 := t3 + t4 - t5 + t6 + d - 1;
CalcDOW := t7 - 7 * trunc (t7 / 7);
end;
function PadNum (num : word; padch : char; places : byte) : string;
var
holdstr,
padstr : string;
begin
fillchar (padstr, sizeof(padstr), padch);
padstr[0] := #16;
str (num, holdstr);
padstr := concat (padstr, holdstr);
delete (padstr, 1, length (padstr) - places);
PadNum := padstr;
end;
procedure BuildTime (var dt : DateTime; var ts : string);
var
pad : char;
tempstr : string;
hour : byte;
begin
case df.MSPadMeth of
true : pad := PadZero;
false : pad := PadSpace;
end;
ts := concat (':', PadNum (dt.min, pad, 2), ':', PadNum (dt.sec, pad, 2));
case df.Show12_24 of
true : hour := dt.hour;
false : begin
hour := dt.hour mod 12;
if hour = 0 then hour := 12;
case dt.hour of
0 .. 11 : ts := concat (ts, 'a');
12 .. 23 : ts := concat (ts, 'p');
end;
end;
end;
case df.HourPad of
true : begin
case df.HPadMeth of
true : pad := PadZero;
false : pad := PadSpace;
end;
ts := concat (PadNum (hour, pad, 2), ts);
end;
false : begin
str (hour, tempstr);
ts := concat (tempstr, ts);
end;
end;
end;
procedure BuildDate (var dt : DateTime; var ds : string);
var
DOW : byte;
tempstr : string;
pad : string[1];
ystr, dstr : string[4];
mstr : string[9];
begin
if df.ShowDOW then
DOW := CalcDOW (dt.day, dt.month, dt.year);
ystr := PadNum (dt.year, ' ', (byte(df.Century) + 1) * 2);
case df.MonthType of
false : case df.SpaceDate of
false : mstr := PadNum (dt.month, '0', 2);
true : str (dt.month, mstr);
end;
true : begin
mstr := Month3[dt.month];
if df.MonthName then
mstr := concat (mstr, MonthF[dt.month]);
end;
end;
case df.SpaceDate of
false : dstr := PadNum (dt.day, '0', 2);
true : str (dt.day, dstr);
end;
case df.SpaceDate of
false : begin
case df.DateOrder of
0 : ds := concat (dstr, mstr, ystr);
1 : ds := concat (mstr, dstr, ystr);
2 : ds := concat (ystr, mstr, dstr);
3 : ds := concat (ystr, dstr, mstr);
end;
end;
true : begin
case df.DateSep of
false : pad := PadSpace;
true : pad := PadDash;
end;
case df.DateOrder of
0 : ds := concat (dstr, pad, mstr, pad, ystr);
1 : case df.CommaSep of
false : ds := concat (mstr, pad, dstr, pad, ystr);
true : ds := concat (mstr, pad, dstr, ',', pad, ystr);
end;
2 : ds := concat (ystr, pad, mstr, pad, dstr);
3 : ds := concat (ystr, pad, dstr, pad, mstr);
end;
end;
end;
if df.ShowDOW then
ds := concat (DayName[DOW], ' ', ds);
end;
function spaces (ns : byte) : string;
var
holdstr : string;
begin
fillchar (holdstr, sizeof(holdstr), 32);
holdstr[0] := chr(ns);
spaces := holdstr;
end;
function DateTimeString (Chron : DateTime; DFormat : word) : string;
var
dstr, tstr : string;
begin
dstr := ''; tstr := '';
SetFlags_df (DFormat);
BuildTime (Chron, tstr);
BuildDate (Chron, dstr);
case df.DTOrder of
false : DateTimeString := concat (tstr, spaces(df.TDSpace + 1), dstr);
true : DateTimeString := concat (dstr, spaces(df.TDSpace + 1), tstr);
end;
end;
begin
lastdate := '';
end.
[Back to DATETIME SWAG index] [Back to Main SWAG index] [Original]