Вопросы и ответы - Delphi - Работа с датами и временем - Библиотека программиста
Пользователь

Добро пожаловать,

Регистрация или входРегистрация или вход
Потеряли пароль?Потеряли пароль?

Ник:
Пароль:

Меню сайта




Ваше мнение
Как вы оцените наш сайт?

Замечательный
Хороший
Обычный
Плохой
Отвратительный


Результаты
Другие опросы

Всего голосов: 846
Комментарии: 10


Наши партнеры



Статистика




Programming books  Download software  Documentation  Scripts  Content Managment Systems(CMS)  Templates  Icon Sets  Articles  Contacts  Voting  Site Search




Вопросы и ответы - Delphi - Работа с датами и временем

                  
 
Вывод даты в нужном формате
Код
function CheckDateFormat(SDate: string): string;

var

IDateChar: string;

x, y: integer;

begin

IDateChar := '.,/';

for y := 1 to length(IDateChar) do

begin

x := pos(IDateChar[y], SDate);

while x > 0 do

begin

Delete(SDate, x, 1);

Insert('-', SDate, x);

x := pos(IDateChar[y], SDate);

end;

end;

CheckDateFormat := SDate;

end;





function DateEncode(SDate:string):longint;

var

year, month, day: longint;

wy, wm, wd: longint;

Dummy: TDateTime;

Check: integer;

begin

DateEncode := -1;

SDate := CheckDateFormat(SDate);

Val(Copy(SDate, 1, pos('-', SDate) - 1), day, check);

Delete(Sdate, 1, pos('-', SDate));

Val(Copy(SDate, 1, pos('-', SDate) - 1), month, check);

Delete(SDate, 1, pos('-', SDate));

Val(SDate, year, check);

wy := year;

wm := month;

wd := day;

try

Dummy := EncodeDate(wy, wm, wd);

except

year := 0;

month := 0;

day := 0;

end;

DateEncode := (year * 10000) + (month * 100) + day;

end;

Вычисление даты Пасхи
Код
function Easter(Year: Integer): TDateTime;

{----------------------------------------------------------------}

{ Вычисляет и возвращает день Пасхи определенного года. }

{ Идея принадлежит Mark Lussier, AppVision <MLussier@best.com>. }

{ Скорректировано для предотвращения переполнения целых, если по }

{ ошибке передан год с числом 6554 или более. }

{----------------------------------------------------------------}



var

nMonth, nDay, nMoon, nEpact, nSunday,

nGold, nCent, nCorx, nCorz: Integer;

begin

{ Номер Золотого Года в 19-летнем Metonic-цикле: }

nGold := (Year mod 19) + 1;

{ Вычисляем столетие: }

nCent := (Year div 100) + 1;

{ Количество лет, в течение которых отслеживаются високосные года... }

{ для синхронизации с движением солнца: }

nCorx := (3 * nCent) div 4 - 12;

{ Специальная коррекция для синхронизации Пасхи с орбитой луны: }

nCorz := (8 * nCent + 5) div 25 - 5;

{ Находим воскресенье: }

nSunday := (Longint(5) * Year) div 4 - nCorx - 10;

{ ^ Предохраняем переполнение года за отметку 6554}

{ Устанавливаем Epact - определяем момент полной луны: }

nEpact := (11 * nGold + 20 + nCorz - nCorx) mod 30;

if nEpact < 0 then

nEpact := nEpact + 30;

if ((nEpact = 25) and (nGold > 11)) or (nEpact = 24) then

nEpact := nEpact + 1;

{ Ищем полную луну: }

nMoon := 44 - nEpact;

if nMoon < 21 then

nMoon := nMoon + 30;

{ Позиционируем на воскресенье: }

nMoon := nMoon + 7 - ((nSunday + nMoon) mod 7);

if nMoon > l 31 then

begin

nMonth := 4;

nDay := nMoon - 31;

end

else

begin

nMonth := 3;

nDay := nMoon;

end;

Easter := EncodeDate(Year, nMonth, nDay);

