Programowanie w języku Delphi » Gotowce

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ć.

<center>
Wartość TDate *Prawdziwa data (dd, mm, rr)
030.12.1899
131.12.1899
201.01.1900
1234518.10.1933
5432120.09.2048

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;


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.

function dwr(rok : word):word;  // dni w roku<br>
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.

procedure pd(data : TDate; var dd, mm, rr : word); // podziel datę<br>
var
  tmpData : integer;
begin
  tmpData := trunc(data);  // zaokrąglenie "do dołu" wartości daty<br>
  rr := 1899;  // zmienna TDate dla daty 30.12.1899 przyjmuje wartość 0
  mm := 12;
  dd := 30;<br>
  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;


Przykład wywołania procedury :

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;



Przykład 4

Teraz prosty przykład formatowania daty w którym wykorzystamy wyżej podaną procedurę i obie funkcje.

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;


Jak widać można ładniej wyświetlić datę :)




Podsumowanie, cały kod 


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 :)
Oto kod całego programu (wystarczy na formie położyć jeden przycisk) :

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.

11 komentarzy

Waldi 2004-08-03 20:32

a jak pobrać jaki dzień tygodnia jest w danym miesiącu

Marooned 2003-08-08 19:51

Do sprawdzenia, czy dany rok jest przestępny można użyć funkcji IsLeapYear. Kod będzie czytelniejszy.

Kubuś_Puchatek 2004-02-04 09:54

Wybacz, ale moim zdanie Twoja praca to wyważanie otwartych drzwi. Wystarczy użyć funkcji z unitów SysUtils i DateUtils, by uzyskać ten sam efekt. Nie bardzo widzę sens tworzenia czegoś co już jest. Poniżej Twoje przykłady z ich odpowiednikami we wspomnianych unitach.

Przykład 1

Poniższa funkcja zwraca ilość dni w miesiącu.
function dwm(miesiac, rok : word):byte;

DaysInAMonth (DateUtils)
Returns the number of days in a specified month of a specified year.

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.

DaysInAYear (DateUtils)
Returns the number of days in a specified year.

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.

DecodeDate (SysUtils)
Returns Year, Month, and Day values for a TDateTime value.

Przykład 4

Teraz prosty przykład formatowania daty w którym wykorzystamy wyżej podaną procedurę i obie funkcje.

Moim zdaniem tak jest o wiele prościej &#8230;
Jeśli mamy ustawiony język polski to nie trzeba definiować nazw miesięcy.  Oczywiście, jak komuś nie odpowiadają te nazwy może je zmienić. Wystarczy wpisać nowe nazwy do tablicy LongMonthNames[1..12] (w przypadku pełnych nazw) lub do tablicy ShortDayNames w przypadku nazw skróconych. Analogicznie sprawa ma się z nazwami dni &#8211; odpowiadające im tablice to LongDayNames i ShortDayNames obie o wymiarach [1..7].

LongMonthNames[<numer_miesiąca>] := '<twoja_nazwa_miesiąca>';
ShortDateFormat := 'dd mmmm yyyy r.';
DateToStr(Date);

-CD- 2003-07-06 23:45

Hehe, algorytm rozpisania TDate na dzien, miesiac i rok jest co prawda ciekawy, no ale duzo latwiej tak:
aa:= DateToStr(Data);
dd:= StrToInt(aa[7] + aa[8]);
mm:= StrToInt(aa[4] + aa[5]);
rr:= StrToInt(aa[1] + aa[2]);


piotr_12345 2003-05-26 17:26

@Drajew : Może i łatwiej, ale formatDateTime jest dość okrojony. Np. co jeżeli chcesz zmienić język lub skrócić nazwy miesiąca czy dni?

Drajwer 2003-05-26 16:50

nie łatwiej formatdatetime('format',now); ?

aZgon 2003-05-25 22:13

No mam nadzieje ze wkrotce sie pokaże...

piotr_12345 2003-05-25 21:39

W kolejenej części :)

aZgon 2003-05-25 21:31

No nawet fajne funcke ale ja bym tutaj jeszcze opisal zecz ktora pewnie wielu by sie przydala ... Mianowicie liczenie sekund, minut, godzin, dni, misiecy, lat od okreslonej daty.
Liczenie ile zostało do daty w przyszłości, itd.

piotr_12345 2003-07-11 17:32

@-CD- : Twój sposób jest łatwiejszy ale zawodny :( Dlaczego? Spróbuj uruchomić Twoją procedurę w Windows XP i Windows 98. W Windows XP rok zapisywane jest w formacie rrrr, a windows 98 rr, tak więc dla roku 2003 odpowiednio uzyskasz efekt : rok 20 dla Win XP oraz rok 03 dla Win 98 :)

Miałem napisać ciąg dalszy i ... napisałem, ale padł dysk i musze napisać od nowa :( Jak zbiorę siły i chęci to coś wyskrobię :)