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

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

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

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

У меня проблема вот с этим: gl.Clear(OpenGL.GL_COLOR_BUFFER_BIT | OpenGL.GL_DEPTH_BUFFER_BIT);. Вылезает ошибка: CS1061 "object" не содержит определения "GL_COLOR_BUFFER_BIT", и не удалось найти доступный метод расширения "GL_COLOR_BUFFER_BIT",...
Большое спасибо. Единственный код который прошел без каких либо ошибок. Ура!!!
Скажите пожалуйста, подскажите алгоритм по которому по заданным точкам можно определить тип многогранника, скажем это куб или прямоугольный параллелепипед. Нашел теорию по этим фигурам: https://www.mat... https://www.mat... Акцентировать внимание...
Всем у кого не работает. файл wizard.script Ещё одно упоминание Glut32 в строке "if (!VerifyLibFile(dir_nomacro_lib, _T("glut32"), _T("GLUT's"))) return false;" меняем на "if (!VerifyLibFile(dir_nomacro_lib, _T("freeglut"), _T("GLUT's"))) return...
Не получается, емаё

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

Рейтинг@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 Мб