end; {Easter}
Генерация еженедельных списков задач
Мне необходима программа, которая генерировала бы еженедельные списки задач. Программа должна просто показывать количество недель в списке задач и организовывать мероприятия, не совпадающие по времени. В моем текущем планировщике у меня имеется 12 групп и планы на 11 недель.

Мне нужен простой алгоритм, чтобы решить эту проблему. Какие идеи?

Вот рабочий код (но вы должны просто понять алгоритм работы):

Код
unit Unit1;



interface



uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls;



type

TForm1 = class(TForm)

ListBox1: TListBox;

Edit1: TEdit;

Button1: TButton;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;



var

Form1: TForm1;



implementation



{$R *.DFM}



const

maxTeams = 100;

var

Teams: array[1..maxTeams] of integer;

nTeams, ix, week, savix: integer;



function WriteBox(week: integer): string;

var

str: string;

ix: integer;

begin

Result := Format('Неделя=%d ', [week]);

for ix := 1 to nTeams do

begin

if odd(ix) then

Result := Result + ' '

else

Result := Result + 'v';

Result := Result + IntToStr(Teams[ix]);

end;

end;



procedure TForm1.Button1Click(Sender: TObject);

begin

nTeams := StrToInt(Edit1.Text);

if Odd(nTeams) then

inc(nTeams); {должны иметь номера каждой группы}

ListBox1.Clear;

for ix := 1 to nTeams do

Teams[ix] := ix;

ListBox1.Items.Add(WriteBox(1));



for week := 2 to nTeams - 1 do

begin

Teams[1] := Teams[nTeams - 1];

{используем Teams[1] в качестве временного хранилища}

for ix := nTeams downto 2 do

if not Odd(ix) then

begin

savix := Teams[ix];

Teams[ix] := Teams[1];

Teams[1] := savix;

end;

for ix := 3 to nTeams - 1 do

if Odd(ix) then

begin

savix := Teams[ix];

Teams[ix] := Teams[1];

Teams[1] := savix;

end;

Teams[1] := 1; {восстанавливаем известное значение}

ListBox1.Items.Add(WriteBox(week));

end;

end;



end.
Дни в месяце
Код
// Колическтво дней в любом месяце любого

// года можно получить с помощью EndOfAMonth



var

YYYY, MM, DD: Word;

D: TDateTime;

begin

DecodeDate(Date, YYYY, MM, DD);

D := EndOfAMonth(YYYY, {Номер месяца});

DecodeDate(D, YYYY, MM, DD); // DD - номер последнего дня в месяце

end;
За какое время было создано изображение
При нажатии на Button1 используется свойство Pixels, а при нажатии на Button2 - ScanLine. В заголовок окна выводится время в миллисекундах, за которое было создано изображение.

Код
procedure TForm1.Button1Click(Sender: TObject);

var

t: cardinal;

x, y: integer;

bm: TBitmap;

begin

bm := TBitmap.Create;

bm.PixelFormat := pf24bit;

bm.Width := Form1.ClientWidth;

bm.Height := Form1.ClientHeight;

t := GetTickCount;

for y := 0 to bm.Height - 1 do

for x := 0 to bm.Width - 1 do

bm.Canvas.Pixels[x,y] := RGB(x+y, x-y, y-x);

Form1.Caption := IntToStr(GetTickCount - t);

Form1.Canvas.Draw(0, 0, bm);

end;



procedure TForm1.Button2Click(Sender: TObject);

var

t: cardinal;

x, y: integer;

bm: TBitmap;

p: PByteArray;

begin

bm := TBitmap.Create;

bm.PixelFormat := pf24bit;

bm.Width := Form1.ClientWidth;

bm.Height := Form1.ClientHeight;

t := GetTickCount;

for y := 0 to bm.Height - 1 do

begin

p := bm.ScanLine[y];

for x := 0 to bm.Width - 1 do

begin

p^[x*3] := x+y;

p^[x*3+1] := x-y;

p^[x*3+2] := y-x;

end;

end;

