model3d.pas

很小的迷你３D引擎

unit Model3D;

interface

uses
  Windows, Graphics, Math, Dialogs, ColorConv;

type

  TRGBTripleArray = array[0..1000] of TRGBTriple;
  PRGBTripleArray = ^TRGBTripleArray;

  TRGBFloat = record
    R : single;
    G : single;
    B : single;
  end;

  TPointColor = record
    X : integer;
    Y : integer;
    RGB : TRGBFloat;
  end;

  TPointColorTriangle = array[0..2] of TPointColor;

  TPoint3D = record
    X : extended;
    Y : extended;
    Z : extended;
  end;

  TPoints = array of TPoint3D;

  TVertex = record
    Point : TPoint3D; // coordinate of vertex
    Normal : TPoint3D; // vector normal to surface at vertex
    Visible : boolean; // flag to show if vertex is part of a visible face
    Lum : integer; // Luminosity at vertex for gouraud polygon filling
  end;

  TFace = record
    Corners : array of integer; // indexes the Vertices.Points that make up the face
    CenterZ : Extended; // Z-coordinate of face center
    Normal : TPoint3D; // normal vector the the plane of the face
    HLS : THLS;
    Curved : boolean; // indicates whether face is curved or flat
  end;

  TAxis = (AxisX, AxisY, AxisZ);

  T3DModel = Class(TObject)
    private

      Vertices : array of TVertex;
      Faces : array of TFace;
      VisibleFaces : array of TFace;

      FCenter : TPoint3D;

      function FaceNormal(AFace : integer) : TPoint3D;
      procedure QuickSortFaces(var A: array of TFace; iLo, iHi: Integer);
      procedure FlatFace(AFace : integer);
      procedure GouraudFace( AFace : integer);
      procedure GouraudPoly(var ABitmap : TBitmap ; V : TPointColorTriangle);
      function CrossProduct(AVector1, AVector2 : TPoint3D) : TPoint3D;
      function DotProduct(AVector1, AVector2 : TPoint3D) : Extended;
      function UnitVector(AVector : TPoint3D) : TPoint3D;
      function Add(AVec1, AVec2 : TPoint3D) : TPoint3D;
      function Subtract(AVec1, AVec2 : TPoint3D) : TPoint3D;

    public

      procedure BuildRotationalVolume(Coords, Radius : array of extended ;
                                      LayerColors : array of TColor ;
                                      Detail : integer);
      procedure BuildCube(ACubeSize : integer ; FaceColors : array of TColor);
      procedure Translate(AX, AY : integer);
      procedure Rotate(AAngle : extended ; AAxis : TAxis);
      procedure RenderObject;

      property Center : TPoint3D read FCenter write FCenter;
    end;

  function Point3D(AX, AY, AZ : Extended) : TPoint3D;

Var
  LightSource : TPoint3D; // position of light source
  SourceDirection : TPoint3D;
  ViewVector : TPoint3D; // viewing position
  OffScrBmp : TBitmap; // off screen bitmap for drawing to
  ScreenRect : TRect;

implementation

// build a general rotational object
procedure T3DModel.BuildRotationalVolume(Coords, Radius : array of extended ;
                                         LayerColors : array of TColor ;
                                         Detail : integer);
Var
  LAngle : extended;
  LRot : integer;
  LP : TPoints;
  LFace, LVertex : integer;
  Lsin, Lcos : extended;
  LRing : integer;
  NumRings : integer;
