Procedury i funkcje TDate i TTime

1. Konwersja daty z formatu 'DD/MM/YY' na 'DDMMYYYY'

LongDate := FormatDateTime('ddmmyyyy', StrToDate(ShortDate));

Taki format (DD/MM/YY),gdzie rok jest określany 2 cyframi i do tego na końcu jest nie do przyjęcia w większości systemów baz danych, które wymagają roku w pełnym 4-cyfrowym ujęciu.

2. Określenie ile dni, miesięcy i lat liczy okres podany pomiędzy 2 datami:

var: Year1, Month1, Day1, Year2, Month2, Day2, YearResult, MonthResult, DayResult: Word;
TDay1, TDay2, DateDiff: TDateTime;
begin
TDay1 := EncodeDate(Year1, Month1, Day1);
TDay2 := EncodeDate(Year2, Month2, Day2);
DateDiff := TDay2 - TDay1; { TDay2 to data późniejsza względem TDay1}
DecodeDate(DateDiff, YearResult, MonthResult, DayResult);
end;

DateDiff określa różnicę dat - jest LongInt chociaż TDateTime jest objektem.

3. Podobny do w/w ale oblicza różnicę od daty dzisiejszej:

var OldDate, Date: TDateTime; wYear, wYear2, wMonth, wMonth2, wDay, wDay2 : Word; fYear, fMonth, fDay : Word;
begin
OldDate := Now; // pobieranie dziesiejszej daty
DecodeDate(OldDate, wYear, wMonth, wDay);
Date := StrToDate('01-10-10');
DecodeDate(Date, wYear2, wMonth2, wDay2);
fYear := wYear - wYear2; fMonth := wMonth - wMonth2;
fDay := wDay - wDay2;
ShowMessage(Format('Różnica dni: %d, miesięcy: %d, lat: %d', [fDay, fMonth, fYear]));

4. Zamykanie programu po upływie np. 30 sek. - przy pomocy komponentu TTimer.

Trzeba wygenerować procedurę OnTimer i tam wpisać:

var I : Integer = 30;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Label1.Caption := 'Do zakończenia programu pozostało: ' + IntToStr(I);
Dec(i); If I = 0 then Close;
end;

5. Ustawienie systemowej daty i czasu z użyciem Delphi.

Procedure settime(hour, min, sec, hundreths : byte); assembler;
asm
mov ch, hour
mov cl, min
mov dh, sec
mov dl, hundreths
mov ah, $2d
int $21
end;

Procedure setdate(Year : word; Month, Day : byte); assembler;
asm
mov cx, year
mov dh, month
mov dl, day
mov ah, $2b
int $21
end;

6. Konwersja daty do postaci np.: 25 stycznia 2001

Należy skorzystać z funkcji "FormatDateTime".

ShowMessage(FormatDateTime('dd mmmm yyyy', Now));
//na ekranie wyświetli się 25 stycznia 2001

7. Określenie ilości tygodni

Są to 2 różne funkcje, z których 1 sprawdza czy to nie jest rok przestępny; 2-ga oblicza dni w danym roku, trzecia natomiast daje ilość tygodni w danym roku.

{1} function kcIsLeapYear( nYear: Integer ): Boolean;
begin
Result := (nYear mod 4 = 0) and ((nYear mod 100 < > 0) or (nYear mod 400 = 0));
end;

{2 } function kcMonthDays( nMonth, nYear: Integer ): Integer;
const
DaysPerMonth: array[1..12] of Integer = (31, 28, 31, 30, 31, 30, 31,
31, 30, 31, 30, 31);
begin
Result := DaysPerMonth[nMonth];
if (nMonth = 2) and kcIsLeapYear(nYear) then Inc(Result);
end;