Form1.Caption := IntToStr(GetTickCount - t);

Form1.Canvas.Draw(0, 0, bm);

end;
Использовать TTime для более 24 часов
Код
function TextToTime(S: string): Integer;

var

p, i: Integer;

Sh, Sm, Ss: string;

begin

Sh := '';

SM := '';

SS := '';

i := 1;

p := 0;

while i do

begin

if (s[i] <> ':') then

begin

case P of

0: SH := Sh + s[i];

1: SM := SM + S[i];

2: SS := SS + S[i];

end;

end

else

Inc(p);

Inc(i);

end;

try

Result := (StrToInt(SH) * 3600) + (StrToInt(SM) * 60) + (StrToInt(SS))

except

Result := 0;

end;

end;



function TimeToText(T: Integer): string;

var

H, M, S: string;

ZH, ZM, ZS: Integer;

begin

ZH := T div 3600;

ZM := T div 60 - ZH * 60;

ZS := T - (ZH * 3600 + ZM * 60);

if ZH then H := '0' + IntToStr(ZH)

else

H := IntToStr(ZH);

if ZM then M := '0' + IntToStr(ZM)

else

M := IntToStr(ZM);

if ZS then S := '0' + IntToStr(ZS)

else

S := IntToStr(ZS);

Result := H + ':' + M + ':' + S;

end;
Как засечь время
Засекание обычно нужно в двух случаях: самому программисту – узнать, как программа работает быстрее, или для информирования пользователя, сколько программа уже трудится.



Для засекания времени удобнее всего использовать функцию GetTickCount, но нельзя забывать о ее погрешности при измерении очень коротких промежутков времени, и о том, что программы в Windows работают с непостоянной скоростью. Поэтому не стоит засекать быстрые процессы, и не стоит делать выводы о каком-то алгоритме после одного тестирования. И еще. Если вы тестируете алгоритм, то поставьте его в цикл, выполнив его, например, тысячу раз, а потом получившееся время делите на тысячу. Так точнее. Эта программа засекает, сколько времени меняется цвет точек окна в этой программе.

Код
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;

Как конвертировать RFC дату и обратно?
Код
function DateTimeToRfcTime(

dt: TDateTime;

iDiff: integer;

blnGMT: boolean = false): string;

{*

Explanation:

iDiff is the local offset to GMT in minutes

if blnGMT then Result is UNC time else local time

e.g. local time zone: ET = GMT - 5hr = -300 minutes

dt is TDateTime of 3 Jan 2001 5:45am

blnGMT = true -> Result = 'Wed, 03 Jan 2001 05:45:00 GMT'

blnGMT = false -> Result = 'Wed, 03 Jan 2001 05:45:00 -0500'

*}

const

Weekday: array[1..7] of string =

('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');

Month: array[1..12] of string = (

'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',

'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');

var

iDummy: Word;

iYear: Word;

iMonth: Word;

iDay: Word;

iHour: Word;

iMinute: Word;

iSecond: Word;

strZone: string;

begin

if blnGMT then

begin

dt := dt - iDiff / 1440;

strZone := 'GMT';

end

else

begin

iDiff := (iDiff div 60) * 100 + (iDiff mod 60);

if iDiff < 0 then

strZone := Format('-%.4d', [-iDiff])

else

strZone := Format('+%.4d', [iDiff]);

end;

DecodeDate(dt, iYear, iMonth, iDay);

DecodeTime(dt, iHour, iMinute, iSecond, iDummy);

Result := Format('%s, %.2d %s %4d %.2d:%.2d:%.2d %s', [

Weekday[DayOfWeek(dt)], iDay, Month[iMonth], iYear,

iHour, iMinute, iSecond, strZone]);

end;



function RfcTimeToDateTime(

strTime: string;

blnGMT: boolean = true): TDateTime;

