Zabawa z datą ;)

Zacznijmy od typu TDate. W dużym skrócie TDate jest 8 bajtową liczbą rzeczywistą typu double.

Zmienna typu TDate przyjmuje wartość 0 dokładnie dla daty 30-12-1899 i godziny 0:00. W dalszej część pominiemy wartość godziny zaokrąglając zmienną korzystając z procedury trunc().

Każdy kolejny dzień od daty 30.12.1899 posiada wartość 1. Tabela poniżej powinna pomóc to zrozumieć.

Jeżeli chcesz samemu przeliczyć wartość TDate skorzystaj z poniższej procedury :

ShowMessage(DateToStr(1000)); // wartość 1000 jest dowolna

---

Teraz przejdziemy do części praktycznej. Oto kilka prostych ale czasem bardzo przydatnych procedur.

Przykład 1 :

Poniższa funkcja zwraca ilość dni w miesiącu. Opiera się ona na zasadach kalendarza gregoriańskiego czyli :

• 31 dni posiadają miesiące 1,3,5,7,8,10,12

• 30 dni posiadają miesiące 4,6,9,11

• rok ma długość 365 lub 366 dni gdy jest rokiem przestępnym

• miesiąc luty w roku przestępnym posiada 29 a zwykłym 28 dni

• rok przestępny to rok który dzieli się przez 4 bez reszty

• wyjątkowo rokiem przestępnym nie jest rok który dzieli się przez 100 i 400, czyli rok 2000 jest rokiem przestępnym, ale już 1900 i 2100 nie jest.

Parametry dla funkcji to jak można się domyśleć to miesiąc i rok.

function dwm(miesiac, rok : word):byte;  // dni w miesiącu<br>
begin
    case miesiac of
      1, 3, 5, 7, 8, 10, 12 : result := 31; // miesiące które mają 31 dni
      4, 6, 9, 11 : result := 30;  // miesiące które mają 30 dni
      2 : begin  // luty - odjazd ;-)
            if (rok mod 4 = 0) then
              begin
                if (rok mod 100 = 0) then
                  begin
                    if (rok mod 400 = 0) then result:=29 else result:= 28;
                  end else result := 29
              end else result := 28;
          end;
      else result := 0;
    end;
end;

</p>

---

Przykład 2

Poniższa funkcja jest skróconą wersją powyższej, korzysta również z wszystkich wymienionych powyżej reguł, jako parametr przyjmuje rok a zwraca liczbę jego dni.
```delphi function dwr(rok : word):word; // dni w roku
begin     if (rok mod 4 = 0) then       begin         if (rok mod 100 = 0) then           begin             if (rok mod 400 = 0) then result:=366 else result:= 365;           end else result := 366;       end else result := 365; end; ```

---

Przykład 3
Tym razem procedura jest już bardziej skomplikowana. Jej działanie w skrócie można określić jako wyciąganie ze zmiennej typu TDate, danych tj. dnia, miesiąca i roku. Wykorzystuje ona obie powyższe funkcje. Jako parametr należy podać rok oraz zmienne którym zostanie przypisana wartość dd, mm, rr, czyli odpowiednio dzień, miesiąc i rok.

```delphi procedure pd(data : TDate; var dd, mm, rr : word); // podziel datę
var   tmpData : integer; begin   tmpData := trunc(data); // zaokrąglenie "do dołu" wartości daty
  rr := 1899; // zmienna TDate dla daty 30.12.1899 przyjmuje wartość 0   mm := 12;   dd := 30;
  while tmpData>dwr(rr) do // aby skrócić proces, zmienną tmpData skracamy o kolejne lata     begin       inc(rr);       dec(tmpData,dwr(rr));     end;   inc(dd,tmpData); // sumujemy i przypisujemy powstałą datę do zmiennej dd - dzień   while dd>dwm(mm,rr) do // rozdzielanie dni na odpowiednie miesiące     begin       dec(dd,dwm(mm,rr)); // co zostanie to dzień       inc(mm);       if mm>12 then // jeżeli miesięcy jest za dużo         begin           mm:=1;           inc(rr); // dodajemy jeden rok         end;     end; end;

<br>
Przykład wywołania procedury :
<br>
```delphi
procedure TForm1.Button1Click(Sender: TObject);
var
  dd, mm, rr : word;
