Математика времени и временные интервалы

Генерация еженедельных списков задач

2013-09-16T21:40:45+07:00

Автор: Mike Orriss

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

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

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

Code:

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 := 1to nTeams do

begin

if odd(ix) then

Result := Result + ' '

else

Result := Result + 'v';

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

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

nTeams := StrToInt(Edit1.Text);

if Odd(nTeams) then

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

ListBox1.Clear;

for ix := 1to nTeams do

Teams[ix] := ix;

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

for week := 2to nTeams - 1do

begin

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

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

for ix := nTeams downto2do

ifnot Odd(ix) then

begin

savix := Teams[ix];

Teams[ix] := Teams[1];

Teams[1] := savix;

end;

for ix := 3to nTeams - 1do

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.

Допустимые периоды истечения времени

2013-09-16T21:39:59+07:00

Code:

{

Retrieves information about the time-out period associated

with the accessibility features.

The pvParam parameter must point to an ACCESSTIMEOUT

structure that receives the information.

Set the cbSize member of this structure and the

uiParam parameter to SizeOf(ACCESSTIMEOUT).

}

// ACCESSTIMEOUT structure

type

TAccessTimeOut = record

cbSize: UINT;

dwFlags: DWORD;

iTimeOutMSec: DWORD;

end;

procedure GetAccessTimeOut(var bTimeOut: Boolean; var bFeedBack: Boolean;

var iTimeOutTime: Integer);

// bTimeOut: the time-out period for accessibility features.

// bFeedBack: the operating system plays a descending

// siren sound when the time-out period elapses and the

// Accessibility features are turned off.

// iTimeOutTime: Timeout in ms

var

AccessTimeOut: TAccessTimeOut;

begin

ZeroMemory(@AccessTimeOut, SizeOf(TAccessTimeOut));

AccessTimeOut.cbSize := SizeOf(TAccessTimeOut);

SystemParametersInfo(SPI_GETACCESSTIMEOUT, SizeOf(AccessTimeOut), @AccessTimeOut, 0);

bTimeOut := (AccessTimeOut.dwFlags and ATF_TIMEOUTON) = ATF_TIMEOUTON;

bFeedBack := (AccessTimeOut.dwFlags and ATF_ONOFFFEEDBACK) = ATF_ONOFFFEEDBACK;

iTimeOutTime := AccessTimeOut.iTimeOutMSec;

end;

// Test it:

procedure TForm1.Button2Click(Sender: TObject);

var

bTimeOut, bFeedBack: Boolean;

iTimeOutTime: Integer;

begin

GetAccessTimeOut(bTimeOut, bFeedBack, iTimeOutTime);

label1.Caption := IntToStr(Ord(bTimeOut));

Label2.Caption := IntToStr(Ord(bFeedBack));

Label3.Caption := IntToStr(iTimeOutTime);

end;

{

Sets the time-out period associated with the accessibility features.

The pvParam parameter must point to anACCESSTIMEOUT structure that

contains the new parameters.

Set the cbSize member of this structure and the uiParam

parameter to sizeof(ACCESSTIMEOUT).

}

{

Setzt Informationen zu den ACCESSEDTIMEOUT-Eigenschaften.

"uiParam" erwartet die Gro?e der ACCESSEDTIMEOUT-Struktur,

die in "pvParam" ubergeben werden muss.

}

procedure SetAccessTimeOut(bTimeOut, bFeedBack: Boolean; iTimeOutTime: Integer);

// bTimeOut: If true, a time-out period has been set for accessibility features.

// bFeedBack: If true, the operating system plays a descending

// siren sound when the time-out period elapses and the

// accessibility features are turned off.

// iTimeOutTime: Timeout in ms

var

AccessTimeOut: TAccessTimeOut;

begin

ZeroMemory(@AccessTimeOut, SizeOf(TAccessTimeOut));

AccessTimeOut.cbSize := SizeOf(TAccessTimeOut);

case bTimeOut of

True: AccessTimeOut.dwFlags := ATF_TIMEOUTON;

False: AccessTimeOut.dwFlags := 0;

end;

if bFeedBack then

AccessTimeOut.dwFlags := AccessTimeOut.dwFlags or ATF_ONOFFFEEDBACK;

AccessTimeOut.iTimeOutMSec := iTimeOutTime;

SystemParametersInfo(SPI_SETACCESSTIMEOUT, SizeOf(AccessTimeOut),

@AccessTimeOut, SPIF_UPDATEINIFILE or SPIF_SENDWININICHANGE);

end;

// Test it:

procedure TForm1.Button1Click(Sender: TObject);

begin

SetAccessTimeOut(True, True, 600000); // 10 min. timeout

end;

За какое время было создано изображение

2013-09-16T21:41:41+07:00

Автор: Даниил Карапетян

WEB сайт: https://program.dax.ru

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

