[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]