Объясните пожалуйста, как на основании ниже приведённой программы закрасить грани тетраэдра ( обычным способом, с помощью FloodFill или SetFillStyle или что-то в этом роде..)?

uses Graph,crt;
const tetr: array[0..11] of real =
       (1,0,0, 0,1,0, 0,0,1, -0.5,-0.5,-0.5);
     line_: array[0..11] of integer = (0,1, 0,2, 0,3, 1,2, 1,3, 2,3);
       var    xt,yt,zt:real;
    x,y,z:real;
    sx,sy,sx1,sy1,p,zoom: integer;

procedure draw(color:byte);
begin
 for p:=0 to 5 do begin
  sx:=round(zoom*tetr[line_[p*2]*3])+260;
  sy:=round(zoom*tetr[line_[p*2]*3+1])+300;
    sx1:=round(zoom*tetr[line_[p*2+1]*3])+260;
  sy1:=round(zoom*tetr[line_[p*2+1]*3+1])+300;
  setcolor(color);
  line(SX,SY,sx1,sy1);
 end;
end;

procedure calc;
begin
 for p:=0 to 3 do begin
  Yt := tetr[p*3+1] * COS(X) - tetr[p*3+2] * SIN(X);
  Zt := tetr[p*3+1] * SIN(X) + tetr[p*3+2] * COS(X);
  tetr[p*3+1] := Yt;
  tetr[p*3+2] := Zt;

  Xt := tetr[p*3] * COS(Y) - tetr[p*3+2] * SIN(Y);
  Zt := tetr[p*3] * SIN(Y) + tetr[p*3+2] * COS(Y);
  tetr[p*3] := Xt;
  tetr[p*3+2] := Zt;

  Xt := tetr[p*3] * COS(Z) - tetr[p*3+1] * SIN(Z);
  Yt := tetr[p*3] * SIN(Z) + tetr[p*3+1] * COS(Z);
  tetr[p*3] := Xt;
  tetr[p*3+1] := Yt;
 end;
end;


var
 gd,gm:integer;
 t:char;
begin
 gd:=detect; initgraph(gd,gm,'');
 Z :=  0.1;
 Y :=  0.1;
 X :=  0.1;
 zoom:=70;

 repeat
  draw(15);
  delay(20000);
  draw(0);
  calc;
  if keypressed then begin
   t:=readkey;
   case t of
    '=':zoom:=zoom+1; {+}
    '-': zoom:=zoom-1;{-}
   end;
  end
 until t=#13;;
 closegraph;
end.

FloodFill'ом не получится, у тебя линии не соединены, между ними есть промежутки ... Собственно эту проблему я думаю и надо решить, а залить-то уже не сложно.

Например вот такой код:

SetFillStyle(SolidFill, Red);
FloodFill(260, 295, white);

Должен заливать только верхнюю грань, но так как какая-то из пар линий принадлежащих этому ребру пересекаются не в одной точке, точнее говоря отрезки эти не пересекаются, по этому не создают замкнутого пространства которое можно залить, этого не происходит

и как быть? в том числе с остальными гранями?

Отрисовывать не ребра, а грани... Причем не с помощью Line, а с помощью FillPoly, которая закрашивает полигон...

klem4, скажи, как так может случиться, что ты проводишь линии между тремя точками, и эти линии не пересекаются?.. Я не могу представить себе такую ситуацию..

Конечно, Марина в своем репертуаре - наворочала так, что конь ногу сломит.. Задавать координаты таким образом - это все равно, что назвать своих детей номерами, а потом еще домашних животных в эту же нумерацию свалить.. Если что-то советовать, то нужно советовать именно как это исправить. А точки - они точки и есть. Хотя Марина их и вычисляет по нескольку раз, все равно должно получиться замкнутое пространство. У меня, кстати, так все и отрисовалось. klem4, у тебя не так? и ты вставлял код заливки после процедуры Draw(15)? Я не понимаю, почему.. странно...
Стирать нужно кодом:

  SetFillStyle(SolidFill, Black);
  FloodFill(260, 295, Black);

- вставить после вторго вызова Draw.