Code:

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 := 0to bm.Height - 1do

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

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 := 0to bm.Height - 1do

begin

p := bm.ScanLine[y];

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

begin

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

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

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

end;

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

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

end;

Использовать TTime для более 24 часов

2013-09-16T21:42:26+07:00

Code:

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;

function TimeToText(T: Integer): string;

var

H, M, S: string;

ZH, ZM, ZS: Integer;

begin

ZH := T div3600;

ZM := T div60 - 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;

Как засечь время

2013-09-16T21:20:27+07:00

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

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

Code:

procedure TForm1.Button1Click(Sender: TObject);

var

i, t: integer;

begin

t := GetTickCount;

randomize;

for i := 0to100000do

Form1.Canvas.Pixels[i mod Form1.ClientWidth, i div Form1.ClientWidth] := RGB(random(255), random(255), random(255));

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

end;

Автор советов: Даниил Карапетян

e-mail: delphi4all@narod.ru

Автор справки: Алексей Денисов

e-mail: aleksey@sch103.krasnoyarsk.su

Как подсчитать возраст по дню рождения?

2013-09-16T21:18:42+07:00

Code:

{ BrthDate: Date of birth }

function TFFuncs.CalcAge(brthdate: TDateTime): Integer;

var

month, day, year, bmonth, bday, byear: word;

begin

DecodeDate(BrthDate, byear, bmonth, bday);

if bmonth = 0then

result := 0

else

begin

DecodeDate(Date, year, month, day);

result := year - byear;

if (100 * month + day) < (100 * bmonth + bday) then

result := result - 1;

end;

Code:

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)

elseif Month = CurrentMonth then

if (Day > CurrentDay) then

dec(Age);

end;

Label1.Caption := IntToStr(Age);

end;

Взято с Delphi Knowledge Base: https://www.baltsoft

Code:

function CalculateAge(Birthday, CurrentDate: TDate): Integer;

var

Month, Day, Year, CurrentYear, CurrentMonth, CurrentDay: Word;

begin

DecodeDate(Birthday, Year, Month, Day);

DecodeDate(CurrentDate, CurrentYear, CurrentMonth, CurrentDay);

if (Year = CurrentYear) and (Month = CurrentMonth) and (Day = CurrentDay) then

begin

Result := 0;

end

else

begin

Result := CurrentYear - Year;

if (Month > CurrentMonth) then

Dec(Result)

else

begin

if Month = CurrentMonth then

if (Day > CurrentDay) then

Dec(Result);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

Label1.Caption := Format('Your age is %d',

[CalculateAge(StrToDate('01.01.1903'), Date)]);

end;

Взято с сайта: https://www.swissdelphicenter.

Code:

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);

https://delphiworld.narod.

Как реализовать визуальный отсчет времени

2013-09-16T21:43:00+07:00

Code:

var Min3: integer;

procedure TForm1.Button1Click(Sender: TObject);

begin

timer1.enabled:=true;

Min3:=3*60;

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

Label1.Caption:=Format('%d : %2d',[Min3 div60, Min3 mod60 ]);

Dec(Min3);

if Min3 < 0then

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

end;

Математика времени

2013-09-16T21:21:24+07:00

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

Code:

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

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

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

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

Code:

Hour = 3600000/MSecsPerDay;

Minute = 60000/MSecsPerDay;

Second = 1000/MSecsPerDay;

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

T := T + 240*Minute;

https://delphiworld.narod.

DelphiWorld 6.0

Есть более простой путь для работы с датой и временем чем прибегать к функциям зашитым в DateUtil. На самом деле тип TDateTime является обычным real - числом с плавающей точкой, который содержит количество дней прошедших с 30 декабря 1899 года (под Windows) или с 1 января 1900 года под Linux. Таким образом целая часть - есть дни. Чтобы взять дату днём позже достаточно просто прибавить 1, неделей позже - прибавить 7. Дробная часть даты это время, причём в днях, т.е. 1 час это 1/24 или 0.0416(6), 1 минута будет равна 1/(24*60), а одна секунда соответственно 1/(24*3600). Ну дальше всё просто... не сложнее арифметики за 3 класс очень средней школы...

Округление времени

2013-09-16T21:35:15+07:00

Code:

function RoundTime(ADate: string; Rounding: Integer; bRound: Boolean): string;

var

Year, Month, Day, Hour, Min, Sec, MSec: Word;

tmpDate: TDateTime;

Res, Diff: string;

M: integer;

begin

tmpDate := StrToDateTime(ADate);

DecodeTime(tmpDate, Hour, Min, Sec, MSec);

if (Rounding > 0) and (bRound = True) then

begin

if Min mod Rounding = 0then

Res := IntToStr(Min)

else

Res := IntToStr(Round(Min / Rounding) * Rounding);

