1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
Объясните пожалуйста, как на основании ниже приведённой программы закрасить грани тетраэдра ( обычным способом, с помощью 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;
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.
решила сделать сначала... добилась заливки граней, но тетраэдра у меня не получается.... я полагаю, дело в неправильном соединении точек грани, это здесь:
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
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;
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.