Анимированное заполнение ячеек таблицы StringGrid разными способами

[Вадим Мошев]

Кстати, можно вообще обойтись без GetTickCount и использовать sleep в сочетании с application.Processmessages.

1. берём изначальный код, который нам дал dubsteppaman
2. Преобразуем один из вариантов обхода таки образом:

//================ Заполнение Змейкой слева ===============
Procedure Left_Snake(var m,n:integer; StringGrid1:TStringGrid);
  var i,j: integer;
Begin
with StringGrid1 do
    begin
      m:=RowCount-1;
      n:=ColCount-1;
          for i:=1 to m do
            for j:=1 to n do begin
              If odd(i) then Cells[j,i]:=IntToStr((i-1)*n+j) else Cells[j,i]:=IntToStr(i*n-j+1);
              application.ProcessMessages;
              sleep(300);
            end;
    end;
end;

Я добавил синие строки и всё. Посмотрите не результат.

[Sibedir]

Сообщение от Вадим Мошев

Я добавил синие строки и всё. Посмотрите не результат.

не А. Подтормаживает на слипах.

[dubsteppaman]

Sibedir, мне ваш вариант кажется попроще, только как связать скорость заполнения с положением TrackBar?

[Аватар]

Ни чего он не проще варианта с таймером, а процессор сильнее будет грузить

[Sibedir]

Сообщение от Аватар

Ни чего он не проще варианта с таймером, а процессор сильнее будет грузить

Не уверен.

procedure TApplication.Run;
begin
...
      repeat
        try
          HandleMessage;
        except
          HandleException(Self);
        end;
      until Terminated;
...
end;

Хотя можно и так

var
  ArrCell: array of TPoint;
  curCell: Integer = 0;

//================ Заполнение "змейкой cлева" ===============
Procedure Left_Snake (var m,n:integer; StringGrid1:TStringGrid);
var
  i,j,k: integer;
begin
  with StringGrid1 do begin
    m := RowCount - 1;
    n := ColCount - 1;
    k := 0;
    SetLength (ArrCell, m*n);
    for i:=1 to m do
     for j:=1 to n do begin
       if odd(i) then ArrCell[k].X := j
       else ArrCell[k].X := n-j+1;
       ArrCell[k].Y := i;
       Inc(k);
     end;
  end;
end;

//============== Формирование интерфейса программы ============
procedure TForm1.FormCreate(Sender: TObject);
var i,j: integer;
begin
  Memo1.Clear;
  SpinEdit1.Value := 5;
  SpinEdit2.Value := 4;
  StringGrid1.Cells[0,0]:='  Табл.';
  Stop;
  TrackBar1.Position := 200;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  Timer1.Interval := TrackBar1.Position;
end;

procedure TForm1.Start;
begin
  if Length (ArrCell) = 0 then Exit;
  curCell := 0;
  Timer1.Enabled := True;
end;

procedure TForm1.Stop;
begin
  Timer1.Enabled := False;
  SetLength (ArrCell, 0);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  StringGrid1.Cells [ArrCell[curCell].X, ArrCell[curCell].Y] := IntToStr(curCell + 1);
  Inc (curCell);
  if curCell = Length(ArrCell) then
    Timer1.Enabled := False;
end;

//======================== Кнопка "Заполнить" =======================
procedure TForm1.Button2Click(Sender: TObject);
begin
  Stop;
   case RadioGroup1.ItemIndex of
      -1: MessageDlg('Выберите способ заполнения!', mtInformation, [mbOk], 0);
      0: Random_Fill(m,n,StringGrid1);
    // 1: Horizontal(m,n,StringGrid1);
    // 2: Vertical(m,n,StringGrid1);
      3: Left_Snake(m,n,StringGrid1);
    // 4: Right_Snake(m,n,StringGrid1);
    // 5: ZigZag(m,n,StringGrid1);
      6: Spiral(m,n,StringGrid1);
  end;
  Start;
end;

[dubsteppaman]

Ребят, помогите пожалуйста переделать (или предложите свой код) заполнение для произвольной таблицы (здесь реализовано только для квадратной). Ещё необходимо реализовать отображение процесса заполнения с помощью компонента "ProgressBar", где скорость заполнения полоски ProgressBar'а будет зависеть от величины таблицы

//=================== "Заполнение по зигзагу" ==================
Procedure ZigZag(var m,n:integer; StringGrid1:TStringGrid; TrackBar1:TTrackBar);
  var i,j,k,q: integer;
Begin
q:=0;
  With StringGrid1 do
    begin
      m:=RowCount-1;
      n:=ColCount-1;

      For i:=1 to 2*n-1 do
        begin
          if i>n then k:=n else k:=i;
          if i mod 2 = 1 then
          for j:=1+i-k to k do
            begin
              inc(q);
              Cells[j,1-j+i]:=IntToStr(q);
              Delay(Trunc(1000/TrackBar1.Position));
            end
          else {âíèç}
            for j:=k downto 1+i-k do
              begin
                inc(q);
                Cells[j,1-j+i]:=IntToStr(q);
                Delay(Trunc(1000/TrackBar1.Position));
              end;
        end;
    MessageDlg('Таблица заполнена!', mtInformation, [mbOk], 0);
    end;
end;

//================ "Заполнение спиралью" ===============
Procedure Spiral(var m,n:integer; StringGrid1:TStringGrid; TrackBar1:TTrackBar);
   var i,j,k,p:integer;
Begin
i:=0;
k:=0;
p:=1;

  with StringGrid1 do
    begin
    m:=RowCount-1;
    n:=ColCount-1;

    while i<n*m do
      begin
        inc(k);

          for j:=k to m-k+1 do
            begin
              inc(i);
              Cells[j,k]:=IntToStr(p);
              inc(p);
              Delay(Trunc(1000/TrackBar1.Position));
            end;

          for j:=k+1 to n-k+1 do
            begin
              inc(i);
              Cells[m-k+1,j]:=IntToStr(p);
              inc(p);
              Delay(Trunc(1000/TrackBar1.Position));
            end;

          for j:=m-k downto k do
            begin
              inc(i);
              Cells[j,n-k+1]:=IntToStr(p);
              inc(p);
              Delay(Trunc(1000/TrackBar1.Position));
            end;

          for j:=n-k downto k+1 do
            begin
              inc(i);
              Cells[k,j]:=IntToStr(p);
              inc(p);
              Delay(Trunc(1000/TrackBar1.Position));
            end;
    end;
    MessageDlg('Таблица заполнена!', mtInformation, [mbOk], 0);
  end;
end;