begin
  try

    NumRings := length(Coords);
    SetLength(LP, NumRings);
    SetLength(Vertices, Detail * NumRings);
    SetLength(Faces, Detail * (NumRings - 1) + 2);
    LVertex := 0;
    LFace := 0;

    // set initial point positions and ring heights
    for LRing := 0 to NumRings - 1 do begin
      Vertices[LVertex].Point := Point3D(Radius[LRing], Coords[LRing], 0);
      Inc(LVertex);
      LP[LRing].Y := Coords[LRing];
    end;

    // create Vertices by rotating points around rings
    for LRot := 1 to Detail do begin
      if LRot < Detail then begin
        LAngle := 2*pi * LRot / Detail;
        SinCos(LAngle, Lsin, Lcos);
        // calculate new point positions
        for LRing := 0 to NumRings - 1 do begin
          LP[LRing].X := Radius[LRing] * Lcos;
          LP[LRing].Z := Radius[LRing] * Lsin;
        end;
        // store new points in Vertices
        for LRing := 0 to NumRings - 1 do begin
          Vertices[LVertex].Point := LP[LRing];
          Inc(LVertex);
        end;
      end;
      // create a new face by indexing Vertices
      for LRing := 0 to NumRings - 2 do begin
        SetLength(Faces[LFace].Corners, 4);
        Faces[LFace].Corners[0] := ((LRot-1) * NumRings) + LRing;
        Faces[LFace].Corners[1] := ((LRot-1) * NumRings) + LRing + 1;
        if LRot = Detail then begin // join up 1st layer and 2nd layer faces
          Faces[LFace].Corners[2] := Faces[LRing].Corners[1];
          Faces[LFace].Corners[3] := Faces[LRing].Corners[0];
        end else begin
          Faces[LFace].Corners[2] := (LRot * NumRings) + LRing + 1;
          Faces[LFace].Corners[3] := (LRot * NumRings) + LRing;
        end;

        // face colours
        Faces[LFace].HLS := RGBtoHLS( ColorToRGB(LayerColors[LRing]) );

        Faces[LFace].Curved := True;

        Inc(LFace);
      end;
    end;

    // create end faces
    SetLength(Faces[length(Faces)-2].Corners, Detail);
    SetLength(Faces[length(Faces)-1].Corners, Detail);
    for LRot := 0 to Detail - 1 do begin
      Faces[length(Faces)-2].Corners[LRot] := LRot * NumRings;
      Faces[length(Faces)-1].Corners[LRot] := ((LRot+1) * NumRings) - 1;
    end;
    // colours
    Faces[length(Faces)-2].HLS := RGBtoHLS( ColorToRGB(LayerColors[length(LayerColors) - 2]) );
    Faces[length(Faces)-1].HLS := RGBtoHLS( ColorToRGB(LayerColors[length(LayerColors) - 1]) );

    Faces[length(Faces)-2].Curved := False; // end faces are not curved
    Faces[length(Faces)-1].Curved := False;

    // calculate face normals
    for LFace := 0 to length(Faces) - 3 do begin
      Faces[LFace].Normal := FaceNormal(LFace);
    end;
    // end faces
    Faces[length(Faces)-2].Normal := Point3D(0, -1, 0);
    Faces[length(Faces)-1].Normal := Point3D(0,  1, 0);

    // calculate vertex normals by averaging the face normals that it toaches
    for LVertex := 0 to length(Vertices) - 1 do begin
      Vertices[LVertex].Normal := Point3D(0, 0, 0);
    end;
    for LFace := 0 to length(Faces) - 3 do begin // don't include end faces
      for LVertex := 0 to length(Faces[LFace].Corners) - 1 do begin
        Vertices[Faces[LFace].Corners[LVertex]].Normal :=
          Add(Vertices[Faces[LFace].Corners[LVertex]].Normal, Faces[LFace].Normal);
      end;
    end;
    for LVertex := 0 to length(Vertices) - 1 do begin
      Vertices[LVertex].Normal := UnitVector(Vertices[LVertex].Normal);
    end;

  except
    ShowMessage('Exception in BuildRotationalVolume Method');
  end;
end;

// build a cube with specified size and face colours
procedure T3DModel.BuildCube(ACubeSize : integer ; FaceColors : array of TColor);
Var                                   
  LVertex, LFace : byte;           //    Face colours assignments
  Lx, Ly, Lz : integer;            //                ___
begin                              //               |5  |
  try                              //        ___ ___|___|___
                                   //       |4  |2  |0  |1  |
    // create cube Vertices        //       |___|___|___|___|
    SetLength(Vertices, 8);        //               |3  |
    LVertex := 0;                  //               |___|
    for Lz := 0 to 1 do begin
      for Ly := 0 to 1 do begin
        for Lx := 0 to 1 do begin
          Vertices[LVertex].Point.X := Lx * ACubeSize;
          Vertices[LVertex].Point.Y := Ly * ACubeSize;
          Vertices[LVertex].Point.Z := Lz * ACubeSize;
          Vertices[LVertex].Normal := Point3D(1, 0, 0); // not used
          Inc(LVertex);
        end;                               //    Vertex indexes
      end;                                 //      0________1
    end;                                   //      |\      |\
                                           //      | \4____|_\5
    // create cube faces                   //      |  |    |  |
    SetLength(Faces, 6);                   //     2|__|____|3 |
    for LFace := 0 to 5 do begin           //       \ |     \ |
      SetLength(Faces[LFace].Corners, 4);  //        \|______\|
      Faces[LFace].Curved := False;        //         6       7
    end;
    for LFace := 0 to 5 do Faces[LFace].Corners[3] := LFace;
    Faces[0].Corners[2] := 1; Faces[0].Corners[1] := 3; Faces[0].Corners[0] := 2;
    Faces[1].Corners[2] := 5; Faces[1].Corners[1] := 7; Faces[1].Corners[0] := 3;
    Faces[2].Corners[2] := 6; Faces[2].Corners[1] := 4; Faces[2].Corners[0] := 0;
    Faces[3].Corners[2] := 7; Faces[3].Corners[1] := 6; Faces[3].Corners[0] := 2;
    Faces[4].Corners[2] := 6; Faces[4].Corners[1] := 7; Faces[4].Corners[0] := 5;
    Faces[5].Corners[2] := 1; Faces[5].Corners[1] := 0; Faces[5].Corners[0] := 4;
    // calculate face normals
    for LFace := 0 to 5 do begin
      Faces[LFace].Normal := FaceNormal(LFace);
      Faces[LFace].HLS := RGBtoHLS( ColorToRGB(FaceColors[LFace]) );
    end;

  except
    ShowMessage('Exception in BuildCube Method');
  end;
