Bu unit program tarih işleminde kullanılır.
Kod: Tümünü seç
Unit ads_date;
Interface
Uses
SysUtils;
{!~ 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
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
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
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
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;
Begin
Result := 30;
Try
DateValue := Date_FirstDayOfNextMonth(DateValue)-1;
DecodeDate(DateValue, YearIn, MonthIn, DayIn);
Result := DayIn;
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
Try
Delta := EndDate - StartDate;
DecodeTime(Delta, Hour, Min, Sec, MSec);
Result := (((((Hour*60)+Min)*60)+Sec)*1000)+MSec;
Except
Result := 0;
End;
End;
End.