Автор: 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;

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;

 

end.

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;

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;

 

 

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

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;

end;

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

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

end;

Работа с временными величинами в 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 класс очень средней школы...

 

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;

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;

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;

 

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

 

Для засекания времени удобнее всего использовать функцию 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: Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра.

 

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

e-mail: Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра.

Code:

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

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

 

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

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

 

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

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

Copyright: Сапронов Алексей (Savva)

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

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

 

function GetСurrentHour: integer;

begin

result := Round(Time * 24);

end;

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;

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;

end;

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.

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

 

 

Code:

procedure TForm1.Timer1Timer(Sender: TObject);

begin

Label1.Caption := DateTimeToStr(Time);

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

end;