HomePage   Delphi Library  

Unit ads_date;

{Copyright(c)1998 Advanced Delphi Systems

 Richard Maley
 Advanced Delphi Systems
 12613 Maidens Bower Drive
 Potomac, MD 20854 USA
 phone 301-840-1554
 [email protected]
 [email protected]
 [email protected]}

Interface

Uses
  SysUtils, StdCtrls, Dialogs, Forms, ExtCtrls,
  Messages, WinProcs, WinTypes, Buttons, Classes,
  DB, DBTables, Controls, Grids, UtilKeys, IniFiles, Graphics,
  ShellAPI, FileCtrl, Ads_Misc, wininet {$IFNDEF WIN32}, ToolHelp{$ENDIF};

{!~ Returns The Number Of Days In The Month}
Function Date_DaysInMonth(DateValue: TDateTime): Integer;

{Returns The First Day Of Last Week, i.e., Sunday, As A TDateTime.  If an
error occurs then zero is returned.}
Function Date_FirstDayOfLastWeek(DateValue: TDateTime): TDateTime;

{!~ Returns The First Day Of The Month}
Function Date_FirstDayOfNextMonth(DateValue: TDateTime): TDateTime;

{Returns The First Day Of next Week, i.e., Sunday, As A TDateTime.  If an
error occurs then zero is returned.}
Function Date_FirstDayOfNextWeek(DateValue: TDateTime): TDateTime;

{Returns The First Day Of the Week, i.e., Sunday, As A TDateTime.  If an
error occurs then zero is returned.}
Function Date_FirstDayOfWeek(DateValue: TDateTime): TDateTime;

{!~ Returns The Last Day Of The Month}
Function Date_LastDayOfMonth(DateValue: TDateTime): TDateTime;

{!~ Returns The Month as an integer when a TDateTime value
is passed as an argument}
Function Date_Month(DateValue: TDateTime): Integer;

{!~ Returns The Next Month}
Function Date_MonthNext(DateValue: TDateTime): Integer;

{!~ Returns The Prior Month}
Function Date_MonthPrior(DateValue: TDateTime): Integer;

{Returns A Date N Days Different Than
The Input Date}
Function Date_MoveNDays(
  DateValue    : TDateTime;
  DateMovement : Integer): TDateTime;

{Returns The Next Day As A TDateTime}
Function Date_NextDay(DateValue: TDateTime): TDateTime;

{!~ Returns The Next Week As A TDateTime}
Function Date_NextWeek(DateValue: TDateTime): TDateTime;

{Returns The Prior Day As A TDateTime}
Function Date_PriorDay(DateValue: TDateTime): TDateTime;

{Returns The Prior Week As A TDateTime}
Function Date_PriorWeek(DateValue: TDateTime): TDateTime;

{!~ Returns True if DateString is a valid date,
False otherwise.}
Function IsDate(DateString: String): Boolean;

{Returns a time delta in minutes}
Function TimeDeltaInMinutes(
           StartDate : TDateTime;
           EndDate   : TDateTime): Double;

{Returns a time delta in seconds}
Function TimeDeltaInSeconds(
           StartDate : TDateTime;
           EndDate   : TDateTime): Double;

{Returns a time delta in Milliseconds}
Function TimeDeltaInMSeconds(
           StartDate : TDateTime;
           EndDate   : TDateTime): Double;

