Уроки, алгоритмы, программы, примеры

Вход на сайт

Материалы по разделам

Построения
на плоскости (2D)
Графика
в пространстве (3D)
Вычислительная
геометрия
Физическое
моделирование
Фрактальная
графика

Новые комментарии

Выдаёт ошибку glut32.dll не найден! При том, что он лежит в System32! Всё решил) Нужно отправить не в System32, а в System.
Спасибо за статью. Я не Ваш студент. Но мне она помогла написать функцию для Канторова множества на Python для черепашки: import turtle def kanter(x, y, d):     if d > 1:         turtle...
Как реализовать в данном примере границы расчёта?

Счетчики и рейтинг

Рейтинг@Mail.ru Яндекс.Метрика
Среда программирования: 
Lazarus 0.9.30 (Free Pascal)

unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Button1: TButton;
    PaintBox1: TPaintBox;
    Timer1: TTimer;
    Timer3: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Timer3Timer(Sender: TObject);
 
  private
    { private declarations }
  public
    { public declarations }
    procedure Rect(x, y, size, cnt: Integer);
    procedure Square(i, j, a, b, size, cnt, p: Integer);
    procedure Povorot(pov: Integer);
    procedure T2();
    function Count(cnt: Integer):Integer;
 
  end;
 
var
  Form1: TForm1;
  i, j, k, m, a, b, c, d, cnt, zcnt, size, z, p, q, II, JJ, pov: Integer;
 
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
//функция пересчета переменной, отвечающей за цвет квадратов
function TForm1.Count(cnt : Integer):Integer;
begin
 
   if cnt=0 then
   begin
       Result:=1;
   end
   else
       Result:=0;
end;
 
//прорисовка прямоугольника
procedure TForm1.Rect(x, y, size, cnt: Integer);
begin
 
   if cnt=0 then
   begin
      PaintBox1.Canvas.Pen.Color := clBlack;
      PaintBox1.Canvas.Brush.Color := clBlack;
   end
   else
   begin
      PaintBox1.Canvas.Pen.Color := clWhite;
      PaintBox1.Canvas.Brush.Color := clWhite;
   end;
 
   PaintBox1.Canvas.Rectangle(x,y,x+size,y+size);
end;
 
//выбор квадратов в виде квадратной рамки
procedure TForm1.Square(i, j, a, b, size, cnt, p: Integer);
begin
     II:=i-(p*size);
     JJ:=j-(p*size);
     z:=i+(p*size);
     while II<=z do
     begin
          cnt:=Count(cnt);
          Rect(II+a, JJ+b, size div 2, cnt);
          II:=II+size;
     end;
     II:=II-size;
     z:=j+(p*size);
     while JJ<z do
     begin
          JJ:=JJ+size;
          cnt:=Count(cnt);
          Rect(II+a, JJ+b, size div 2, cnt);
     end;
     z:=i-(size*p);
     while II>z do
     begin
          II:=II-size;
          cnt:=Count(cnt);
          Rect(II+a, JJ+b, size div 2, cnt);
     end;
     z:=j-(size*p) ;
     while JJ>z do
     begin
          JJ:=JJ-size;
          cnt:=Count(cnt);
          Rect(II+a, JJ+b, size div 2, cnt);
     end;
end;
 
//пересчет переменных, отвечающих за сдвиг маленьких квадратов
procedure TForm1.Povorot(pov: Integer);
begin
      if (pov mod 4 = 0)  then
      begin
          a:=0;
          b:=0;
          c:=0;
          d:=0;
      end;
      if (pov mod 4 = 1)  then
      begin
          a:=size div 2;
          b:=0;
          c:=size div 2;
          d:=0;
      end;
      if (pov mod 4 = 2)  then
      begin
          a:=size div 2;
          b:=size div 2;
          c:=size div 2;
          d:=size div 2;
      end;
      if (pov mod 4 = 3)  then
      begin
          a:=0;
          b:=size div 2;
          c:=0;
          d:=size div 2;
      end;
end;
 