{*

Explanation:

if blnGMT then Result is UNC time else local time

e.g. local time zone: ET = GMT - 5hr = -0500

strTime = 'Wed, 03 Jan 2001 05:45:00 -0500'

blnGMT = true -> FormatDateTime('...', Result) = '03.01.2001 10:45:00'

blnGMT = false -> FormatDateTime('...', Result) = '03.01.2001 05:45:00'

*}

const

wd = 'sun#mon#tue#wed#thu#fri#sat';

month = 'janfebmaraprmayjunjulaugsepoctnovdec';

var

s: string;

dd: Word;

mm: Word;

yy: Word;

hh: Word;

nn: Word;

ss: Word;

begin

s := LowerCase(Copy(strTime, 1, 3));

if Pos(s, wd) > 0 then

Delete(strTime, 1, Pos(' ', strTime));

s := Trim(Copy(strTime, 1, Pos(' ', strTime)));

Delete(strTime, 1, Length(s) + 1);

dd := StrToIntDef(s, 0);

s := LowerCase(Copy(strTime, 1, 3));

Delete(strTime, 1, 4);

mm := (Pos(s, month) div 3) + 1;

s := Copy(strTime, 1, 4);

Delete(strTime, 1, 5);

yy := StrToIntDef(s, 0);

Result := EncodeDate(yy, mm, dd);

s := strTime[1] + strTime[2];

hh := StrToIntDef(strTime[1] + strTime[2], 0);

nn := StrToIntDef(strTime[4] + strTime[5], 0);

ss := StrToIntDef(strTime[7] + strTime[8], 0);

Delete(strTime, 1, 9);

Result := Result + EncodeTime(hh, nn, ss, 0);

if (CompareText(strTime, 'gmt') <> 0) and blnGMT then

begin

hh := StrToIntDef(strTime[2] + strTime[3], 0);

nn := StrToIntDef(strTime[4] + strTime[5], 0);

if strTime[1] = '+' then

Result := Result - EncodeTime(hh, nn, 0, 0)

else

Result := Result + EncodeTime(hh, nn, 0, 0);

end;

end;
Как определить день недели?
Код
procedure TForm1.Button1Click(Sender: TObject);

var

d: TDateTime;

begin

d := StrToDate(Edit1.Text);

ShowMessage(FormatDateTime('dddd',d));

end;




Также есть функции DayOfTheWeek и DayOfWeek (см. справку по Дельфи)
Как отчитывать промежутки времени с точностью, большей чем 60 мсек?
Для начала описываешь процедуру, которая будет вызываться по сообщению от таймера :


Код
procedure FNTimeCallBack(uTimerID, uMessage: UINT;dwUser, dw1, dw2: DWORD);stdcall;

begin

//

// Тело процедуры.

end;




а дальше в программе (например по нажатию кнопки) создаешь Таймер и вешаешь на него созданную процедуру


Код
uTimerID:=timeSetEvent(10,500,@FNTimeCallBack,100,TIME_PERIODIC);




И в конце убиваешь таймер:


Код
timeKillEvent(uTimerID);



И все. Точность этого способа до 1 мсек. минимальный интервал времени можно задавать 1 мсек.

Как подсчитать возраст по дню рождения?
Код
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;




Можно так:

Код
DecodeDate(DM.Table.FieldByName('Born').AsDateTime, Year, Month, Day); // Дата рождения

DecodeDate(Date, YYYY, MM, DD); // Текущая дата



if (MM >= Month) and (DD >= Day) then

Edit2.Text := IntToStr((YYYY - Year))

else

Edit2.Text := IntToStr((YYYY - Year) - 1);

Как получить дату по Юлианскому календарю?
Код
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 < 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;
Как преобразовать строку в дату?
Код распознаёт и русский и английский языки. Кстати вполне корректно обрабатывает и падежи типа:



2 мая 2002

май месяц 1999 года, 3е число

3е мая 1999 года

Солнечный апрельский день в 1998м году, 20е число



Корректно распознаёт что-нибудь типа



July 3, 99



но естественно не способен распознать



01-jan-03



т.е. год если двузначный, то должен быть больше 31. Иначе необоходим дополнительный параметер, указывающий годом считать первую или вторую найденную цифру в строке