{ 3}function kcWeekOfYear( dDate: TDateTime ): Integer;
var X, nDayCount: Integer; nMonth, nDay, nYear: Word;
begin
nDayCount := 0;
deCodeDate( dDate, nYear, nMonth, nDay );
For X := 1 to ( nMonth - 1 ) do
nDayCount := nDayCount + kcMonthDays( X, nYear );
nDayCount := nDayCount + nDay;
Result := ( ( nDayCount div 7 ) + 1 );
end;

8. EncodeDate - data w postaci łańcucha

Składnia do konwersji tekstu z pola bazy Paradoxa na łańcuch(xx,xx,xx)

opcje
TheDateField.AsString := TheDateString;
TheDateString := TheDateField.AsString;

a niżej ta konwersja
TheDateField.AsDateTime := StrToDate(TheDateString);
TheDateString := DateToStr(TheDateField.AsDateTime);

9. Data jako łańcuch

procedura wprowadza automatycznie aktualną datę do okienka MaskEdita a ten może ją wstawiać gdzie indziej:

procedure TForm1.MaskEdit1Exit(Sender: TObject);
var y, m, d : word;
begin
decodedate(strtodate(maskedit1.text) + 11, y, m, d);
maskedit2.text := inttostr(m) + '/' + inttostr(d) + '/' + inttostr(y);
end;

10. Wykonanie operacji o określonej godzinie

Przy pomocy komponentu TTimer. Będzie on co sekunde sprawdzał, która jest godzina. Jeżeli będzie to np. 09.30 to wykona jakąś operacje.

procedure TForm1.TimerTimer(Sender: TObject);
var Present : TDateTime; Hour, Min, Sek, MSec : Word;
begin
Present := Now;
DecodeTime(Present, Hour, Min, Sek, MSec);
if (Hour = 09) and (Min = 31) and (Sek = 0) then
ShowMessage('Jest godz: 9.30'); // Uruchomi sie o godz. 9.31
end;

11. Zmiana daty w systemie

var Data:Systemtime;
begin
Data.wMonth:= 12;
Data.wDay:=22;
Data.wYear:=1995;
SetLocalTime(Data);

12. Date Conversion

Prosty sposób zamiany danych danego ciągu dnia w formacie '1996-06-03 00.00.00' na wydzielone ciągi zmiennych Date/Time formatu zmiennej ShortDateFormat.

procedure TForm1.Button1Click(Sender: TObject);
var st, formatsave : string; DT : TDateTime;
begin
st := Edit1.text; // '1996-06-03 00.00.00' formatsave := ShortDateFormat;
ShortDateFormat := 'yyyy.mm.dd hh.mm.ss';
while pos ('-', st) > 0 do
st [pos ('-', st)] := '.';
DT := StrToDateTime (st);
ShortDateFormat := formatsave;
Label1.Caption := DateTimeToStr (DT);
end;

13. Konwersja daty na tydzień

Ile tygodni pozostało do wyznaczonego terminu:

procedure TForm1.Button1Click(Sender: TObject);
var frstDay,toDay : TDateTime; week : Integer;
begin
frstDay := StrToDate('1/1/96');
toDay := StrToDate(Edit1.Text);
week := Trunc((toDay - frstDay) / 7) + 1;
Label1.Caption := IntToStr(week);
end;

14. Wstawianie datownika - daty i czasu do pola Memo

Var s : string ;
begin
s := DateToStr( Date ) + ' ' + TimeToStr( Time ) + ' :' ;
Memo1.Lines.Insert( 0, s ) ;
Memo1.SetFocus ;
Memo1.SelStart := Length( s ) ;
Memo1.SelLength := 0 ;
end;

15. Wstawienie do RichEdita datę lub godzinę.

Po pierwsze, aby wstawić datę lub godzinę do RichEdit należy datę skonwertować. Robi to funkcja DateToStr, TimeToStr.

RichEdit1.SelText := DateToStr(Date);
RichEdit1.SelText := TimeToStr(Time);

Powyższy kod może nie działać w starych wersjach Delphi gdyż nie są przystosowane do daty 2000 i pokazują date: 99-12-30