begin
  pd(date,dd,mm,rr);  // date - aktualna data, do zmiennych dd, rr, mm zostaną przypisane odpowiednie wartości
  ShowMessage('IntToStr(dd)+' '+IntToStr(mm)+' '+IntToStr(rr));
end;

</p>

---

Przykład 4
Teraz prosty przykład formatowania daty w którym wykorzystamy wyżej podaną procedurę i obie funkcje.
```delphi procedure TForm1.Button1Click(Sender: TObject); const   miesiace : array[1..12] of string = ('Styczeń','Luty','Marzec','Kwiecień','Maj','Czerwiec','Lipiec','Sierpień','Wrzesień','Październik','Listopad','Grudzień'); var   dd, mm, rr : word; begin   pd(date,dd,mm,rr);   ShowMessage('Aktualna data : '+IntToStr(dd)+' '+miesiace[mm]+' '+IntToStr(rr)+' r.'); end;

<br>
Jak widać można ładniej wyświetlić datę :)</p>
<hr size="1" color="#008080" noshade>
<p align="left"><b>Podsumowanie, cały kod</b> <br>
<br>To by było na dzisiaj koniec, zachęcam do testowania i rozwijania moich pomysłów. Powyższe procedury i funkcje choć są już i tak bardzo szybkie, można jeszcze zoptymalizować ale to zostawiam już Tobie :)<br>Oto kod całego programu (wystarczy na formie położyć jeden przycisk) :
<br>
```delphi
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function dwm(miesiac, rok : word):byte;  // dni w miesiącu
begin
  case miesiac of
    1, 3, 5, 7, 8, 10, 12 : result := 31; // miesiące które mają 31 dni
    4, 6, 9, 11 : result := 30;  // miesiące które mają 30 dni
    2 : begin  // luty - odjazd ;-)
          if (rok mod 4 = 0) then
            begin
              if (rok mod 100 = 0) then
                begin
                  if (rok mod 400 = 0) then result:=29 else result:= 28;
                end else result := 29
              end else result := 28;
          end;
    else result := 0; // taki miesiąc nie istnieje
  end;
end;

function dwr(rok : word):word;  // dni w roku
begin
  if (rok mod 4 = 0) then
    begin
      if (rok mod 100 = 0) then
        begin
          if (rok mod 400 = 0) then result:=366 else result:= 365;
        end else result := 366;
    end else result := 365;
end;

procedure pd(data : TDate; var dd, mm, rr : word); // podziel datę
var tmpData : integer;
begin
  tmpData := trunc(data);  // zaokrąglenie do dołu wartości daty

  rr := 1899;  // zmienna TDate dla daty 30.12.1899 przyjmuje wartość 0
  mm := 12;
  dd := 30;

  while tmpData>dwr(rr) do  // aby skrócić proces date skracamy o kolejne lata
    begin
      inc(rr);
      dec(tmpData,dwr(rr));
  end;

  inc(dd,tmpData);  // sumujemy i przypisujemy powstałą datę do zmiennej dd - dzień

  while dd>dwm(mm,rr) do  // rozdzielenie dni na odpowiednie misiące
    begin
      dec(dd,dwm(mm,rr));  // co zostanie to dzień
      inc(mm);
      if mm>12 then  // jeżeli miesięcy jest za dużo
        begin
          mm:=1;
          inc(rr);   // dodajemy jeden rok
        end;
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
const
  miesiace : array[1..12] of string = ('Styczeń','Luty','Marzec','Kwiecień','Maj','Czerwiec','Lipiec','Sierpień','Wrzesień','Październik','Listopad','Grudzień');
var
  dd, mm, rr : word;
begin
  pd(date,dd,mm,rr);
  ShowMessage('Aktualna data : '+IntToStr(dd)+' '+miesiace[mm]+' '+IntToStr(rr)+' r.');
end;

end.

</p>