Код
Function StringToDate(Temp:String):TDateTime;

type TDateItem=(diYear, diMonth, diDay, diUnknown);

TCharId=(ciAlpha, ciNumber, ciSpace);



//языковые настройки. Для включения нового языка добавляем раскладку сюда, дополняем тип alpha и меняем

//единственную строку где используется эта константа

const

eng_monthes:array[1..12] of string=('jan', 'feb', 'mar', 'apr', 'may', 'jun', 'jul', 'aug', 'sep', 'oct', 'nov', 'dec');

rus_monthes:array[1..12] of string=('янв', 'фев', 'мар', 'апр', 'ма', 'июн', 'июл', 'авг', 'сен', 'окт', 'ноя', 'дес');

alpha:set of char=['a'..'z','а'..'я'];



//временные переменные

var month, day, year:string;

temp1:string;

i, j:integer;

ci1, ci2:TCharId;



Function GetWord(var temp:string):string;

begin

//возвращаем следующее слово из строки и вырезаем это слово из исходной строки

if pos(' ', temp)>0 then

begin //берём слово до пробела

result:=trim(copy(temp, 1, pos(' ', temp)));

temp:=copy(temp, pos(' ', temp)+1, length(temp));

end

else //это последнее слово в строке

begin

result:=trim(temp);

temp:='';

end;

end;



Function GetDateItemType(temp:string):TDateItem;

var i, j:integer;

begin

//распознаём тип слова

i:=StrToIntDef(temp,0); //попытка преобразовать слово в цифру

Case i of

0: Result:=diMonth; //не число, значит или месяц или мусор

1..31:Result:=diDay;//числа от 1 до 31 считаем днём

else Result:=diYear;//любые другие числа считаем годами

End;

end;



Function GetCharId(ch:char):TCharId;

begin

//узнаём тип символа, нужно для распознавания "склееных" дней или лет с месяцем

Case ch of

' ':Result:=ciSpace;

'0'..'9':Result:=ciNumber;

else Result:=ciAlpha;

End;

end;







begin

temp:=trim(ansilowercase(temp));

month:='';

day:='';

year:='';

//замена любого мусора на пробелы

For i:=1 to length(temp) do

if not (temp[i] in alpha+['0'..'9']) then temp[i]:=' ';



//удаление лишних пробелов

while pos(' ', temp)>0 do

Temp:=StringReplace(temp, ' ',' ',[rfReplaceAll]);



//вставка пробелов если месяц слеплен с днём или годом

ci1:=GetCharId(temp[1]);

i:=1;

Repeat

inc(i);

ci2:=GetCharId(temp[i]);

if ((ci1=ciAlpha) and (ci2=ciNumber)) or ((ci1=ciNumber) and (ci2=ciAlpha)) then

insert(' ', temp, i);

ci1:=ci2;

Until i>=length(temp);



//собственно парсинг

while temp>'' do

begin

temp1:=GetWord(temp);

Case GetDateItemType(temp1) of

diMonth: if month='' then //только если месяц ещё не определён, уменьшает вероятность ошибочного результата

for i:=12 downto 1 do // обязателен отсчёт в обратную сторону чтоб не путать май и март

if (pos(eng_monthes[i],temp1)=1) or (pos(rus_monthes[i],temp1)=1) then //сюда добавляем ещё язык если надо

month:=inttostr(i);

diDay: Day:=temp1;

diYear: Year:=temp1;

End;

end;





//проверка - все ли элементы определены

if (month='') or (Day='') or (Year='') then raise Exception.Create('Could not be converted!');



//поправка на двузначный год

if length(year)<3 then year:='19'+year;



//кодирование результата

Result:=EncodeDate(Strtoint(Year), Strtoint(month), Strtoint(Day));

end;
Как реализовать визуальный отсчет времени
Код
var Min3: integer;



procedure TForm1.Button1Click(Sender: TObject);

begin

timer1.enabled:=true;

Min3:=3;

end;



