Графика в Турбо Паскаль

vincent

Читаю форум и вижу, что много кому требуется помощь в освоении графики в Паскаль. Предлагаю постить сюда разнообразные задачи, которые вам приходилось решать. Лично мне интересно было бы посмотреть на реализации следующих задач: рисование сложных геометрических объектов, построение графиков функций, вписать/описать одну фигуру внутри/вокруг другой, аффинные преобразования (перенос, масштабирование, поворот), анимация (в том числе которая зависит от пользователя), игры, а вообще все что кажется вам интересным и достойным внимания. Например: Как разбить экран на правильные шестиугольные соты?
program sota;
uses graph;
const
r = 10;
var
gd,gm: integer;
ga: string;
ErrCode: integer;
i, j: integer;
n, m, x, y: integer;
fi: integer;
begin
gd := VGA;
gm := VGAHi;
ga := '../bgi';
initgraph(gd,gm,ga);
ErrCode := GraphResult;
 if ErrCode = GrOk then begin
   x:=0;
   y:=0;
   n:=Round(GetMaxX/r);
   m:=Round(GetMaxY/r);
   for j := 0 to n do begin
    for i := 0 to m do begin
    x :=Round(r*(i*3+1.5*(j mod 2)));
    y := Round(j*r*0.866);
    fi := 0;
    MoveTo(x + Round(r*cos(2*fi*pi/360)), y + Round(r*sin(2*fi*pi/360)));
     repeat
     inc(fi,60);
     LineTo(x + Round(r*cos(2*fi*pi/360)), y + Round(r*sin(2*fi*pi/360)));
     until 360 <= fi;
    end;
    end;
   ReadLn;
 end;
end.
Ссылки на разнообразные алгоритмы тоже приветствуются!) Многим по разным причинам (задания в школе/институте) приходится начинать изучать компьютерную графику именно с Паскаля. Чтобы помочь начинающим быстрее разобраться, я и создал эту тему. Так что, если есть какие-либо примеры, то выкладывай.
Важно: Данная тема не предназначенна для вопросов. Тут размещаются готовые программы или полезная информация по теме: "Графика в Turbo Pascal". Если у Вас возникли вопросы, то создайте новую тему и ждите пока Вам кто-нибудь ответит. Все последующие посты не в тему будут наказываться карточкой.
14 ответов

vincent

Поддерживаю тему, если наполнится нормальным материалом, поместим в ФАК. ССЫЛКИ НА СТОРОННИЕ ФОРУМЫ НЕ ПРИЛАГАТЬ!!!


vincent

А архивы с исходниками можно кидать?


vincent

ЛоРД_Оледжан, Да, давайте. Особо если есть комментарии. Для новичков это очень важно.


vincent

Предлагаю не просто исходники постить, а по возможности процесс составления программы. Они же не строчка за строчкой из головы появляются.


vincent

Для начала выкладываю коротенькую книгу-руководство, в приложении к которой уже есть некоторое количество простых примеров. Если вы только решили начать изучать графику в Турбо Паскаль, это то, что нужно.


vincent

Не все заглядывают в тему Справочные материалы. Там вложена книга, в которой тоже очень доходчиво, в расчете на школьников, изложены приемы работы с графикой, много примеров. http://www.cyberforum.ru/attachments/3834d1241779566


vincent

Часто просят нарисовать график функции. Вот последний мой вариант почти по полной программе, с масштабированием сетки. Есть еще над чем работать, но лучше хоть что, чем ничего. Построение графика функции


vincent

Часто просят нарисовать график функции. Вот последний мой вариант почти по полной программе, с масштабированием сетки. Есть еще над чем работать, но лучше хоть что, чем ничего. Построение графика функции
В этой программе Y всегда от -1 до 1, неплохо было бы ввести интервал и по Y, тогда легко можно будет увидеть график любой функции.Еще одна простая программка для начинающих. При нажатии на Enter плавно перемещает треугольник c вершинами (10,10);(10,100);(100,100) на 10 пунктов по X, и по Y.
uses crt,graph;
const n=4;
type
Point=record
x,y:integer;
end;
mas=array[1..n] of Point;
procedure Z(x,y:integer;var m:mas;c:byte);
 