Вот только работает это страшно медленно... Поэтому все же лучше использовать не FloodFill, а FillPoly (присоединяюсь к словам volvo - но, повторяю, только для ускорения и упрощения). Помимо прочего, отпадет неопределенность с выбором точки начала заполнения (очень существенно!!).

Еще один вопрос - как выделить верхние грани. Но мне кажется, Марина уже интересовалась им..

Чтоб закрасить грань, надо внесть в прогу такое понятие. Т.е. заменить твой массив line_, в котором точки сгруппированы по 2, на массив граней, где группировка по 3 точки. Вот так например:

grn: array [0..11] of integer = (0,1,2, 0,1,3, 0,2,3, 1,2,3);

В этом случае процедура отрисоки поменяется например так:

procedure draw(color:byte);
var j,p:integer;
begin
setcolor(color);
for p:=0 to 3 do begin
  sx1:=round(zoom*tetr[grn[p*2]*3])+260;
  sy1:=round(zoom*tetr[grn[p*2]*3+1])+300;
for j:=1 to 2 do begin
  sx:=round(zoom*tetr[grn[p*2+j]*3])+260;
  sy:=round(zoom*tetr[grn[p*2+j]*3+1])+300;
 line(SX,SY,sx1,sy1);
sx1:=sx; sy1:=sy;
end;
end;
end;

Правда для заливки тебе эта процедура не понадобится
Твои следующие шаги: После поворота всех точек необходимо найти расстояние от наблюдателя до грани (до средней точки просто). Далее отрисовываешь все грани, начиная с самой удаленной. Самую дальнюю, кстати, можно вообще не рисовать, т.к. из 4-х граней в 1 момент может быть видно только 3.

решила сделать сначала... добилась заливки граней, но тетраэдра у меня не получается.... я полагаю, дело в неправильном соединении точек грани, это здесь:

    with gran[1] do begin a:=1;b:=2;c:=4;cl:=9;end;
    with gran[2] do begin a:=2;b:=4;c:=3;cl:=9;end;
    with gran[3] do begin a:=3;b:=4;c:=1;cl:=9;end;
    with gran[4] do begin a:=1;b:=2;c:=3;cl:=9;end;

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

вот вся программа:

Program Tetr_5;
Uses crt,graph;
Type
  Tetr=record
    mass1:array [1..4] of record
      x3d,y3d,z3d:real;
      x2,y2:integer;
      xold,yold:integer;
    end;

    gran:array [1..4] of record
      a,b,c:integer;
      cl:integer;
    end;
    npixel:integer;
    plosk:integer;
  end;
  matr=array [1..4,1..4] of real;
const S=150;

procedure otobragenie(var f:tetr);
var
  n:integer;
  t:array [1..3] of pointtype;
const
  EYEY=400;
  EYEL=200;
  begin
  with f do
    for n:=1 to npixel do with mass1[n] do begin
    xold:=x2;yold:=y2;
    x2:=trunc(x3d*EYEL/(z3d-EYEY));
    y2:=trunc(y3d*EYEL/(z3d-EYEY));
  end;
  setcolor(0);
  setfillstyle(1,0);
  with f do for n:=1 to plosk do begin
    t[1].x:=300+mass1[gran[n].a].xold;t[1].y:=200-mass1[gran[n].a].yold;
    t[2].x:=300+mass1[gran[n].b].xold;t[2].y:=200-mass1[gran[n].b].yold;
    t[3].x:=300+mass1[gran[n].c].xold;t[3].y:=200-mass1[gran[n].c].yold;
    fillpoly(3,t);
  end;
  setcolor(0);
  with f do for n:=1 to plosk do begin
    setfillstyle(1,gran[n].cl);
    t[1].x:=300+mass1[gran[n].a].x2;t[1].y:=200-mass1[gran[n].a].y2;
    t[2].x:=300+mass1[gran[n].b].x2;t[2].y:=200-mass1[gran[n].b].y2;
    t[3].x:=300+mass1[gran[n].c].x2;t[3].y:=200-mass1[gran[n].c].y2;
    fillpoly(3,t);
  end;
end;

procedure preobraz(var f:tetr;m:matr);
var
  nx,ny,nz:real;
  n:integer;
