Автор: 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; |
- Подробности
- Родительская категория: Работа с датами и временем
- Категория: Математика времени и временные интервалы
Страница 1 из 2