procedure TForm1.Timer1Timer(Sender: TObject);

begin

Label1.Caption:=Format('%d : %2d',[Min3 div 60, Min3 mod 60 ]);

Dec(Min3);

if Min3 < 0 then

// Что-то делаешь - 3 минуты закончились

end;

Как узнать номер недели данного дня в году?
Вариант 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);

Result := Trunc(ADate - FirstOfYear) div 7 + 1;

end;





procedure TForm1.Button1Click(Sender: TObject);

begin

ShowMessage(IntToStr(WeekOfYear(Date)));

end;




Вариант 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;




Вариант 3:



Code:

Код
function WeekOfYear(Dat: TDateTime): Word;

// Интерпретация номеров дней:

// ISO: 1 = Понедельник, 7 = Воскресенье

// Delphi SysUtils: 1 = Воскресенье, 7 = Суббота

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;

Класс-оболочка для объекта синхронизации WaitableTimer
Код
{

>> Класс-оболочка для объекта синхронизации WaitableTimer.



Класс представляет собой оболочку для объекта синхронизации WaitableTimer,

существующего в операционных системах, основанных на ядре WinNT.



Методы.

--------------

Start - запуск таймера.



Stop - остановка таймера.



Wait - ожидает срабатывания таймера заданное количество миллисекунд и

возвращает результат ожидания.





Свойства.

--------------

Time : TDateTime - дата/время когда должен сработать таймер.



Period : integer - Период срабатывания таймера. Если значение равно 0, то

таймер срабатывает один раз, если же значение отлично от нуля, таймер будет

срабатывать периодически с заданным интервалом, первое срабытывание произойдет

в момент, заданный свойством Time.



LongTime : int64 - альтернативный способ задания времени срабатывания. Время

задается в формате UTC.



Handle : THandle (только чтение) - хендл обекта синхронизации.



LastError : integer (только чтение) - В случае если метод Wait возвращает

wrError, это свойство содержит значение, возвращаемое функцией GetLastError.



Зависимости: Windows, SysUtils, SyncObjs

Автор: vuk

Copyright: Алексей Вуколов

Дата: 25 апреля 2002 г.

********************************************** }



unit wtimer;



interface



uses

Windows, SysUtils, SyncObjs;



type



TWaitableTimer = class( TSynchroObject )

protected

FHandle : THandle;

FPeriod : longint;

FDueTime : TDateTime;

FLastError: Integer;

FLongTime: int64;

public



constructor Create( ManualReset : boolean;

TimerAttributes: PSecurityAttributes; const Name : string );

destructor Destroy; override;



procedure Start;

procedure Stop;

function Wait( Timeout : longint ) : TWaitResult;



property Handle : THandle read FHandle;

property LastError : integer read FLastError;

property Period : integer read FPeriod write FPeriod;

property Time : TDateTime read FDueTime write FDueTime;

property LongTime : int64 read FLongTime write FLongTime;



end;







implementation





{ TWaitableTimer }



constructor TWaitableTimer.Create(ManualReset: boolean;

TimerAttributes: PSecurityAttributes; const Name: string);

var

pName : PChar;

begin

inherited Create;

if Name = '' then pName := nil else

pName := PChar( Name );

FHandle := CreateWaitableTimer( TimerAttributes, ManualReset, pName );

end;



destructor TWaitableTimer.Destroy;

begin

CloseHandle(FHandle);

inherited Destroy;

end;



procedure TWaitableTimer.Start;

var

SysTime : TSystemTime;

LocalTime, UTCTime : FileTime;

Value : int64 absolute UTCTime;



begin

if FLongTime = 0 then

begin

DateTimeToSystemTime( FDueTime, SysTime );

SystemTimeToFileTime( SysTime, LocalTime );

LocalFileTimeToFileTime( LocalTime, UTCTime );

end else

Value := FLongTime;

SetWaitableTimer( FHandle, Value, FPeriod, nil, nil, false );

end;



procedure TWaitableTimer.Stop;

begin

CancelWaitableTimer( FHandle );

end;