var i:byte;
begin
Setcolor(c);
m[1].x:=x;m[1].y:=y;
m[2].x:=x;m[2].y:=y+90;
m[3].x:=x+90;m[3].y:=y+90;
m[4].x:=x;m[4].y:=y;
moveto(m[1].x,m[1].y);
for i:=1 to n do
lineto(m[i].x,m[i].y);
Setfillstyle(1,c);
end;
var gd,gm:integer;
    x,y,x1,y1,i:integer;
    p:mas;
    c1,c2:byte;
    k:char;
    move:boolean;
begin
gd:=VGA;
gm:=VGAHi;
Initgraph(gd,gm,'..\bgi');
Setbkcolor(8);
x:=10;y:=10;
c1:=7;c2:=8;
move:=true;
repeat
if keypressed then
  begin
    k:=readkey;
    if k=#13 then {if enter}
     for i:=1 to 10 do
      begin
        y1:=y;
        x1:=x;
        y:=y+1;
        x:=x+1;
        delay(6000);
        Z(x1,y1,p,c2);
        Z(x,y,p,c1);
        move:=true;
      end;
    end;
if move then
  begin
    Z(x1,y1,p,c2);
    Z(x,y,p,c1);
    move:=false;
  end;
OutTextXY(320,240,'Press Enter to continue');
until k=#27; {until escape}
closegraph;
end.
Delay похоже зависит от компьютера, приходится подбирать значение, которое устраивает. Если время очень важно можно использовать это.
function timer:real;
var hour,minute,second,sec100:word;
begin
   gettime(hour,minute,second,sec100);
   timer:=(hour*3600.0+minute*60.0+second)*100.0+1.0*sec100;
end;
 
procedure wait_seconds(t:real);
var t1:real;
begin
 t1:=timer;
 repeat until timer>t1+100*t;
end;
Еще один отличный пример. Вращаем и отражаем фигуру в пространстве. Управление цифрами 1-9.
Program Rotation and Reflection;
 
uses Crt, Graph;
var
   gd, gm: Integer;
   par: array[1..8, 1..3] of real;
   ribs: array[1..12, 1..2] of integer;
   i: integer;
   ch: char;
   corner : real;
 
procedure draw;
var
   x1, x2, y1, y2: integer;
   ver1, ver2: integer;
begin
   for i := 1 to 12 do begin
   ver1 := ribs[i,1];
   ver2 := ribs[i,2];
   x1 := round(par[ver1,1])+320;
   y1 := 240-round(par[ver1,2]);
   x2 := round(par[ver2,1])+320;
   y2 := 240-round(par[ver2,2]);
   line(x1,y1,x2,y2);
  end;
end;
 
procedure reflection_XOZ_YOZ;
begin
   for i:=1 to 8 do begin
       par[i,2]:=-par[i,2];
       par[i,1]:=-par[i,1];
   end;
end;
 
procedure reflection_XOZ_XOY;
begin
   for i:=1 to 8 do begin
       par[i,2]:=-par[i,2];
       par[i,3]:=-par[i,3];
   end;
end;
 
procedure reflection_XOY_YOZ;
begin
   for i:=1 to 8 do begin
       par[i,3]:=-par[i,3];
       par[i,1]:=-par[i,1];
   end;
end;
 
procedure turnOX(corner: real);
var
   y,z: real;
begin
   for i:=1 to 8 do Begin
       y:=par[i,2];
       z:=par[i,3];
       par[i,2]:=y*cos(corner)-z*sin(corner);
       par[i,3]:=y*sin(corner)+z*cos(corner);
   end;
end;
 
procedure turnOY(corner: real);
var
   x,z: real;
begin
   for i:=1 to 8 do begin
       x:=par[i,1];
       z:=par[i,3];
       par[i,1]:=x*cos(corner)+z*sin(corner);
       par[i,3]:=-x*sin(corner)+z*cos(corner);
   end;
end;
 
procedure turnOZ(corner: real);
var
   x,y: real;
begin
   for i:=1 to 8 do begin
       x:=par[i,1];
       y:=par[i,2];
       par[i,1]:=x*cos(corner)-y*sin(corner);
       par[i,2]:=x*sin(corner)+y*cos(corner);
   end;
end;
 