end;

// calculate the normal vector of a face
function T3DModel.FaceNormal(AFace : integer) : TPoint3D;
Var
  LVec1, LVec2 : TPoint3D;
begin
  try
    // find 2 vectors that lie on the plane
    LVec1 := Subtract(Vertices[Faces[AFace].Corners[1]].Point, Vertices[Faces[AFace].Corners[0]].Point);
    LVec2 := Subtract(Vertices[Faces[AFace].Corners[3]].Point, Vertices[Faces[AFace].Corners[0]].Point);

    Result := UnitVector(CrossProduct(LVec1, LVec2));

  except
    ShowMessage('Exception in FaceNormal Method');
  end;
end;

// translate an object
procedure T3DModel.Translate(AX, AY : integer);
Var
  LDis : TPoint3D;
  LVertex : integer;
begin
  try
    LDis.X := AX - Center.X;
    LDis.Y := AY - Center.Y;

    for LVertex := 0 to length(Vertices) - 1 do begin
      Vertices[LVertex].Point.X := Vertices[LVertex].Point.X + LDis.X;
      Vertices[LVertex].Point.Y := Vertices[LVertex].Point.Y + LDis.Y;
    end;

    Center := Point3D(Center.X + LDis.X, Center.Y + LDis.Y, Center.Z);

  except
    ShowMessage('Exception in Translate Method');
  end;
end;

// rotate an object around a given axis
procedure T3DModel.Rotate(AAngle : extended ; AAxis : TAxis);
Var
  LVertex : integer;
  TempPoint : TPoint3D;
  Lsin, Lcos : extended;