//условие: продолжать движение или начинать с центра
procedure TForm1.T2();
begin
         if (p = 6) then
               begin
                    Timer1.Enabled := false;
                    p:=0;
                    q:=-1;
                    pov:=pov+1;
                    Povorot(pov);
                    Timer1.Enabled := true;
               end
               else
               begin
                    Square(i, j, a, b, size, cnt, p);
                    Timer1.Enabled := true;
               end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
   size:=50;
   cnt:=1; //отвечает за цвет квадратов в первом таймере
   zcnt:=0; //отвечает за цвет квадратов во втором таймере
   Timer1.Interval:=1;
   Timer3.Interval:=1;
 
   //фон
   i:=0;
   while i<450 do
   begin
     j:=0;
     while j<450 do
     begin
        cnt:=Count(cnt);
        Rect(i, j, size, cnt);
        j:=j+50;
     end;
     i:=i+50;
   end;
 
   cnt:=0;
   i:=0;
   while i<450 do
   begin
       j:=0;
       while j<450 do
       begin
            cnt:=Count(cnt);
            Rect(i, j, size div 2, cnt);
            j:=j+50;
       end;
       i:=i+50;
   end;
 
   cnt:=Count(cnt);
   p:=0; //начальный размер квадратной рамки в 1м таймере
   q:=-1; //начальный размер квадратной рамки в 2м таймере
   pov:=0; //отвечает за направление маленьких квадратов
   j:=4*size; i:=4*size; k:=4*size; m:=4*size;
   a:=0; b:=0; c:=0; d:=0; //отвечают за движение маленьких квадратов в 1м и 2м таймере
   Square(i, j, a, b, size, cnt, p);
   Timer1.Enabled := true;
 
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
   //зарисовываем
   cnt:=Count(cnt);
   Square(i, j, a, b, size, cnt, p);
 
   //движение направо
   if (pov mod 4 = 0)  then
   begin
        a:=a+1;
        //прорисовка на новом месте
        cnt:=Count(cnt);
        Square(i, j, a, b, size, cnt, p);
        //включение второго таймера
        if (a = size div 4) then
        begin
            c:=0;
            d:=0;
            q:=q+2;
            Square(m, k, c, d, size, zcnt, q);
            Timer3.Enabled := true;
        end;
        //выключение первого таймера
        if (a = size div 2 ) then
        begin
             Timer1.Enabled := false;
             a:=0;
             b:=0;
        end;
   end;
 
   //движение вниз
   if (pov mod 4 = 1)  then
   begin
        b:=b+1;
        //прорисовка на новом месте
        cnt:=Count(cnt);
        Square(i, j, a, b, size, cnt, p);
        if (b = size div 4) then
        begin
             q:=q+2;
             c:=size div 2;
             d:=0;
             Square(m, k, c, d, size, zcnt, q);
             Timer3.Enabled := true;
        end;
        if (b = size div 2 ) then
        begin
             Timer1.Enabled := false;
             a:=size div 2;
             b:=0;
        end;
   end;
 
   //движение налево
   if (pov mod 4 = 2)  then
   begin
        a:=a-1;
        //прорисовка на новом месте
        cnt:=Count(cnt);
        Square(i, j, a, b, size, cnt, p);
 
        if (a = size div 4) then
        begin
            q:=q+2;
            c:=size div 2;
            d:=size div 2;
            Square(m, k, c, d, size, zcnt, q);
            Timer3.Enabled := true;
        end;
        if (a = 0 ) then
        begin
             Timer1.Enabled := false;
             a:=size div 2;
             b:=size div 2;
        end;
   end;
 
   //движение вверх
   if (pov mod 4 = 3)  then
   begin
        b:=b-1;
        //прорисовка на новом месте
        cnt:=Count(cnt);
        Square(i, j, a, b, size, cnt, p);
 
        if (b = size div 4) then
        begin
             q:=q+2;
             c:=0;
             d:=size div 2;
             Square(m, k, c, d, size, zcnt, q);
             Timer3.Enabled := true;
        end;
        if (b = 0 ) then
        begin
             Timer1.Enabled := false;
             a:=0;
             b:=size div 2;
        end;
   end;
 
end;
 
procedure TForm1.Timer3Timer(Sender: TObject);
begin
     //зарисовываем
     zcnt:=Count(zcnt);
     Square(m, k, c, d, size, zcnt, q);
 
     //движение направо
     if (pov mod 4 = 0)  then
     begin
          c:=c+1;
          //прорисовка на новом месте
          zcnt:=1;
          zcnt:=Count(zcnt);
          Square(m, k, c, d, size, zcnt, q);
 
          //включение первого таймера
          if (c = size div 4 + 2) then
          begin
               p:=p+2;
               T2();
          end;
 
          //выключение второго таймера
          if (c = size div 2 + 2) then
          begin
               Timer3.Enabled := false;
          end;
 
     end;
 
     //движение вниз
     if (pov mod 4 = 1)  then
     begin
          d:=d+1;
          //прорисовка на новом месте
          zcnt:=1;
          zcnt:=Count(zcnt);
          Square(m, k, c, d, size, zcnt, q);
          if (d = size div 4 + 2) then
          begin
               p:=p+2;
               T2();
          end;
 
          if (d = size div 2 + 2) then
          begin
               Timer3.Enabled := false;
          end;
     end;
 
     //движение налево
     if (pov mod 4 = 2)  then
     begin
         c:=c-1;
         //прорисовка на новом месте
         zcnt:=1;
         zcnt:=Count(zcnt);
         Square(m, k, c, d, size, zcnt, q);
 
         if (c = size div 4 - 2) then
         begin
             p:=p+2;
             T2();
        end;
 
        if (c = 0 - 2) then
        begin
             Timer3.Enabled := false;
        end;
    end;
 
    //движение вверх
    if (pov mod 4 = 3)  then
    begin
         d:=d-1;
         //прорисовка на новом месте
         zcnt:=1;
         zcnt:=Count(zcnt);
         Square(m, k, c, d, size, zcnt, q);
 
         if (d = size div 4 - 2) then
         begin
             p:=p+2;
             T2();
        end;
 
        if (d = 0 - 2 ) then
        begin
             Timer3.Enabled := false;
        end;
    end;
 
end;
 
end.  

Прикрепленный файлРазмер
Демо пример.zip1.06 Мб