begin
  for n:=1 to f.npixel do with f.mass1[n] do begin
    nx:=m[1,1]*x3d+m[1,2]*y3d+m[1,3]*z3d+m[1,4];
    ny:=m[2,1]*x3d+m[2,2]*y3d+m[2,3]*z3d+m[2,4];
    nz:=m[3,1]*x3d+m[3,2]*y3d+m[3,3]*z3d+m[3,4];
    x3d:=nx;y3d:=ny;z3d:=nz;
  end;
end;

procedure smeshenie(var mm:matr);
var n,m:integer;
begin
  for n:=1 to 4 do for m:=1 to 4 do
    if (n<>m) then mm[n,m]:=0 else mm[n,m]:=1;
end;

procedure rotate(var m:matr;a:real;n:integer);
var
  ax1,ax2:integer;
begin
  smeshenie(m);
  ax1:=n+1;if ax1=4 then ax1:=1;
  ax2:=ax1+1;if ax2=4 then ax2:=1;
  m[ax1,ax1]:=cos(a);
  m[ax1,ax2]:=-sin(a);
  m[ax2,ax1]:=sin(a);
  m[ax2,ax2]:=cos(a);
end;

var
  drv,mode:integer;
  c:char;
  fg:tetr;
  rt:matr;
begin
  drv:=DETECT;
  mode:=VGAHI;
  initgraph(drv,mode,'');
  if (GraphResult=grOk) then

begin
  with fg do begin
    npixel:=4;
    plosk:=4;

    mass1[1].x3d:=S;mass1[1].y3d:=0;mass1[1].z3d:=0;
    mass1[2].x3d:=0;mass1[2].y3d:=S;mass1[2].z3d:=0;
    mass1[3].x3d:=-S;mass1[3].y3d:=0;mass1[3].z3d:=0;
    mass1[4].x3d:=0;mass1[4].y3d:=-S;mass1[4].z3d:=0;

    with gran[1] do begin a:=1;b:=2;c:=4;cl:=9;end;
    with gran[2] do begin a:=2;b:=4;c:=3;cl:=9;end;
    with gran[3] do begin a:=3;b:=4;c:=1;cl:=9;end;
    with gran[4] do begin a:=1;b:=2;c:=3;cl:=9;end;

  end;

  rotate(rt,0.25,1);
  preobraz(fg,rt);
  rotate(rt,0.13,2);

    repeat

      otobragenie(fg);
      delay(10000);
      preobraz(fg,rt);
      if (keypressed) then begin
        c:=readkey;
      end else c:=' ';
    until c=#27;
    closegraph;
  end else begin
    writeln;
    writeln('Error initialize !!!');
  end;
end.

Если хвататься за разные исходники, бросать темы и никого не слушать, то вряд ли что-то получится.

прошу прощения, если кого-то обидела, но я использую то, что мне наиболее понятно.

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

Вот немного модернизировал первоначальный вариант (добавил собственно сортировку и вывод):

procedure draw(color:byte);
var i,k,j,p:integer;
x:real;
Tr: array[1..3] of PointType;
begin
setcolor(color);
setfillstyle (1,4);
for i:=0 to 2 do
 for j:=i+1 to 3 do begin
z:=(tetr[grn[i*3]*3+2]+tetr[grn[i*3+1]*3+2]+tetr[grn[i*3+2]*3+2])/3;
x:=(tetr[grn[j*3]*3+2]+tetr[grn[j*3+1]*3+2]+tetr[grn[j*3+2]*3+2])/3;
if z>x then
for p:=0 to 2 do begin k:= grn[i*3+p];grn[i*3+p]:=grn[j*3+p]; grn[j*3+p]:=k; end;
end;
for p:=1 to 3 do begin
for j:=0 to 2 do begin
  tr[j+1].x:=round(zoom*tetr[grn[p*3+j]*3])+260;
  tr[j+1].y:=round(zoom*tetr[grn[p*3+j]*3+1])+300;
end;
fillpoly (3,tr);
end;
end;

Стирать через draw(0); уже нельзя, можно вызывать вместо этого cleardevice.

спасибо большое! вроде разобралась, только не понятен вот этот фрагмент. Объясни пожалуйста.

Это как раз сортировка: берем 3 координаты Z вершин грани после поворота и делим на 3, получает среднее расстояние до грани. Сравниваем по таким значениям все и сортируем.