Таблица Шульте

program Shulte;
 
uses GraphABC, Timers, System;
 
var
  a: array[1..25] of integer;
  tofind: integer;
  t: DateTime;
  timerr: Timer;
 
procedure proc;
 
begin
  SetFontSize(10);
  textout(280, 70, 'Времени прошло: ' + (DateTime.Now - t).Seconds + ' сек.');
  SetFontSize(22);
end;
 
procedure MouseDown(x, y, mb: integer);
 
begin
  if (x > 100) and (x < 600) and (y > 100) and (y < 600) then
    if a[x div 100 + (y div 100 - 1) * 5] = tofind then
      if tofind = 1 then
      begin
        inc(tofind);
        textout(200, 30, 'Следующее число: ' + tofind);
        t := DateTime.Now;
        proc;
        timerr.Start;
      end
      else if tofind = 25 then
      begin
        fillrect(280, 70, 700, 99);
        var tt := DateTime.Now - t;
        textout(200, 30, 'Ваше время: ' + tt.Seconds + '.' + tt.Milliseconds + ' сек.');
        timerr.Stop;
      end
      else
      begin
        inc(tofind);
        textout(200, 30, 'Следующее число: ' + tofind);
      end;
end;
 
begin
  SetWindowSize(700, 700);
  SetWindowIsFixedSize(true);
  CenterWindow;
  SetFontSize(22);
  for var i := 1 to 6 do
  begin
    line(i * 100, 100, i * 100, 600);
    line(100, i * 100, 600, i * 100);
  end;
  for var i := 1 to 25 do
    a[i] := i;
  for var i := 1 to 25 do
    swap(a[i], a[PABCSystem.Random(25) + 1]);
  for var i := 1 to 25 do
    if a[i] < 10 then
      textout(((i - 1) mod 5 + 1) * 100 + 42, ((i - 1) div 5 + 1) * 100 + 35, a[i])
    else
      textout(((i - 1) mod 5 + 1) * 100 + 35, ((i - 1) div 5 + 1) * 100 + 35, a[i]);
  textout(200, 30, 'Следующее число: 1');
  tofind := 1;
  timerr := new Timer(1000, proc);
  OnMouseDown := MouseDown;
end.

program Shulte;
 
uses GraphABC, Timers, System, Events, Utils;
 
var
  a: array[1..25] of integer;
  tofind: integer;
  tmil: integer;
  timerr: integer;
 
 
procedure proc;
begin
  SetFontSize(10);
  textout(280, 70, 'Времени прошло: ' + IntToStr((Milliseconds-tmil) div 1000) + ' сек.');
  SetFontSize(22);
end;
 
procedure MouseDown(x,y,mousebutton: integer);
var tt : integer;
begin
  if (x > 100) and (x < 600) and (y > 100) and (y < 600) then
    if a[x div 100 + (y div 100 - 1) * 5] = tofind then
      if tofind = 1 then
      begin
        inc(tofind);
        textout(200, 30, 'Следующее число: ' + IntToStr(tofind));
        tmil:=Milliseconds;
        proc;
      end
      else if tofind = 25 then
      begin
        fillrect(280, 70, 700, 99);
        tt := Milliseconds - tmil;
        textout(200, 30, 'Ваше время: ' + IntToStr(tt div 1000) + '.' + IntToStr(tt mod 1000) + ' сек.');
        StopTimer(timerr);
      end
      else
      begin
        inc(tofind);
        textout(200, 30, 'Следующее число: ' + IntToStr(tofind));
      end;
end;
 
procedure swap(var a,b:integer);
var tmp : integer;
begin
  tmp := a; a:=b; b := tmp
end;
 
 
 
var i : integer;
begin
  SetWindowSize(700, 700);
  CenterWindow;
  SetFontSize(22);
  for i := 1 to 6 do
  begin
    line(i * 100, 100, i * 100, 600);
    line(100, i * 100, 600, i * 100);
  end;
  for i := 1 to 25 do
    a[i] := i;
  for i := 1 to 25 do
    swap(a[i], a[Random(25) + 1]);
  for i := 1 to 25 do
    if a[i] < 10 then
      textout(((i - 1) mod 5 + 1) * 100 + 42, ((i - 1) div 5 + 1) * 100 + 35, IntToStr(a[i]))
    else
      textout(((i - 1) mod 5 + 1) * 100 + 35, ((i - 1) div 5 + 1) * 100 + 35, IntToStr(a[i]));
  textout(200, 30, 'Следующее число: 1');
  tofind := 1;
  timerr:=CreateTimer(1000, proc);
  StartTimer(timerr);
  OnMouseDown := MouseDown;
end.