psa1974
Full Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
procedure TForm1.Button2Click(Sender: TObject);
const
cFormTime = 30000; // интервал времени перерисовки формы
cSpickerTime = 40000; // интервал времени издавания звука
cQueryTime = 60000; // интервал времени запроса на подтверждение
csharTyme = 20000; // интервал времени рисования шариков
var
CurrentTime, FormTime, SpickerTime, QueryTime, sharTyme: DWORD;
X, Y, R: Integer;
shar: TColor;
begin
CurrentTime:= GetTickCount; // текущий тик времени
FormTime:= CurrentTime;
SpickerTime:= CurrentTime;
QueryTime:= CurrentTime;
sharTyme:= CurrentTime;
Button2.Enabled:= False;
try
while True do // в цикле пока не получим утведит. ответ об окончании
begin
CurrentTime:= GetTickCount; // получаем новый тик времени
if (CurrentTime - FormTime) >= cFormTime then
// если интервал времени между новым тиком и тем, в кот. прошлый раз была
// перерисовка цвета формы превысил требуемое значение, то:
begin
Form1.Color:= Random($FFFFFF);
FormTime:= CurrentTime; // запоминаем этот тик
end;
if (CurrentTime - SpickerTime) >= cSpickerTime then
// аналогично для спикера:
begin
Beep;
SpickerTime:= CurrentTime;
end;
if (CurrentTime - QueryTime) >= cQueryTime then
// аналогично для запроса на продолжение:
begin
if MessageDlg('Продолжить?', mtConfirmation, [mbYes, mbNo], 0, mbYes) = mrNo then
Break
else
// в течении времени пока вы думаете отвечать или нет, тики все равно идут.
// если это время на раздумывание не учитывать, то после ответа программа
// "наверстает" упущенное время, одновременно на следующем шаге цикла
// выполнив все перерисовки, бипы спикером и задав при этом опять вопрос.
// Следующий блок begin..end позволяет "пропустить" время раздумывания:
begin
Inc(FormTime, GetTickCount- CurrentTime);
Inc(SpickerTime, GetTickCount- CurrentTime);
Inc(sharTyme, GetTickCount- CurrentTime);
end;
QueryTime:= GetTickCount;
end;
if (CurrentTime - sharTyme) >= csharTyme then
begin
Form1.Refresh;
X := Random(Min(ClientHeight, ClientWidth)); // чтобы центр не выходил за пределы клиентской части окна
Y := Random(Min(ClientHeight, ClientWidth)); // чтобы центр не выходил за пределы клиентской части окна
R := Random(Min(ClientHeight, ClientWidth)) div 2; // чтобы радиус был меньше половины клиентской части окна
shar := TColor(Random($FFFFFF));
Canvas.Ellipse(X-R, Y-R, X+R, Y+R);
Canvas.Pen.Color := Form1.Color;
Canvas.Pen.Color :=shar;
Canvas.Brush.Color :=shar;
Canvas.Ellipse(X-R, Y-R, X+R, Y+R);
sharTyme:= CurrentTime;
end;
Application.ProcessMessages;
end;
finally
Button2.Enabled:= True;
end;
end;
|
Всего записей: 438 | Зарегистр. 08-11-2005 | Отправлено: 20:35 18-12-2009 | Исправлено: psa1974, 21:32 18-12-2009 |
|