16. Ustawienie czasu włączenia wygaszacza ekranu:

var Delay: integer;
begin
Delay := 180; // tym razem tutaj podaje się w sekundach (180 sek = 3 min.)
SystemParametersInfo(SPI_SETSCREENSAVETIMEOUT, Delay, nil, 0);

17. Numer tygodnia na podstawie podanego dnia w roku.

Wariant 1:
function weekofyear(adate: tdatetime): word;
var day: word; month: word; year: word; firstofyear: tdatetime;
begin
decodedate(adate,year,month,day); firstofyear:=encodedate(year,1,1);
if (adate=encodedate(year,12,31)) or
(adate=firstofyear) then result:=1 else result:=trunc(adate - firstofyear) div 7+1;
end;

Wariant 2:
function weeknum(const adate: tdatetime): word;
var year: word; month: word; day: word;
begin
decodedate(adate + 4 - dayofweek(adate + 6),year,month,day);
result:=1+trunc((adate-encodedate(year,1,5) +
dayofweek(encodedate(year,1,3))) / 7);
end;

Wariant 3:
function myweekofyear(dat: tdatetime): word;
// interpretacja numerów dni- iso: 1 = poniedziałek, 7 = niedziela
// a delphi sysutils: 1 = niedziela, 7 = sobota
var day, month, year: word; firstdate: tdatetime; datediff: integer;
begin
day:=sysutils.dayofweek(dat) - 1; dat:=dat + 3 -((6 + day) mod 7);
decodedate(dat,year,month,day); firstdate:=encodedate(year,1,1);
datediff:=trunc(dat - firstdate); result:=1 + (datediff div 7);
end;

Wariant 4:
function myweekofyear2(date: tdatetime): word;
{ a teraz standardowa funkcja z dateutils.dcu. }
begin
result:=weekof(date);
end;

Teraz sprawdzamy wszystkie opcje:
procedure tform1.button1click(sender: tobject);
begin
showmessage(inttostr(weekofyear(strtodate('31.12.2003'))));
showmessage(inttostr(weeknum(strtodate('31.12.2003'))));
showmessage(inttostr(myweekofyear(strtodate('31.12.2003'))));
showmessage(inttostr(myweekofyear2(strtodate('31.12.2003'))));
end;

18. Sygnalizacja (dźwięk) zmiany czasu systemowego.

...
private
procedure wmtimechange(var message: twmtimechange); message wm_timechange;
...
procedure tform1.wmtimechange(var message: twmtimechange);
begin
messgebeep(0);
end;

19. Jak mierzyć czas?

Czas wykonania pewnych operacji programista mierzy w 2 przypadkach: programista sam chce się dowiedzieć jak działa program lub poinformować użytkowników o tym. Do tego celu wykorzystujemy funkcję GetTickCount. Aby uniknąć błędu (ze względu na bardzo krótki czas 1 pomiaru i fakt, że programy pod Windows są wykonywane z różnymi prędkościami) algorytm pomiaru wykonuje zadaną operację np, 1000 razy i następnie dzieli przez 1000 aby uśrednić wynik. W przykładzie program dokładnie określa czas zmian pikseli w oknie tego programu.

procedure tform1.button1click(sender: tobject);
var i, t: integer;
begin
t := gettickcount; randomize;
for i := 0 to 100000 do
form1.canvas.pixels[i mod form1.clientwidth, i div form1.clientwidth] :=
rgb(random(255), random(255), random(255));
form1.caption := inttostr(gettickcount - t);
end;

20. Jak otrzymać datę według kalendarza Juliańskiego?