begin
   par[1,1]:=0;    par[1,2]:=0;    par[1,3]:=0;
   par[2,1]:=0;    par[2,2]:=110;  par[2,3]:=0;
   par[3,1]:=175;  par[3,2]:=110;  par[3,3]:=0;
   par[4,1]:=175;  par[4,2]:=0;    par[4,3]:=0;
   par[5,1]:=0;    par[5,2]:=0;    par[5,3]:=150;
   par[6,1]:=0;    par[6,2]:=110;  par[6,3]:=150;
   par[7,1]:=175;  par[7,2]:=110;  par[7,3]:=150;
   par[8,1]:=175;  par[8,2]:=0;    par[8,3]:=150;
 
   ribs[1,1]:=1;   ribs[1,2]:=2;
   ribs[2,1]:=2;   ribs[2,2]:=3;
   ribs[3,1]:=3;   ribs[3,2]:=4;
   ribs[4,1]:=4;   ribs[4,2]:=1;
   ribs[5,1]:=5;   ribs[5,2]:=6;
   ribs[6,1]:=6;   ribs[6,2]:=7;
   ribs[7,1]:=7;   ribs[7,2]:=8;
   ribs[8,1]:=8;   ribs[8,2]:=5;
   ribs[9,1]:=1;   ribs[9,2]:=5;
   ribs[10,1]:=2;  ribs[10,2]:=6;
   ribs[11,1]:=3;  ribs[11,2]:=7;
   ribs[12,1]:=4;  ribs[12,2]:=8;
 
 
   gd := VGA;
   gm := VGAHi;
   InitGraph(gd, gm, '../bgi');
 
   If GraphResult <> grOk then
      Halt(1);
 
   turnOX(pi/12);
   turnOY(pi/12);
   turnOZ(pi/12);
   While ch<>#27 do begin
      ClearDevice;
      Draw;
      OuttextXY(10,450,'Press <1>-<6> for rotation, <7>-<9> for reflection');
      OuttextXY(10,465,'Press <Esc> to Exit');
      ch:=readkey;
      Case ch Of
         '1': turnOX(pi/15);
         '4': turnOX(-pi/15);
         '2': turnOY(pi/15);
         '5': turnOY(-pi/15);
         '3': turnOZ(pi/15);
         '6': turnOZ(-pi/15);
         '7': reflection_XOZ_YOZ;
         '8': reflection_XOZ_XOY;
         '9': reflection_XOY_YOZ;
      end;
   end;
   closegraph;
end.


vincent

Люди часто задаются вопросом по поводу анимации или просто обычных рисунков в Паскале. Выложу несколько видов своего художества...а так же коментарии к ним.... Итак: 1) Анимационная картинка - кораблик совершает путь по заданной траектории...все происходит довольно быстро...но время может задать каждый желающий...вообщем смотрите...
program corablik;
uses Graph, Crt;
var
  grDriver: integer;
  grMode: integer;
  ErrCode: integer;
  x,y,y0,a,b: integer;{a,b-переменные для линии моря, чтоб они не зависели от х,у}
procedure more(a,b:integer);
begin
moveto(0,y0);
setcolor(blue);
for a:=0 to 680 do{слева направо рисуем синусоиду синего чвета}
 begin
  b:=y0-round(sin(a*pi/180)*30);{30-коэффициент масштабирования по оси Х,
чем больше, тем волна круче}
  lineto(a,b);
 end;
end;
begin
  grDriver := Detect;
  InitGraph(grDriver, grMode, '..\BGI');
  ErrCode := GraphResult;
  y0 := 250;
  if ErrCode = grOk then
  begin
    x:=600;
    while x>=0 do{лучше использовать цикл while, можно менять величину шага,
что тоже влияет на скорость и частоту смены картинки}
     begin
      cleardevice;
      more(a,b);{рисуем волну}
      setcolor(white);{устанавливаем цвет кораблика}
      y:=y0-40-round(sin(x*pi/180)*30);{движемся по волне}
      MoveTo(x - 40, y + 20);
      LineTo(x - 20, y + 40);
      LineTo(x + 20, y + 40);
      LineTo(x + 40, y + 20);
      LineTo(x - 40, y + 20);
      MoveTo(x + 15, y + 20);
      LineTo(x + 15, y - 40);
      LineTo(x - 20, y + 20);
      LineTo(x + 15, y + 20);
      delay(100); {нормальная скорость, если модули *.TPL не глючные как у Вас,
 время должно быть в миллисекундах, а не в каких-нибудь наносекундах}
      x:=x-2;{шаг движения}
    end;
  end
  else Writeln('Graphics error: ', GraphErrorMsg(ErrCode));
 Settextstyle(0,0,3);{устанавливаем стиль шрифта}
 cleardevice;
 setcolor(red);
 OuttextXY(200,240,'Rejs zavershen!');{выводим надпись}
 readln;
 CloseGraph;
