Добро пожаловать,
Вывод даты в нужном формате
Код 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;
Печать страницы
Всего 39 на 2 страницах по 20 на каждой странице 1 2 >>
Внимание! Если у вас не получилось найти нужную информацию, используйте
рубрикатор или воспользуйтесь
поиском .
книги по программированию исходники компоненты шаблоны сайтов C++ PHP Delphi скачать