function julian(year, month, day: integer): real;
var yr, mth: integer; noleap, leap, days, yrs: real;
begin
if year < 0 then yr := year + 1
else
yr := year; mth := month; if (month < 3) then
begin
mth := mth + 12; yr := yr - 1; end;
yrs := 365.25 * yr; if ((yrs *lt; 0) and (frac(yrs) < > 0)) then
yrs := int(yrs) - 1
else
yrs := int(yrs); days := int(yrs) + int(30.6001 * (mth + 1)) + day - 723244.0;
if days < -145068.0 then julian := days
else begin
yrs := yr / 100.0; if ((yrs < 0) and (frac(yrs) < > 0)) then
yrs := int(yrs) - 1; noleap := int(yrs); yrs := noleap / 4.0;
if ((yrs < 0) and (frac(yrs) < > 0)) then
yrs := int(yrs) - 1; leap := 2 - noleap + int(yrs); julian := days + leap;
end; end;

21. Jak obliczyć wiek po dniu urodzin?

{ brthdate: data urodzin }
function tffuncs.calcage(brthdate: tdatetime): integer;
var month, day, year, bmonth, bday, byear: word;
begin
decodedate(brthdate, byear, bmonth, bday);
if bmonth = 0 then result := 0
else begin
decodedate(date, year, month, day); result := year - byear;
if (100 * month + day) < (100 * bmonth + bday) then
result := result - 1;
end; end;

procedure tform1.button1click(sender: tobject);
var month, day, year, currentmonth, currentday, currentyear: word; age: integer;
begin
decodedate(datetimepicker1.date, year, month, day);
decodedate(date, currentyear, currentmonth, currentday);
if (year = currentyear) and (month = currentmonth) and (day = currentday) then age := 0
else begin
age := currentyear - year;
if (month > currentmonth) then dec(age)
else
if month = currentmonth then if (day > currentday) then dec(age); end;
label1.caption := inttostr(age);
end;
// sprawdzenie czy data aktualna
function dateexists(date: string; separator: char): boolean;
var olddateseparator: char;
begin
result := true; olddateseparator := dateseparator;
dateseparator := separator;
try try strtodate(date);
except
result := false; end;
finally dateseparator := olddateseparator;
end; end;

procedure tform1.formcreate(sender: tobject);
begin
if dateexists('35.3.2001', '.') then
begin
{tutaj wstaw swój kod.......}
end; end;

22. Praca z czasem i sposoby dodawania czasu typu 1.20+1.50=3.10

Jeśli tworzysz aplikację, w której użytkownik wprowadzi wartość czasu, standardowe obliczenia nie będą działać. Problem w tym, że w normalnym trybie dla komputera wyrażenia 1.20 + 1.70 wyniesie 2,90, a nie 3.10. Oto trzy funkcje, które rozwiązują problem. One pracują tylko z godzinami i minutami ponieważ użytkownicy rzadko wykorzystują sekundy. Druga i trzecia funkcja pozwalają na konwersję rzeczywistą wartości czasu do dziesiętny odpowiednik i vice versa. Wszystkie pola na formularzu będą w formacie hh.mm.

function sumhhmm(a, b: double): double;
var h1: double;
begin
h1 := (int(a) + int(b)) * 60 + (frac(a) + frac(b)) * 100;
result := int(h1 / 60) + (h1 - int(h1 / 60) * 60) / 100;
end;

function hhmm2hhdd(const hhmm: double): double;
begin
result := int(hhmm) + (frac(hhmm) / 0.6);
end;

function hhdd2hhmm(const hhdd: double): double;
begin
result := int(hhdd) + (frac(hhdd) * 0.6);
end;

//zastosowanie:
// sumtime(1.20,1.50) => 3.10
// sumtime(1.20,- 0.50) => 0.30
// hhmm2hhdd(1.30) => 1.5 (1h.30m = 1.5h)
// hhdd2hhmm(1.50) => 1.30 (1.5h = 1h30m)

23.Jak wdrożyć w Windows dokładny (ułamkowy) pomiar czasu?

Sam Windows nie pokazuje dokladnego czasu. Za pomocą procedury QueryPerformanceCounter można osiągnąć dokładność rzędu kilku nanosekund. Oto przykład:

var waitcal: int64;