end.
2) Анимация - прямоугольничек красного цвета совершает полный путь по экрану монитора!
program kv;
uses
    crt, graph;
var
   x, y, dx, dy, w, h, driver, mode: integer;
begin
     initgraph(driver, mode, 'G:/BP/BGI');
     if graphresult<>0 then begin
        writeln('none');
        halt
     end;
     dx:=1;
     dy:=0;
     w:=100;
     h:=10;
repeat
      setfillstyle(1, black);
      bar(x, y, x+w, y+h);
      x:=x+dx;
      y:=y+dy;
      setfillstyle(1, red);
      bar(x, y, x+w, y+h);
      delay(100);
      if (x+w>=getmaxx)and(y<=0) then
      begin
           dx:=0;
           dy:=1;
      end
      else
      if (y+h>=getmaxy)and(x+w>=getmaxx) then
      begin
           dx:=-1;
           dy:=0;
      end
      else
      if (x<=0)and(y+h>=getmaxy) then
      begin
           dx:=0;
           dy:=-1;
      end
      else
      if (y<=0)and(x<=0) then
      begin
           dx:=1;
           dy:=0;
      end;
until keypressed;
closegraph;
end.
3) Люди часто просят нарисовать самый обычный рисунок из разных тем...т.к. это форум скажем компьютерщиков то вот простенький рисунок (как я его называю "программист")!
Program bugalteria;
Uses crt,graph;
Var gd,gm:integer;
begin
clrscr;
 Detectgraph (gd,gm);
 Initgraph (gd,gm,'C:\tp7');
  {Зарисовка стола}
  Bar (120,330,360,360);
  Bar (180,360,330,480);
  {Зарисовка компьютера}
  Line (180,240,180,330);
  Line (180,270,210,330);
  Line (172,210,202,300);
  Line (180,210,210,300);
  Line (210,300,202,300);
  Line (180,210,172,210);
  Line (270,322,270,330);
  Line (270,322,330,330);
  {Зарисовка стула}
  Bar (420,405,510,420);
  Bar (456,420,480,480);
  {Зарисовка бухгалтера работающего за компьютером}
  Line (510,405,540,300);
  Line (334,480,390,390);
  Line (390,390,510,390);
  Line (360,480,420,405);
  Line (510,390,450,240);
  Line (480,390,420,300);
  Line (420,300,430,240);
  Line (450,270,330,300);
  Line (330,300,310,310);
  Circle (435,195,40);
Readln
end.


vincent

LoRD6006 вот архив в которм програмка реализует рисунок: Дорожный знак на столбе со светофором. У светофора должен гореть один фонарь. В тексте программы есть коментарии. LoRD6007 программа реализует график функции |sin(x)|+cos|x| есть масштаб(от 20 до 100) также присутствуют коментарии.


vincent

LoRD6001 МУРАВЕЙНИК Демонстрация свойств случайных чисел (центральная предельная теорема) \колокообразная прямая Разбиваем ось на небольшие интервалы и подсчитываем частоту попаданий случайного значения в каждый интервал если кол-во опытов велико, то график частот будет выглядеть так как требуется. LoRD6002 ПАПОРОТНИК Вывести изображение папоротника Вероятностный графический алгоритм, основанный на построении множества с помощу четырех преобразованныч координат точек на плоскости, каждое из которых применяется с определенной вероятностью. LoRD6003 Экран - сосуд с кипящей жидкостью. На дне в случайной точке образуеться пузырек; при движении вверх он растет, а дойдя до поверхности лопается. Если два пузырька соприкасаются, они сливаются в один. Реализовать этот процесс.


vincent

Ещё одна простая программка для начинающих. При нажатии на Enter плавно перемещает треугольник c вершинами (10,10);(10,100);(100,100) на 10 пунктов по X, и по Y. Delay похоже зависит от компьютера, приходится подбирать значение, которое устраивает. Если время очень важно можно использовать это.
Delay зависит от кривости TPL, а, точнее, CRT.TPU внутри него. Самая популярная версия — это кривой патч Клаусса Хартнегга. Его кривости есть оправдание, но он всё равно кривой.Прилагаю для сравнения версию, скомпилированную с нормальными библиотеками. Задержку поменял на 100, иначе состариться можно, пока этот треугольник целую минуту на десять пикселов будет сдвигаться.


