Trabalhando com Datas no Delphi

Olá, estou meio atarefado e não estou com tempo para postar mais coisas.

Bom, irei postar algumas rotinas para trabalhar com datas no delphi 5, usando algumas rotinas existentes no Delphi 2010.

Sei que não são todas as rotinas, mas é de grande ajuda.

unit Datas;

interface

uses
SysUtils, Math;

resourcestring
SInvalidDateTime = ””’%s”” is not a valid date and time’;

function DaysBetween(const ANow, AThen: TDateTime): Integer;
function DaySpan(const ANow, AThen: TDateTime): Double;
function SpanOfNowAndThen(const ANow, AThen: TDateTime): TDateTime;
function DayOf(const AValue: TDateTime): Word;
function MonthOfTheYear(const AValue: TDateTime): Word;
function MonthOf(const AValue: TDateTime): Word;
function YearOf(const AValue: TDateTime): Word;
function CurrentYear: Word;
function DiasUteis(mes,ano:Integer ):integer;

function Today: TDateTime;
function Yesterday: TDateTime;
function Tomorrow: TDateTime;
function DaysInMonth(const AValue: TDateTime): Word;
function DaysInAMonth(const AYear, AMonth: Word): Word;

function RecodeTime(const AValue: TDateTime; const AHour, AMinute, ASecond,
AMilliSecond: Word): TDateTime;
function RecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay,
AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
function TryRecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay,
AHour, AMinute, ASecond, AMilliSecond: Word; out AResult: TDateTime): Boolean;

function StartOfTheMonth(const AValue: TDateTime): TDateTime;
function EndOfTheMonth(const AValue: TDateTime): TDateTime;
function EndOfTheDay(const AValue: TDateTime): TDateTime;
function DayOfTheWeek(const AValue: TDateTime): Word;

function IncYear(const Anow: TDateTime; Anos : integer): TDateTime;
function IncMonth(const DateTime: TDateTime; NumberOfMonths: Integer): TDateTime;

procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute,
ASecond, AMilliSecond: Word; const ABaseDate: TDateTime);

procedure DecodeDateTime(const AValue: TDateTime; out AYear, AMonth, ADay,
AHour, AMinute, ASecond, AMilliSecond: Word);

function TryEncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond,
AMilliSecond: Word; out AValue: TDateTime): Boolean;

const
RecodeLeaveFieldAsIs = High(Word);
HoursPerDay   = 24;
MinsPerHour   = 60;
SecsPerMin    = 60;
MSecsPerSec   = 1000;
MinsPerDay    = HoursPerDay * MinsPerHour;
SecsPerDay    = MinsPerDay * SecsPerMin;
SecsPerHour   = SecsPerMin * MinsPerHour;
MSecsPerDay   = SecsPerDay * MSecsPerSec;

implementation

function TryEncodeTime(Hour, Min, Sec, MSec: Word; out Time: TDateTime): Boolean;
var
TS: TTimeStamp;
begin
Result := False;
if (Hour < HoursPerDay) and (Min < MinsPerHour) and (Sec < SecsPerMin) and (MSec < MSecsPerSec) then
begin
TS.Time :=  (Hour * (MinsPerHour * SecsPerMin * MSecsPerSec))
+ (Min * SecsPerMin * MSecsPerSec)
+ (Sec * MSecsPerSec)
+  MSec;
TS.Date := DateDelta; // This is the “zero” day for a TTimeStamp, days between 1/1/0001 and 12/30/1899 including the latter date
Time := TimeStampToDateTime(TS);
Result := True;
end;
end;

function TryEncodeDate(Year, Month, Day: Word; out Date: TDateTime): Boolean;
var
I: Integer;
DayTable: PDayTable;
begin
Result := False;
DayTable := @MonthDays[IsLeapYear(Year)];
if (Year >= 1) and (Year <= 9999) and (Month >= 1) and (Month <= 12) and
(Day >= 1) and (Day <= DayTable^[Month]) then
begin
for I := 1 to Month – 1 do Inc(Day, DayTable^[I]);
I := Year – 1;
Date := I * 365 + I div 4 – I div 100 + I div 400 + Day – DateDelta;
Result := True;
end;
end;

function TryEncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond,
AMilliSecond: Word; out AValue: TDateTime): Boolean;
var
LTime: TDateTime;
begin
Result := TryEncodeDate(AYear, AMonth, ADay, AValue);
if Result then
begin
Result := TryEncodeTime(AHour, AMinute, ASecond, AMilliSecond, LTime);
if Result then
if AValue >= 0 then
AValue := AValue + LTime
else
AValue := AValue – LTime
end;
end;

procedure DecodeDateTime(const AValue: TDateTime; out AYear, AMonth, ADay,
AHour, AMinute, ASecond, AMilliSecond: Word);
begin
DecodeDate(AValue, AYear, AMonth, ADay);
DecodeTime(AValue, AHour, AMinute, ASecond, AMilliSecond);
end;

procedure IncAMonth(var Year, Month, Day: Word; NumberOfMonths: Integer = 1);
var
DayTable: PDayTable;
Sign: Integer;
begin
if NumberOfMonths >= 0 then Sign := 1 else Sign := -1;
Year := Year + (NumberOfMonths div 12);
NumberOfMonths := NumberOfMonths mod 12;
Inc(Month, NumberOfMonths);
if Word(Month-1) > 11 then    // if Month <= 0, word(Month-1) > 11)
begin
Inc(Year, Sign);
Inc(Month, -12 * Sign);
end;
DayTable := @MonthDays[IsLeapYear(Year)];
if Day > DayTable^[Month] then Day := DayTable^[Month];
end;

function IncMonth(const DateTime: TDateTime; NumberOfMonths: Integer): TDateTime;
var
Year, Month, Day: Word;
begin
DecodeDate(DateTime, Year, Month, Day);
IncAMonth(Year, Month, Day, NumberOfMonths);
Result := EncodeDate(Year, Month, Day);
ReplaceTime(Result, DateTime);
end;

function DaysInMonth(const AValue: TDateTime): Word;
var
LYear, LMonth, LDay: Word;
begin
DecodeDate(AValue, LYear, LMonth, LDay);
Result := DaysInAMonth(LYear, LMonth);
end;

function DaysInAMonth(const AYear, AMonth: Word): Word;
begin
Result := MonthDays[(AMonth = 2) and IsLeapYear(AYear), AMonth];
end;

function StartOfTheMonth(const AValue: TDateTime): TDateTime;
var
LYear, LMonth, LDay: Word;
begin
DecodeDate(AValue, LYear, LMonth, LDay);
Result := EncodeDate(LYear, LMonth, 1);
end;

function EndOfTheMonth(const AValue: TDateTime): TDateTime;
var
LYear, LMonth, LDay: Word;
begin
DecodeDate(AValue, LYear, LMonth, LDay);
Result := EndOfTheDay(EncodeDate(LYear, LMonth, DaysInAMonth(LYear, LMonth)));
end;

function StartOfTheWeek(const AValue: TDateTime): TDateTime;
begin
Result := Trunc(AValue) – (DayOfTheWeek(AValue) – 1);
end;

function EndOfTheWeek(const AValue: TDateTime): TDateTime;
begin
Result := EndOfTheDay(StartOfTheWeek(AValue) + 6);
end;

function StartOfTheDay(const AValue: TDateTime): TDateTime;
begin
Result := Trunc(AValue);
end;

function DayOfTheWeek(const AValue: TDateTime): Word;
begin
Result := (DateTimeToTimeStamp(AValue).Date – 1) mod 7 + 1;
end;

function EndOfTheDay(const AValue: TDateTime): TDateTime;
begin
Result := RecodeTime(AValue, 23, 59, 59, 999);
end;

function RecodeTime(const AValue: TDateTime; const AHour, AMinute, ASecond,
AMilliSecond: Word): TDateTime;
begin
Result := RecodeDateTime(AValue, RecodeLeaveFieldAsIs, RecodeLeaveFieldAsIs,
RecodeLeaveFieldAsIs, AHour, AMinute, ASecond, AMilliSecond);
end;

function RecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay,
AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
begin
if not TryRecodeDateTime(AValue, AYear, AMonth, ADay,
AHour, AMinute, ASecond, AMilliSecond, Result) then
InvalidDateTimeError(AYear, AMonth, ADay,
AHour, AMinute, ASecond, AMilliSecond,
AValue);
end;

procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute,
ASecond, AMilliSecond: Word; const ABaseDate: TDateTime);
function Translate(AOrig, AValue: Word): string;
begin
if AValue = RecodeLeaveFieldAsIs then
if ABaseDate = 0 then
Result := ‘?’
else
Result := IntToStr(AOrig)
else
Result := IntToStr(AValue);
end;
var
LYear, LMonth, LDay, LHour, LMinute, LSecond, LMilliSecond: Word;
begin
DecodeDate(ABaseDate, LYear, LMonth, LDay);
DecodeTime(ABaseDate, LHour, LMinute, LSecond, LMilliSecond);
raise EConvertError.CreateFmt(SInvalidDateTime,
[Translate(LYear, AYear) + ‘-‘ +
Translate(LMonth, AMonth) + ‘-‘ +
Translate(LDay, ADay) + ‘ ‘ +
Translate(LHour, AHour) + ‘:’ +
Translate(LMinute, AMinute) + ‘:’ +
Translate(LSecond, ASecond) + ‘.’ +
Translate(LMilliSecond, AMilliSecond)]);
end;

function TryRecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay,
AHour, AMinute, ASecond, AMilliSecond: Word; out AResult: TDateTime): Boolean;
var
LYear, LMonth, LDay, LHour, LMinute, LSecond, LMilliSecond: Word;
begin
DecodeDateTime(AValue, LYear, LMonth, LDay,
LHour, LMinute, LSecond, LMilliSecond);
if AYear <> RecodeLeaveFieldAsIs then LYear := AYear;
if AMonth <> RecodeLeaveFieldAsIs then LMonth := AMonth;
if ADay <> RecodeLeaveFieldAsIs then LDay := ADay;
if AHour <> RecodeLeaveFieldAsIs then LHour := AHour;
if AMinute <> RecodeLeaveFieldAsIs then LMinute := AMinute;
if ASecond <> RecodeLeaveFieldAsIs then LSecond := ASecond;
if AMilliSecond <> RecodeLeaveFieldAsIs then LMilliSecond := AMilliSecond;
Result := TryEncodeDateTime(LYear, LMonth, LDay,
LHour, LMinute, LSecond, LMilliSecond, AResult);
end;

function DaysBetween(const ANow, AThen: TDateTime): Integer;
begin
Result := Trunc(DaySpan(ANow, AThen));
end;

function DaySpan(const ANow, AThen: TDateTime): Double;
begin
Result := SpanOfNowAndThen(ANow, AThen);
end;

function SpanOfNowAndThen(const ANow, AThen: TDateTime): TDateTime;
begin
if ANow < AThen then
Result := AThen – ANow
else
Result := ANow – AThen;
end;

function DayOf(const AValue: TDateTime): Word;
var
LYear, LMonth: Word;
begin
DecodeDate(AValue, LYear, LMonth, Result);
end;

function MonthOfTheYear(const AValue: TDateTime): Word;
begin
Result := MonthOf(AValue);
end;

function MonthOf(const AValue: TDateTime): Word;
var
LYear, LDay: Word;
begin
DecodeDate(AValue, LYear, Result, LDay);
end;

function YearOf(const AValue: TDateTime): Word;
var
LMonth, LDay: Word;
begin
DecodeDate(AValue, Result, LMonth, LDay);
end;

function CurrentYear: Word;
var
LMonth, LDay: Word;
begin
DecodeDate(Date, Result, LMonth, LDay);
end;

function Today: TDateTime;
begin
Result := Date;
end;

function Yesterday: TDateTime;
begin
Result := Date – 1;
end;

function Tomorrow: TDateTime;
begin
Result := Date + 1;
end;

function IncYear(const Anow: TDateTime; Anos : integer): TDateTime;
var
LMonth, LDay, LYear: Word;
begin
DecodeDate(ANow, LYear, LMonth, LDay);
lYear:=LYear+Anos;
Result:=EncodeDate(LYear, LMonth, LDay);
end;

function DiasUteis(mes,ano:Integer ):integer; // Dias Uteis de Um Mês Especifico
var
data : TDateTime;
contador : Integer;
begin
data := StrToDate(’01/’+IntTOStr(mes)+’/’+IntToStr(ano));
Contador := 0;
while (MonthOf(data)= mes) do
begin
if ( DayOfWeek(data) in [2,3,4,5,6] ) then
Inc(Contador);
Data := Data + 1
end;
result := contador;
end;

end.

Espero ter ajudado.

Até a próxima.

Agradecimento a Márcio Torres pela função de contar os dias Ulteis no Mês.