procedure wait(ns: integer);
var counter, freq, waituntil: int64;
begin
if queryperformancecounter(counter) then
begin
queryperformancefrequency(freq);
waituntil := counter + waitcal + (ns * (freq div 1000000));
while counter < waituntil do
queryperformancecounter(counter);
end else sleep(ns div 1000);
end;
// aby uzyskać większą dokładność należy poczekać (sleep) chwilę przed użyciem wait()
var start, finish: int64;
application.processmessages; sleep(10);
queryperformancecounter(start); wait(0);
queryperformancecounter(finish); waitcal := start - finish;

//jeżeli nie stwierdzi się zwiększenia dokładności to można spróbować tak:
application.processmessages;
sleep(0); dosomething; wait(10); dosomethingelse;

24. Robota z datami.

data - d (dzień), m (miesiąc), y (rok).
numer dnia tygodnia: poniedziałek - 1, wtorek - 2, niedziela - 7.
uses math, ap;

function dayofweek(d : integer; m : integer; y : integer):integer;forward;

Dzień tygodnia według daty.
function dayofweek(d : integer; m : integer; y : integer):integer;
var n : integer;
begin
if m >2 then begin m := m+1;
end else begin
m := m+13; y := y-1;
end;
n := 36525*y div 100+306*m div 10+d-621050; result := n-n div 7*7+1;
end;

Ilość dni między dwiema datami -date2 i date1
uses math, api;

function daysbetween(d1 : integer; m1 : integer; y1 : integer; d2 : integer;
m2 : integer; y2 : integer) : integer; forward;

function daysbetween(d1 : integer; m1 : integer; y1 : integer; d2 : integer;
m2 : integer; y2 : integer):integer;
var n1 : integer; n2 : integer;
begin
if m1 >2 then begin m1 := m1+1;
end else begin
m1 := m1+13; y1 := y1-1;
end;
n1 := 36525*y1 div 100+306*m1 div 10+d1; if m2 >2 then
begin
m2 := m2+1; end else begin
m2 := m2+13; y2 := y2-1;
end;
n2 := 36525*y2 div 100+306*m2 div 10+d2; result := n2-n1;
end;

Ilość lat, miesięcy i dni między dwiema datami
uses math, ap;

procedure dmybetween(const d2 : integer; const m2 : integer; const y2 : integer;
const d1 : integer; const m1 : integer; const y1 : integer; var d : integer;
var m : integer; var y : integer);forward;

Liczbę lat, miesięcy i dni pomiędzy dwiema datami - data1 i data2.
procedure dmybetween(const d2 : integer; const m2 : integer; const y2 : integer; const d1 : integer;
const m1 : integer; const y1 : integer; var d : integer; var m : integer; var y : integer);
var yleap : boolean; dm : tinteger1darray; cf : integer;
begin
setlength(dm, 12+1); yleap := (y2 mod 4=0) and ((y2 mod 100 < > 0) or (y2 mod 400=0));
dm[1] := 31; dm[3] := 31; dm[4] := 30; dm[5] := 31; dm[6] := 30; dm[7] := 31; dm[8] := 31;
dm[9] := 30; dm[10] := 31; dm[11] := 30; dm[12] := 31;
if yleap then
begin
dm[2] := 29; end else begin dm[2] := 28; end;
cf := 0; d := d1-d2; if d <0 then
begin
d := d+dm[m2]; cf := 1; end;
m := m1-m2-cf; cf := 0; if m < 0 then
begin
m := m+12; cf := 1; end; y := y1-y2-cf;
end;

Sprawdzenie, czy rok jest przestępny. Program sprawdza czy rok jest przestępny. Ten rok to taki, który dzieli się prze 4 ale nie dzieli się przez 100 chociaż dzieli się przez 400 - stąd:
yleap := (y2 mod 4=0) and ((y2 mod 100 < > 0) or (y2 mod 400=0));

25. Jak uzyskać listę stref czasowych?

uses Registry;