vincent

Достаточно простой, но норм работающий. Для начинающих то что надо))
uses GraphABC;
 
var xx, yy, xx1, yy1, xx2, yy2, xx3, yy3: real;
   
begin
  var x1:= 50;
  var y1:= 50;
  var x2:= 70;
  var y2:= 50;
  var x3:= 70;
  var y3:= 70;
  var x4:= 50;
  var y4:= 70;  
  var alfa:=0.5;
  while(true) do
    begin
      ClearWindow;
      {xx:= x1*cos(alfa) + y1*(-sin(alfa)) + (-20)*cos(alfa) + 20*sin(alfa) + 20;
      yy:= x1*sin(alfa) + y1*cos(alfa) + (-20)*sin(alfa) - 20*cos(alfa) + 20;}
      xx1:= x2*cos(alfa) + y2*(-sin(alfa)) + (-50)*cos(alfa) + 50*sin(alfa) + 50;
      yy1:= x2*sin(alfa) + y2*cos(alfa) + (-50)*sin(alfa) - 50*cos(alfa) + 50;
      Line(round(x1),round(y1),round(xx1),round(yy1));
     
      xx2:= x3*cos(alfa) + y3*(-sin(alfa)) + (-50)*cos(alfa) + 50*sin(alfa) + 50;
      yy2:= x3*sin(alfa) + y3*cos(alfa) + (-50)*sin(alfa) - 50*cos(alfa) + 50;
      Line(round(xx1),round(yy1),round(xx2),round(yy2));
     
      xx3:= x4*cos(alfa) + y4*(-sin(alfa)) + (-50)*cos(alfa) + 50*sin(alfa) + 50;
      yy3:= x4*sin(alfa) + y4*cos(alfa) + (-50)*sin(alfa) - 50*cos(alfa) + 50;
      Line(round(xx2), round(yy2), round(xx3), round(yy3));
     
      Line(round(xx3), round(yy3), round(x1), round(y1));
     
      alfa +=0.1;
      redraw;
     // sleep(1);
   
    end;
end.


vincent

Пример программы, которая в текстовом режиме запрашивает значения десяти параметров и строит по ним столбиковую диаграмму (гистограмму) в графическом режиме.
program LoRD; {Построение столбиковой диаграммы}
uses Crt, Graph;
const Count=10;
Width =40; {Ширина столбца диаграммы}
var
I,X1,X2,Y1,Y2 : integer;
M : array[1..Count] of byte;
DriverVar, ModeVar: integer;
S_M : string;
begin
Writeln('Ввод данных (целые числа) для построения диаграммы');
for I:=l to Count do
begin
repeat {Ввод с контролем, входит ли введенное значение в [1..10]}
Write('Введите значение' , I, '-го параметра (от 1 до 10) :');
Readln(M[I]) ;
if not M[I] in [1..10] {Если введенное значение не входит в ин-тервал [1..10]}
then Writeln('Значение параметра должно быть от 1 до 10');
until M[I] in [1..10];
end;
27
DriverVar:=Detect; {Инициализация графического режима}
InitGraph(DriverVar,ModeVar,'');
SetViewPort(10,10,630,400,True); {Создать окно}
SetTextStyle(DefaultFont,HorizDir,1);
Yl:=325; {Построение гистограммы}
for I:=l to Count do {Повторять, пока не построим все столбики}
begin
XI:=I*50;
Str(M[I],S_M) ; {Преобразовать значение М[1] в строку для вы-вода в графическом режиме на экран}
SetFillStyle(I,I); {Задать стиль и цвет заполнения}
Bar3D(Xl,Yl,Xl+Width,Yl-M[I]*30,10,TopOn); {Построить столбико-вую диаграмму}
OutTextXY (X1+15,Y1-M[I]*3O-15,S_M); {Напечатать над столбиком значение отображаемой величины}
end; {Конец цикла}
{Вывод пояснительных надписей}
SetTextStyle(DefaultFont,HorizDir,2);
OutTextXY(150,20,'Пример гистограммы');
SetTextStyle(DefaultFont,VertDir,1);
OutTextXY(40,175,'Величина параметра');
SetTextStyle(DefaultFont,HorizDir,1);
OutTextXY(250,GetMaxY-140,'Параметры');
OutTextXY(150,GetMaxY-100,'Для завершения нажмите Enter');
Readln;
CloseGraph;
end.