function TWaitableTimer.Wait(Timeout: Integer): TWaitResult;

begin

case WaitForSingleObjectEx(Handle, Timeout, BOOL(1)) of

WAIT_ABANDONED: Result := wrAbandoned;

WAIT_OBJECT_0: Result := wrSignaled;

WAIT_TIMEOUT: Result := wrTimeout;

WAIT_FAILED:

begin

Result := wrError;

FLastError := GetLastError;

end;

else

Result := wrError;

end;

end;





end.




Пример использования:

Пример создания таймера, который срабатывает по алгоритму "завтра в это же время и далее с интервалом в одну минуту".

Код

var

Timer : TWaitableTimer;

....

begin

Timer := TWaitableTimer.Create(false, nil, '');

Timer.Time := Now + 1; //завтра в это же время

Timer.Period := 60 * 1000; //Интервал в 1 минуту

Timer.Start; //запуск таймера

....


Конвертируем TDateTime to Unix Timestamp
Код
unit unix_utils;



interface



implementation



const

// Sets UnixStartDate to TDateTime of 01/01/1970

UnixStartDate: TDateTime = 25569.0;



function DateTimeToUnix(ConvDate: TDateTime): Longint;

begin

//example: DateTimeToUnix(now);

Result := Round((ConvDate - UnixStartDate) * 86400);

end;



function UnixToDateTime(USec: Longint): TDateTime;

begin

//Example: UnixToDateTime(1003187418);

Result := (Usec / 86400) + UnixStartDate;

end;



end.
Конвертируем Unix дату
Код
const

UnixDateDelta = 25569; { 1970-01-01T00:00:00,0 }

SecPerMin = 60;

SecPerHour = SecPerMin * 60;

SecPerDay = SecPerHour * 24;

MinDayFraction = 1 / (24 * 60);



{Convert Unix time to TDatetime}



function UnixTimeToDateTime(AUnixTime: DWord; ABias: Integer): TDateTime;

begin

Result := UnixDateDelta + (AUnixTime div SecPerDay) { Days }

+ ((AUnixTime mod SecPerDay) / SecPerDay) { Seconds }

- ABias * MinDayFraction { Bias to UTC in minutes };

end;



{Convert Unix time to String with locale settings}



function UnixTimeToStr(AUnixTime: DWord; ABias: Integer): string;

begin

Result := FormatDateTime('ddddd hh:nn:ss', UnixTimeToDateTime(AUnixTime, ABias));

end;



{Convert TDateTime to Unix time}



function DateTimeToUnixTime(ADateTime: TDateTime; ABias: Integer): DWord;

begin

Result := Trunc((ADateTime - UnixDateDelta) * SecPerDay) + ABias * SecPerMin;

end;



procedure TForm1.Button4Click(Sender: TObject);

begin

Label1.Caption := UnixTimeToStr(977347109, -60);

end;
Математика времени
Работа с временными величинами в Delphi очень проста, если пользоваться встроенными функциями преобразования. Определите глобальные Hour, Minute, Second и инициализируйте их следующим образом:

Код
Hour := EncodeTime(1,0,0,0);

Minute := EncodeTime(0,1,0,0);

Second := EncodeTime(0,0,1,0);



Или, если вы предпочитаете константы, сделайте так:

Код
Hour = 3600000/MSecsPerDay;

Minute = 60000/MSecsPerDay;

Second = 1000/MSecsPerDay;



Теперь для того, чтобы добавить 240 минут к переменной TDateTime, просто сделайте

T := T + 240*Minute;

Название месяца --> номер месяца
Код
function NumMonth(SMonth: string): word;

var

i: byte;

begin

Result := 0;

for i := 1 to 12 do

if AnsiUpperCase(SMonth) = Month[i] then

Result := i

end;


Печать страницы
Печать страницы




Внимание! Если у вас не получилось найти нужную информацию, используйте рубрикатор или воспользуйтесь поиском


.



книги по программированию исходники компоненты шаблоны сайтов C++ PHP Delphi скачать