procedure TForm1.Button1Click(Sender: TObject);
var reg : TRegistry; ts : TStrings; i : integer;
begin
reg := TRegistry.Create; reg.RootKey := HKEY_LOCAL_MACHINE;
reg.OpenKey( 'SOFTWARE\Microsoft\Windows\CurrentVersion\Time Zones', false);
if reg.HasSubKeys then begin
ts := TStringList.Create; reg.GetKeyNames(ts); reg.CloseKey;
for i := 0 to ts.Count -1 do begin
reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Time Zones\' + ts.Strings[i], false);
Memo1.Lines.Add(ts.Strings[i]); Memo1.Lines.Add(reg.ReadString('Display'));
Memo1.Lines.Add(reg.ReadString('Std')); Memo1.Lines.Add(reg.ReadString('Dlt'));
Memo1.Lines.Add('----------------------');
reg.CloseKey;
end; ts.Free; end else
reg.CloseKey; reg.free;
end;

26. Jak określić czas ostatniego dostępu do pliku?

Uwaga: nie wszystkie pliki systemowe dają się tak odczytać. przykład:

procedure TForm1.Button1Click(Sender: TObject);
var SearchRec : TSearchRec; Success : integer; DT : TFileTime; ST : TSystemTime;
begin
Success := SysUtils.FindFirst('C:\autoexec.bat', faAnyFile, SearchRec);
if (Success = 0) and
(( SearchRec.FindData.ftLastAccessTime.dwLowDateTime < > 0)
or ( SearchRec.FindData.ftLastAccessTime.dwHighDateTime < > 0))
then begin
FileTimeToLocalFileTime(SearchRec.FindData.ftLastAccessTime,DT);
FileTimeToSystemTime(DT,ST);
Memo1.Lines.Clear;
Memo1.Lines.Add('AutoExec.Bat was last accessed at:');
Memo1.Lines.Add('Year := ' + IntToStr(st.wYear));
Memo1.Lines.Add('Month := ' + IntToStr(st.wMonth));
Memo1.Lines.Add('DayOfWeek := ' + IntToStr(st.wDayOfWeek));
Memo1.Lines.Add('Day := ' + IntToStr(st.wDay));
Memo1.Lines.Add('Hour := ' + IntToStr(st.wHour));
Memo1.Lines.Add('Minute := ' + IntToStr(st.wMinute));
Memo1.Lines.Add('Second := ' + IntToStr(st.wSecond));
Memo1.Lines.Add('Milliseconds := ' + IntToStr(st.wMilliseconds));
end;
SysUtils.FindClose(SearchRec);
end;

27. Jak znaleźć datę ostatniej modyfikacji pliku?

function GetFileDate(FileName: string): string;
var FHandle: Integer;
begin
FHandle := FileOpen(FileName, 0);
try
Result := DateTimeToStr(FileDateToDateTime(FileGetDate(FHandle)));
finally FileClose(FHandle);
end; end;

28. Zmiana daty systemowej inna wersja.

procedure TForm1.Button1Click(Sender: TObject);
begin
SetNewTime(1998,2,10,18,07);
end;

function SetNewTime(Ano, Mes, Dia, hour, minutes: word): Boolean;
var st:TSYSTEMTIME;
begin
GetLocalTime(st); st.wYear := Ano; st.wMonth := Mes;
st.wDay := Dia; st.wHour := hour; st.wMinute := minutes;
if not SetLocalTime(st) then Result := False
else
Result := True;
end;

29. Sprawdzenie daty.

function dateexists(date: string; separator: char): boolean;
var olddateseparator: char;
begin
result := true; olddateseparator := dateseparator;
dateseparator := separator;
try try strtodate(date);
except
result := false; end;
finally dateseparator := olddateseparator; end;
end;

procedure tform1.formcreate(sender: tobject);
begin
if dateexists('35.3.2001', '.') then
begin
{tutaj możesz wstawić swój kod -- reakcja na datę!}
end; end;