M := StrToInt(Copy(ADate, Length(ADate) - 1, 2));

Diff := IntToStr(StrToInt(Res) - M);

if Copy(Diff, 1, 1) = '-'then

begin

Diff := Copy(Diff, 2, Length(Diff) - 1);

Result := FormatDateTime('dd.mm.yy hh:mm', (tmpDate - StrToTime('00:00' + Diff)));

end

else

Result := FormatDateTime('dd.mm.yy hh:mm', (tmpDate + StrToTime('00:00' + Diff)));

end

else

Result := ADate;

end;

// Example:

procedure TForm1.Button1Click(Sender: TObject);

begin

Edit1.Text := FormatDateTime('dd.mm.yy hh:mm', Now);

Edit2.Text := RountTime(Edit1.Text, SpinEdit1.Value, Checkbox1.Checked);

// Example: RoundTime('07.08.02 10:41', '15', True) -- > 07.08.02 10:45

end;

Получение целого числа часов от начала суток

2013-09-16T21:36:09+07:00

Code:

{ **** UBPFD *********** by delphibase.endimus****

>> Получение целого числа часов от начала суток

Возвращает целое число часов от начала суток.

Пример: для "11:25:00" будет возвращено значение "11"

Зависимости: System, SysUtils

Автор: savva, savvanm.ru, ICQ:126578975, Орел

Дата: 6 июня 2002 г.

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

function GetСurrentHour: integer;

begin

result := Round(Time * 24);

end;

Прибавить час

2013-09-16T21:36:57+07:00

Тип TDateTime, используемый для передачи даты и времени, это тип double, у которого целая часть определяет день, а дробная время от полуночи. То есть, если прибавить ко времени 1, то дата изменится на один день, а время не изменится. Если прибавить 0.5, то прибавится 12 часов. Причем этот метод работает даже в том случае, когда меняется дата, месяц или год.

Code:

procedure TForm1.Timer1Timer(Sender: TObject);

begin

Label1.Caption := DateTimeToStr(Time);

Label2.Caption := DateTimeToStr(Time + 1 / 24);

end;

Работа со временем или как реализовать 1.20+1.50=3.10 ?

2013-09-16T20:45:36+07:00

Автор: Hans Pieters

Если Вы создаёте приложение, в котором пользователь вводит значения времени, то стандартные вычисления не подойдут. Проблема в том, что нужно сделать так, чтобы выражение 1.20 + 1.70 было равно НЕ 2.90 а 3.10.

Здесь представлены три функции, которые решают эту проблему. Они работают только с часами и минутами, потому что пользователь очень редко используют секунды, но если Вам потребуются секунды, то Вы без труда сможете доработать эти функции по своему желанию. Вторая и третья функции позволяют преобразовать реальное значение времени в десятичный эквивалент и обратно. Все поля на форме будут в формате hh.mm.

Code:

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;

Использование:

// 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)

Взято из https://forum.sources

Сложение времени

2013-09-16T21:37:49+07:00

Здесь представлены три функции, которые решают эту проблему. Они работают только с часами и минутами, потому что пользователь очень редко используют секунды, но если Вам потребуются секунды, то Вы без труда сможете доработать эти функции по своему желаню. Вторая и третья функции позволяют преобразовать реальное значение времени в десятичный эквивалент и обратно. Все поля на форме будут в формате hh.mm.

Code:

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;

// ************************************** //

// Использование: //

// ************************************** //

// 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) //

// ************************************** //

Сравнить быстродействие алгоритмов

2013-09-16T21:38:59+07:00

Если вас сколько-нибудь интересует скорость работы вашей программы, то нужно смерить скорость алгоритмов и сравнивать их. Здесь я привожу пример, сравнивающий четыре способа возведения 2 в степень 30.

Code:

uses Math;

procedure TForm1.Button1Click(Sender: TObject);

var

Res, Exponent: integer;

Res1: real;

t, i: integer;

begin

Exponent := 30;

Application.ProcessMessages;

t := GetTickCount;

for i := 1to1000000do

Res := 1shl Exponent;

Form1.Caption := Form1.Caption + ' ' +

IntToStr(GetTickCount - t);

Application.ProcessMessages;

t := GetTickCount;

for i := 1to1000000do

Res1 := LdExp(1, Exponent);

Form1.Caption := Form1.Caption + ' ' +

IntToStr(GetTickCount - t);

Application.ProcessMessages;

t := GetTickCount;

for i := 1to1000000do

Res1 := IntPower(2, Exponent);

Form1.Caption := Form1.Caption + ' ' +

IntToStr(GetTickCount - t);

Application.ProcessMessages;

t := GetTickCount;

for i := 1to1000000do

Res1 := Power(2, Exponent);

Form1.Caption := Form1.Caption + ' ' +

IntToStr(GetTickCount - t);

end;