begin
  try
    sincos(AAngle, Lsin, Lcos);

    if AAxis = AxisX then begin
      // rotate about x-axis
      for LVertex := 0 to length(Vertices) - 1 do begin // Vertex Points
        TempPoint.X := Vertices[LVertex].Point.X;
        TempPoint.Y := ((Vertices[LVertex].Point.Y-Center.Y) * Lcos) -
                        ((Vertices[LVertex].Point.Z-Center.Z) * Lsin) + Center.Y;
        TempPoint.Z := ((Vertices[LVertex].Point.Y-Center.Y) * Lsin) +
                        ((Vertices[LVertex].Point.Z-Center.Z) * Lcos) + Center.Z;
        Vertices[LVertex].Point := TempPoint;
      end;
      for LVertex := 0 to length(Faces) - 1 do begin // face normals
        TempPoint.X := Faces[LVertex].Normal.X;
        TempPoint.Y := ((Faces[LVertex].Normal.Y) * Lcos) -
                        ((Faces[LVertex].Normal.Z) * Lsin);
        TempPoint.Z := ((Faces[LVertex].Normal.Y) * Lsin) +
                        ((Faces[LVertex].Normal.Z) * Lcos);
        Faces[LVertex].Normal := TempPoint;
      end;
      for LVertex := 0 to length(Vertices) - 1 do begin // vertex normals
        TempPoint.X := Vertices[LVertex].Normal.X;
        TempPoint.Y := ((Vertices[LVertex].Normal.Y) * Lcos) -
                        ((Vertices[LVertex].Normal.Z) * Lsin);
        TempPoint.Z := ((Vertices[LVertex].Normal.Y) * Lsin) +
                        ((Vertices[LVertex].Normal.Z) * Lcos);
        Vertices[LVertex].Normal := TempPoint;
      end;
    end else if AAxis = AxisY then begin
      // rotate about y-axis
      for LVertex := 0 to length(Vertices) - 1 do begin // Vertex Points
        TempPoint.X := ((Vertices[LVertex].Point.X-Center.X) * Lcos) +
                        ((Vertices[LVertex].Point.Z-Center.Z) * Lsin) + Center.X;
        TempPoint.Y := Vertices[LVertex].Point.Y;
        TempPoint.Z := -((Vertices[LVertex].Point.X-Center.X) * Lsin) +
                         ((Vertices[LVertex].Point.Z-Center.Z) * Lcos) + Center.Z;
        Vertices[LVertex].Point := TempPoint;
      end;
      for LVertex := 0 to length(Faces) - 1 do begin // face normals
        TempPoint.X := ((Faces[LVertex].Normal.X) * Lcos) +
                        ((Faces[LVertex].Normal.Z) * Lsin);
        TempPoint.Y := Faces[LVertex].Normal.Y;
        TempPoint.Z := -((Faces[LVertex].Normal.X) * Lsin) +
                         ((Faces[LVertex].Normal.Z) * Lcos);
        Faces[LVertex].Normal := TempPoint;
      end;
      for LVertex := 0 to length(Vertices) - 1 do begin // vertex normals
        TempPoint.X := ((Vertices[LVertex].Normal.X) * Lcos) +
                        ((Vertices[LVertex].Normal.Z) * Lsin);
        TempPoint.Y := Vertices[LVertex].Normal.Y;
        TempPoint.Z := -((Vertices[LVertex].Normal.X) * Lsin) +
                         ((Vertices[LVertex].Normal.Z) * Lcos);
        Vertices[LVertex].Normal := TempPoint;
      end;
    end else begin
      // rotate about z-axis
      for LVertex := 0 to length(Vertices) - 1 do begin // Vertex Points
        TempPoint.X := ((Vertices[LVertex].Point.X-Center.X) * Lcos) -
                        ((Vertices[LVertex].Point.Y-Center.Y) * Lsin) + Center.X;
        TempPoint.Y := ((Vertices[LVertex].Point.X-Center.X) * Lsin) +
                        ((Vertices[LVertex].Point.Y-Center.Y) * Lcos) + Center.Y;
        TempPoint.Z := Vertices[LVertex].Point.Z;
        Vertices[LVertex].Point := TempPoint;
      end;
      for LVertex := 0 to length(Faces) - 1 do begin // face normals
        TempPoint.X := ((Faces[LVertex].Normal.X) * Lsin) -
                        ((Faces[LVertex].Normal.Y) * Lcos);
        TempPoint.Y := ((Faces[LVertex].Normal.X) * Lcos) +
                        ((Faces[LVertex].Normal.Y) * Lsin);
        TempPoint.Z := Faces[LVertex].Normal.Z;
        Faces[LVertex].Normal := TempPoint;
      end;
      for LVertex := 0 to length(Vertices) - 1 do begin // vertex normals
        TempPoint.X := ((Vertices[LVertex].Normal.X) * Lsin) -
                        ((Vertices[LVertex].Normal.Y) * Lcos);
        TempPoint.Y := ((Vertices[LVertex].Normal.X) * Lcos) +
                        ((Vertices[LVertex].Normal.Y) * Lsin);
        TempPoint.Z := Vertices[LVertex].Normal.Z;
        Vertices[LVertex].Normal := TempPoint;
      end;
    end;

  except
    ShowMessage('Exception in Rotate Method');
  end;
end;

// Render an object to the screen
procedure T3DModel.RenderObject;
Var
  LFace, LVertex : integer;
  LVisibleVertices : array of integer; // index's of vertices belonging to visible faces
  LIntensityRatio : Extended;
begin
  try
    // backface culling
    SetLength(VisibleFaces, 0);
    for LFace := 0 to length(Faces) - 1 do begin
      // if face normal is pointing towards viewer then it is visible else it is invisible
      if DotProduct(Faces[LFace].Normal, ViewVector) > 0 then begin
        SetLength(VisibleFaces, length(VisibleFaces) + 1);
        VisibleFaces[length(VisibleFaces) - 1] := Faces[LFace];
      end;
    end;

    // calculate Z-coordinate of face centers for Z-buffering
    for LFace := 0 to length(VisibleFaces) - 1 do begin
      VisibleFaces[LFace].CenterZ := (Vertices[VisibleFaces[LFace].Corners[0]].Point.Z +
        Vertices[VisibleFaces[LFace].Corners[length(VisibleFaces[LFace].Corners) div 2]].Point.Z) / 2;
    end;

    // sort faces by Z
    QuicksortFaces(VisibleFaces, 0, length(VisibleFaces)-1);

    // calculate light source direction from center of club
    SourceDirection := UnitVector( Subtract(LightSource, Center) );

    // clear bitmap
    OffScrBmp.Canvas.Brush.Color := clblack;
    OffScrBmp.Canvas.FillRect(ScreenRect);

    // find visible vertices and calculate the luminosity at each of them
    // this means that luminosities will only have to be calculated once for each vertex
    SetLength(LVisibleVertices, 0);
    for LVertex := 0 to length(Vertices) - 1 do Vertices[LVertex].Visible := False;
    for LFace := 0 to length(VisibleFaces) - 1 do begin
      for LVertex := 0 to length(VisibleFaces[LFace].Corners) - 1 do begin