Икосаэдр

Mash6a
Дата: 07.06.2011 01:41:09
Gust2002,

Условие такое( без OpenGL(((
Рябов А.С.
Дата: 14.06.2011 12:05:36
fanllan
Алгоритм великолепен, работает очень быстро.
А как будет выглядеть алгоритм для более сложного икосаэдра?
Мне нужно написать программу для вывода икосаэдра более сложного порядка, скажем с частотой V = 1 .. n .
Заранее благодарен.


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

+
unit rotateu;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TXYZ=array[0..2] of double;
  TMainForm = class(TForm)
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
   MyBitmap:TBitmap;
   procedure Line(x1,y1,x2,y2:integer);
   procedure SetColor(clr:TColor);
   procedure DrawLine(var a,b:TXYZ);
   procedure DrawTriangle(v1,v2,v3:TXYZ);
   procedure DrawRect(v1,v2,v3,v4:TXYZ);
   procedure DrawCub(ax,ay,az,size:double);
   procedure Delay(msecs: dword);
   procedure Animate;
   procedure Draw;
   procedure DrawIkosaedr(depth:integer;ax,ay,az,size:double);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

const
 dx:Integer=320;
 dy:Integer=240;
var
 xAng,yAng,zAng:Real;
 Mode:Byte; { 0-проекция, 1 - перспектива, 2-своб.проэк., 3-кабинетн. }
 BreakFlag:boolean;

procedure SetAng(a,b:Word);
var
 p:Real;
begin
 p:=pi;
 case Mode of
  0:begin
     xAng:=(p*a)/180;
     yAng:=Sin((p*b)/180);
     zAng:=Cos(xAng);
     xAng:=Sin(xAng);
    end;
  2,3:
    begin
     xAng:=Cos(p/4);
     if Mode=3 then xAng:=xAng/2;
    end;
 end;
end;

procedure GetXY(var a:TXYZ;var x,y:Integer);
begin
 case mode of
   0:begin
      x:=Round(a[0]*zAng+a[2]*yAng);
      y:=Round(a[0]*xAng*yAng+a[1]*zAng-a[2]*yAng*zAng);
     end;
   1:begin
      x:=Round(a[0]/(1-a[2]/zAng));
      y:=Round(a[1]/(1-a[2]/zAng));
     end;
 2,3:begin
      x:=Round(a[0]+a[2]*xAng);
      y:=Round(a[1]+a[2]*yAng);
     end;
 end;
end;

procedure RotateX(an:real;const a:TXYZ; var b:TXYZ);
var
 s,c:Real;
begin
 s:=(pi*an)/180;
 c:=Cos(s); s:=Sin(s);
 b[0]:=a[0];
 b[1]:=Round(a[1]*c-a[2]*s);
 b[2]:=Round(a[1]*s+a[2]*c);
end;

procedure RotateY(an:real;const a:TXYZ; var b:TXYZ);
var
 s,c:Real;
begin
 s:=(pi*an)/180;
 c:=Cos(s); s:=Sin(s);
 b[1]:=a[1];
 b[0]:=Round(a[0]*c+a[2]*s);
 b[2]:=Round(a[2]*c-a[0]*s);
end;

procedure RotateZ(an:real;const a:TXYZ; var b:TXYZ);
var
 s,c:Real;
begin
 s:=(pi*an)/180;
 c:=Cos(s); s:=Sin(s);
 b[2]:=a[2];
 b[1]:=Round(a[1]*c+a[0]*s);
 b[0]:=Round(a[0]*c-a[1]*s);
end;

procedure Rotate(a,b,c:real;const a1:TXYZ; var b1:TXYZ);
var
 c1:TXYZ;
begin
 b1:=a1;
 if a>0 then begin RotateX(a,b1,c1); b1:=c1; end;
 if b>0 then begin RotateY(b,b1,c1); b1:=c1; end;
 if c>0 then begin RotateZ(c,b1,c1); b1:=c1; end;
end;

procedure TMainForm.Line(x1,y1,x2,y2:integer);
begin
 MyBitmap.Canvas.MoveTo(x1,y1);
 MyBitmap.Canvas.LineTo(x2,y2);
end;

procedure TMainForm.SetColor(clr:TColor);
begin
 MyBitmap.Canvas.Pen.Color:=clr;
end;

procedure TMainForm.DrawLine(var a,b:TXYZ);
var
 x1,y1,x2,y2:Integer;
begin
 GetXY(a,x1,y1);
 GetXY(b,x2,y2);
 Line(x1+dx,y1+dy,x2+dx,y2+dy);
end;

procedure TMainForm.DrawTriangle(v1,v2,v3:TXYZ);
begin
 DrawLine(v1,v2);
 DrawLine(v2,v3);
 DrawLine(v3,v1);
end;

procedure TMainForm.DrawRect(v1,v2,v3,v4:TXYZ);
begin
 DrawLine(v1,v2);
 DrawLine(v2,v3);
 DrawLine(v3,v4);
 DrawLine(v4,v1);
end;

function MulD(v:TXYZ;d:double):TXYZ;
begin
 Result[0]:=v[0]*d;
 Result[1]:=v[1]*d;
 Result[2]:=v[2]*d;
end;

procedure TMainForm.DrawIkosaedr(depth:integer;ax,ay,az,size:double);
const
 X=0.525731112119133606;
 Z=0.850650808352039932;
 vdata:array[0..11] of TXYZ =
 ((-X, 0.0, Z), (X, 0.0, Z), (-X, 0.0, -Z), (X, 0.0, -Z),
  (0.0, Z, X), (0.0, Z, -X), (0.0, -Z, X), (0.0, -Z, -X),
  (Z, X, 0.0), (-Z, X, 0.0), (Z, -X, 0.0), (-Z, -X, 0.0));
 tindices:array[0..19,0..2] of integer =
((0,4,1), (0,9,4), (9,5,4), (4,5,8), (4,8,1),
(8,10,1), (8,3,10), (5,3,8), (5,2,3), (2,7,3),
(7,10,3), (7,6,10), (7,11,6), (11,0,6), (0,1,6),
(6,1,10), (9,0,11), (9,11,2), (9,2,5), (7,2,11) );
var
 i:integer;

procedure normalize(var v:TXYZ);
var
 d:double;
begin
 d:=sqrt(v[0]*v[0]+v[1]*v[1]+v[2]*v[2]);
 if (d=0.0) then exit;
 { Ошибка: вектор нулевой длины }
 v[0]:=v[0]/d; v[1]:=v[1]/d; v[2]:=v[2]/d;
end;

procedure subdivide(v1,v2,v3:TXYZ;depth:longint);
var
 v12, v23, v31:TXYZ;
 i:integer;
 a,b,c:TXYZ;
begin
if (depth=0) then
 begin
  a:=MulD(v1,size);
  b:=MulD(v2,size);
  c:=MulD(v3,size);
  Rotate(ax,ay,az,a,a);
  Rotate(ax,ay,az,b,b);
  Rotate(ax,ay,az,c,c);
  DrawTriangle(a,b,c);
  exit;
 end;
 for i:=0 to 2 do
  begin
   v12[i]:=(v1[i]+v2[i])/2;
   v23[i]:=(v2[i]+v3[i])/2;
   v31[i]:=(v3[i]+v1[i])/2;
  end;
 normalize(v12);
 normalize(v23);
 normalize(v31);
 subdivide(v1,v12,v31,depth-1);
 subdivide(v2,v23,v12,depth-1);
 subdivide(v3,v31,v23,depth-1);
 subdivide(v12,v23,v31,depth-1);
end;

begin
 for i:=0 to 19 do
  begin
   subdivide(vdata[tindices[i,0]],
    vdata[tindices[i,1]],
    vdata[tindices[i,2]],depth);
  end;
end;

procedure TMainForm.DrawCub(ax,ay,az,size:double);
const
 X=0.5;
 vdata:array[0..7] of TXYZ=
  ((-x,-x,-x),(-x,-x,x),(-x,x,x),(-x,x,-x),
   (x,-x,-x),(x,-x,x),(x,x,x),(x,x,-x));
 tindices:array[0..5,0..3] of integer =
 ((0,1,2,3), (0,1,5,4), (1,2,6,5), (2,3,7,6), (0,3,7,4),( 4,5,6,7));
var
 i:integer;
 a,b,c,d:TXYZ;
begin
 for i:=0 to 5 do
  begin
    a:=MulD(vdata[tindices[i,0]],size);
    b:=MulD(vdata[tindices[i,1]],size);
    c:=MulD(vdata[tindices[i,2]],size);
    d:=MulD(vdata[tindices[i,3]],size);
    Rotate(ax,ay,az,a,a);
    Rotate(ax,ay,az,b,b);
    Rotate(ax,ay,az,c,c);
    Rotate(ax,ay,az,d,d);
    DrawRect(a,b,c,d);
  end;
end;

procedure TMainForm.Delay(msecs: dword);
var
 FirstTickCount: dword;
begin { Delay }
 FirstTickCount:=GetTickCount;
 repeat
  Application.ProcessMessages; {allowing access to other controls, etc.}
 until ((GetTickCount-FirstTickCount)>=msecs);
end; { Delay }

procedure TMainForm.Draw;
begin
 BitBlt(Canvas.Handle,0,0,Width,Height,MyBitmap.Canvas.Handle,0,0,SRCCOPY);
end;

procedure TMainForm.Animate;
var
 ax:integer;
begin
 Mode:=3;
 SetColor(clRed);
 repeat
  for ax:=0 to 360 do
   begin
    SetAng(ax,10);
    DrawIkosaedr(1,ax,ax,ax,100);
//      DrawCub(ax,ax,ax,100);
    Draw;
    Delay(10);
    if BreakFlag then exit;
    MyBitmap.Canvas.FillRect(Rect(0,0,MyBitmap.Width,MyBitmap.Height));
   end;
 until BreakFlag;
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 BreakFlag:=true;
end;

procedure TMainForm.FormActivate(Sender: TObject);
begin
 Animate;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
 MyBitmap:=TBitmap.Create;
 MyBitmap.Width:=640;
 MyBitmap.Height:=480;
end;

procedure TMainForm.FormPaint(Sender: TObject);
begin
 Draw;
end;

end.
fanllan
Дата: 23.06.2011 08:33:32
Рябов А.С.,

Благодарю