{!~ Returns Today's Date As A String}
Function Today: String;

Implementation

{Returns The First Day Of Last Week, i.e., Sunday, As A TDateTime.  If an
error occurs then zero is returned.}
Function Date_FirstDayOfLastWeek(DateValue: TDateTime): TDateTime;
Begin
  Result := Date_FirstDayOfWeek(DateValue-7);
End;

{!~ Returns The First Day Of The Month}
Function Date_FirstDayOfNextMonth(DateValue: TDateTime): TDateTime;
Begin
  Try
    Result  := Date_LastDayOfMonth(DateValue)+1;
  Except
    Result  := DateValue;
  End;
End;
{!~
The following example sets the variable FirstDayNextMonth to
the appropriate TDateTime value associated with DateValue.

Procedure SetFirstDayNextMonth(Var FirstDayNextMonth, DateValue : TDateTime);
Begin
  FirstDayNextMonth := Date_FirstDayOfNextMonth(DateValue);
End;

}

{Returns The First Day Of next Week, i.e., Sunday, As A TDateTime.  If an
error occurs then zero is returned.}
Function Date_FirstDayOfNextWeek(DateValue: TDateTime): TDateTime;
Begin
  Result := Date_FirstDayOfWeek(DateValue+7);
End;

{Returns The First Day Of the Week, i.e., Sunday, As A TDateTime.  If an
error occurs then zero is returned.}
Function Date_FirstDayOfWeek(DateValue: TDateTime): TDateTime;
Begin
  Try
    Result := DateValue - (DayOfWeek(DateValue)) +1;
  Except
    Result := 0;
  End;
End;

{!~ Returns The Last Day Of The Month}
Function Date_LastDayOfMonth(DateValue: TDateTime): TDateTime;
Var
  LastDay : String;
Begin
{  Result  := DateValue;}{zzz}
  LastDay := IntToStr(Date_DaysInMonth(DateValue));
  Result  := StrToDate(
               FormatDateTime('mm',DateValue)+
               '/'+
               LastDay+
               '/'+
               FormatDateTime('yyyy',DateValue));
End;
{!~
The following example sets the variable LastDayOfMonth to
the appropriate TDateTime value associated with DateValue.

Procedure SetLastDayOfMonth(Var LastDayOfMonth, DateValue : TDateTime);
Begin
  LastDayOfMonth := Date_LastDayOfMonth(DateValue);
End;

}

{!~ Returns The Month as an integer when a TDateTime value
is passed as an argument}
Function Date_Month(DateValue: TDateTime): Integer;
Var
  Year, Month, Day: Word;
Begin
  Result := -1;
  Try
    DecodeDate(DateValue, Year, Month, Day);
    Result := Integer(Month);
  Except
    Result := -1;
  End;
End;
{!~
The following example returns the month as an integer for
1000 days from now.

Date_Month(now()+1000);
}

{!~ Returns The Next Month}
Function Date_MonthNext(DateValue: TDateTime): Integer;
Var
  Year, Month, Day: Word;
  CurMonth   : Integer;
  NewMonth  : Integer;
Begin
  Result := -1;
  Try
    DecodeDate(DateValue, Year, Month, Day);
    CurMonth := Integer(Month);
    NewMonth := ((CurMonth + 12 + 1) mod 12);
    If NewMonth = 0 Then NewMonth := 12;
    Result := NewMonth;
  Except
    Result := -1;
  End;
End;
{!~
The following example returns the next month as an integer for
1000 days from now.

Date_MonthNext(now()+1000);
}

{!~ Returns The Prior Month}
Function Date_MonthPrior(DateValue: TDateTime): Integer;
Var
  Year, Month, Day: Word;
  CurMonth   : Integer;
  NewMonth  : Integer;
Begin
  Result := -1;
  Try
    DecodeDate(DateValue, Year, Month, Day);
    CurMonth := Integer(Month);
    NewMonth := ((CurMonth + 24 - 1) mod 12);
    If NewMonth = 0 Then NewMonth := 12;
    Result := NewMonth;
  Except
    Result := -1;
  End;
End;
{!~
The following example returns the prior month as an integer for
1000 days from now.

Date_MonthPrior(now()+1000);
}

{Returns A Date N Days Different Than
The Input Date}
Function Date_MoveNDays(
  DateValue    : TDateTime;
  DateMovement : Integer): TDateTime;
Begin
  Result := DateValue + DateMovement;
End;
{!~
The following example returns the date as a TDateTime for
1000 days from now.

Date_MoveNDays(now()+1000);
}

{Returns The Next Day As A TDateTime}
Function Date_NextDay(DateValue: TDateTime): TDateTime;
Begin
  Result := Date_MoveNDays(DateValue,1);
End;
{!~
The following example returns the next day after
1000 days from now.

Date_NextDay(now()+1000);
}

{Returns The Prior Day As A TDateTime}
Function Date_PriorDay(DateValue: TDateTime): TDateTime;
Begin
  Result := Date_MoveNDays(DateValue,-1);
End;
{!~
The following example returns the prior day after
1000 days from now.

Date_PriorDay(now()+1000);
}

{Returns The Prior Week As A TDateTime}
Function Date_PriorWeek(DateValue: TDateTime): TDateTime;
Begin
  Result := Date_MoveNDays(DateValue,-7);
End;
{!~
The following example returns the date that
is one week prior to 1000 days from now.

Date_PriorWeek(now()+1000);
}

{!~ Returns True if DateString is a valid date,
False otherwise.}
Function IsDate(DateString: String): Boolean;
Begin
  Try
    StrToDateTime(DateString);
    Result := True;
  Except
    Result := False;
  End;
End;

{Returns a time delta in minutes}
Function TimeDeltaInMinutes(
           StartDate : TDateTime;
           EndDate   : TDateTime): Double;
Var
  Hour  : Word;
  Min   : Word;
  Sec   : Word;
  MSec  : Word;
  Delta : TDateTime;
Begin
  Try
    Delta := EndDate - StartDate;
    DecodeTime(Delta, Hour, Min, Sec, MSec);
    Result := (Hour*60)+Min;
  Except
    Result := 0;
  End;
End;

{Returns a time delta in seconds}
Function TimeDeltaInSeconds(
           StartDate : TDateTime;
           EndDate   : TDateTime): Double;
Var
  Hour  : Word;
  Min   : Word;
  Sec   : Word;
  MSec  : Word;
  Delta : TDateTime;
Begin
  Try
    Delta := EndDate - StartDate;
    DecodeTime(Delta, Hour, Min, Sec, MSec);
    Result := (((Hour*60)+Min)*60)+Sec;
  Except
    Result := 0;
  End;
End;

{!~ Returns Today's Date As A String}
Function Today: String;
Begin
  Result := FormatDateTime('m/d/yy',now);
End;

{!~ Returns The Number Of Days In The Month}
Function Date_DaysInMonth(DateValue: TDateTime): Integer;
var
  YearIn    : Word;
  MonthIn   : Word;
  DayIn     : Word;
  YearNew   : Word;
  MonthNew  : Word;
  DayNew    : Word;
  Counter   : Integer;
  NewDate   : TDateTime;
Begin
  Result := 30;
  Try
    DecodeDate(DateValue, YearIn, MonthIn, DayIn);
    NewDate := EncodeDate(YearIn, MonthIn, 26);

    For Counter := 26 To 32 Do
    Begin
      NewDate := NewDate+1;
      DecodeDate(NewDate, YearNew, MonthNew, DayNew);
      If MonthNew <> MonthIn Then
      Begin
        DecodeDate(NewDate-1, YearNew, MonthNew, DayNew);
        Result := DayNew;
        Break;
      End;
    End;
  Except
  End;
End;

{Returns The Next Week As A TDateTime}
Function Date_NextWeek(DateValue: TDateTime): TDateTime;
Begin
  Result := Date_MoveNDays(DateValue,7);
End;

{Returns a time delta in Milliseconds}
Function TimeDeltaInMSeconds(
           StartDate : TDateTime;
           EndDate   : TDateTime): Double;
Var
  Hour  : Word;
  Min   : Word;
  Sec   : Word;
  MSec  : Word;
  Delta : TDateTime;
Begin
{  Result := 0;}{zzz}
  Try
    Delta := EndDate - StartDate;
    DecodeTime(Delta, Hour, Min, Sec, MSec);
    Result := (((((Hour*60)+Min)*60)+Sec)*1000)+MSec;
  Except
    Result := 0;
  End;
End;

Initialization
  DelphiChecker(
    RunOutsideIDE_ads,
    'Advanced Delphi Systems Code',
    RunOutsideIDECompany_ads,
    RunOutsideIDEPhone_ads,
    RunOutsideIDEDate_ads);
End.