fmain.pas

这是三Ｄ开发的一些源码

            VertexIndices:= indices;
            MaterialName:= MatName;
            Mode:= fgmmTriangles;
         end;
      end;
    //
    texIndices.Free;
    subdivideRemap.Free;
    firstRemap.Free;
    tex.Free;
    indices.Free;
    norms.Free;
    tris.Free;
  end;
end;

function TMain.AllocFacegroup( mo: TMeshobject; matname: string ): TFGVertexNormalTexIndexList;
var i: Integer;
begin
  for i:= 0 to mo.facegroups.count - 1 do
    if mo.facegroups[i].MaterialName = matname then begin
      result:= TFGVertexNormalTexIndexList( mo.facegroups[i] );
      exit;
    end;
  result:= TFGVertexNormalTexIndexList.CreateOwned( mo.facegroups );
  result.MaterialName:= matname;
  result.Mode:= fgmmTriangles;
end;

function TMain.AllocMeshObject( mesh: TGLBaseMesh; name: string ): TMeshObject;
var i: Integer;
begin
  for i:= 0 to mesh.MeshObjects.count - 1 do
    if mesh.MeshObjects[i].Name = name then begin
      result:= mesh.MeshObjects[i];
      exit;
    end;
  result:= Tmeshobject.CreateOwned( mesh.MeshObjects );
  result.Name:= name;
  result.Mode:= momFacegroups;
end;

procedure TMain.RebuildOneMeshObject( mesh: TGLFreeform );
var
  mo: TMeshobject;
  i, j, k, c: integer;
  vi, ti, ni: integer;
  fg: TFGVertexNormalTexIndexList;
begin
  c:= mesh.meshobjects.count;
  mo:= allocmeshobject( mesh, 'oxMesh' );
    for i:= 0 to c - 1 do
      with mesh.meshobjects[i] do begin
        for j:= 0 to facegroups.count - 1 do
          with TFGVertexNormalTexIndexList( facegroups[j] ) do begin
            fg:= allocfacegroup( mo, materialname );
            fg.VertexIndices.Clear;
            fg.TexcoordIndices.Clear;
            fg.NormalIndices.Clear;
            for k:= 0 to vertexindices.count - 1 do begin
              vi:= mo.vertices.findoradd( vertices[vertexindices[k]] );
              ti:= mo.texcoords.findoradd( texcoords[texcoordindices[k]] );
              ni:= mo.normals.findoradd( normals[normalindices[k]] );
              fg.VertexIndices.add( vi );
              fg.TexcoordIndices.add( ti );
              fg.NormalIndices.add( ni );
            end;
          end;
        end;
  for i:= 0 to c - 1 do
    mesh.meshobjects.Delete( 0 );
  //GLMaterialLibrary.Materials.Clear;
  //mesh.StructureChanged;
  SetupFreeFormShading;
end;

procedure TMain.FormCreate(Sender: TObject);
begin
   hlShader:= THiddenLineShader.Create( Self );
   FreeForm.IgnoreMissingTextures:= True;
   ToolSave3DS:= TOXToolSave3DS.Create( FreeForm );
end;

procedure TMain.AddMeshObjectsAndFaces;
var i, j: integer;
begin
  ListBox1.Clear;
  ListBox2.Clear;
  for i:= 0 to FreeForm.MeshObjects.Count -1 do begin
    ListBox1.Items.AddObject(FreeForm.MeshObjects[i].Name,FreeForm.MeshObjects[i]);
    for j:= 0 to FreeForm.MeshObjects[i].FaceGroups.Count -1 do begin
      ListBox2.Items.AddObject(FreeForm.MeshObjects[i].FaceGroups[j].MaterialName,FreeForm.MeshObjects[i].FaceGroups[j]);
    end;
  end;
  Label1.Caption:= 'Mesh Objects: ' + IntToStr( ListBox1.Count );
  Label2.Caption:= 'Mesh Faces: ' + IntToStr( ListBox2.Count );
  ListBox1.Selected[0]:= True;
end;

procedure TMain.FormShow(Sender: TObject);
var
   i : Integer;
begin
   if not nthShow then begin

      OpenDialog.Filter:=VectorFileFormatsFilter;
      SaveDialog.Filter:=VectorFileFormatsSaveFilter;
      with ActionList do for i:=0 to ActionCount-1 do
         if Actions[i] is TCustomAction then
            with TCustomAction(Actions[i]) do Hint:=Caption;
      ApplyFSAA;
      ApplyFaceCull;
      ApplyBgColor;
      ApplyFPS;

      if ParamCount>0 then
         DoOpen(ParamStr(1));

      nthShow:=True;
   end;
end;

procedure TMain.GLSceneViewerBeforeRender(Sender: TObject);
begin
   THiddenLineShader(hlShader).LinesColor:=VectorMake(107/256, 123/256, 173/256, 1);
   THiddenLineShader(hlShader).BackgroundColor:=ConvertWinColor(GLSceneViewer.Buffer.BackgroundColor);
   if not GL_ARB_multisample then begin
      MIAADefault.Checked:=True;
      MIAA2x.Enabled:=False;
      MIAA4X.Enabled:=False;
   end;
end;

procedure TMain.GLSceneViewerAfterRender(Sender: TObject);
begin
   ApplyFSAA;
   Screen.Cursor:=crDefault;
end;

procedure TMain.MIAboutClick(Sender: TObject);
begin
   ShowMessage( 'GLSViewer - Simple OpenGL Mesh Viewer'#13#10
               +'Copyright 2002 Eric Grange'#13#10#13#10
               +'A freeware Delphi program based on...'#13#10#13#10
               +'GLScene: 3D view, 3D file formats support'#13#10
               +'http://glscene.org'#13#10#13#10
               +'GraphicEx: 2D image file formats support'#13#10
               +'http://www.delphi-gems.com/')
end;

procedure TMain.DoResetCamera;
var
   objSize : Single;
begin
   DCTarget.Position.AsVector:=NullHmgPoint;
   GLCamera.Position.SetPoint(7, 3, 5);
   FreeForm.Position.AsVector:=NullHmgPoint;
   FreeForm.Up.Assign(DCAxis.Up);
   FreeForm.Direction.Assign(DCAxis.Direction);

   objSize:=FreeForm.BoundingSphereRadius;
   if objSize>0 then begin
      if objSize<1 then begin
         GLCamera.SceneScale:=1/objSize;
         objSize:=1;
      end else GLCamera.SceneScale:=1;
      GLCamera.AdjustDistanceToTarget(objSize*0.27);
      GLCamera.DepthOfView:=1.5*GLCamera.DistanceToTarget+2*objSize;
   end;
end;

procedure TMain.ApplyShadeModeToMaterial(aMaterial : TGLMaterial);
begin
   with aMaterial do begin
      if ACShadeSmooth.Checked then begin
         GLSceneViewer.Buffer.Lighting:=True;
         GLSceneViewer.Buffer.ShadeModel:=smSmooth;
         aMaterial.FrontProperties.PolygonMode:=pmFill;
         aMaterial.BackProperties.PolygonMode:=pmFill;
      end else if ACFlatShading.Checked then begin
         GLSceneViewer.Buffer.Lighting:=True;
         GLSceneViewer.Buffer.ShadeModel:=smFlat;
         aMaterial.FrontProperties.PolygonMode:=pmFill;
         aMaterial.BackProperties.PolygonMode:=pmFill;
      end else if ACFlatLined.Checked then begin
         GLSceneViewer.Buffer.Lighting:=True;
         GLSceneViewer.Buffer.ShadeModel:=smFlat;
         aMaterial.FrontProperties.PolygonMode:=pmLines;
         aMaterial.BackProperties.PolygonMode:=pmLines;
      end else if ACHiddenLines.Checked then begin
         GLSceneViewer.Buffer.Lighting:=False;
         GLSceneViewer.Buffer.ShadeModel:=smSmooth;
         aMaterial.FrontProperties.PolygonMode:=pmLines;
         aMaterial.BackProperties.PolygonMode:=pmLines;
      end else if ACWireframe.Checked then begin
         GLSceneViewer.Buffer.Lighting:=False;
         GLSceneViewer.Buffer.ShadeModel:=smSmooth;
         aMaterial.FrontProperties.PolygonMode:=pmLines;
         aMaterial.BackProperties.PolygonMode:=pmLines;
      end;
   end;
end;

procedure TMain.ApplyShadeMode;
var
   i : Integer;
begin
   with GLMaterialLibrary.Materials do for i:=0 to Count-1 do begin
      ApplyShadeModeToMaterial(Items[i].Material);
      if (ACHiddenLines.Checked) or (ACFlatLined.Checked) then
         Items[i].Shader:=hlShader
      else Items[i].Shader:=nil;
   end;
   GLSceneViewer.Buffer.Lighting:=ACLighting.Checked;
   FreeForm.StructureChanged;
end;

procedure TMain.ApplyFSAA;
begin
   with GLSceneViewer.Buffer do begin
      if MIAADefault.Checked then
         AntiAliasing:=aaDefault
      else if MIAA2X.Checked then
         AntiAliasing:=aa2x
      else if MIAA4X.Checked then
         AntiAliasing:=aa4x;
   end;
end;

procedure TMain.ApplyFaceCull;
begin
   with GLSceneViewer.Buffer do begin
      if ACCullFace.Checked then begin
         FaceCulling:=True;
         ContextOptions:=ContextOptions-[roTwoSideLighting];
      end else begin
         FaceCulling:=False;
         ContextOptions:=ContextOptions+[roTwoSideLighting];
      end;
   end;
end;

procedure TMain.ApplyBgColor;
var
   bmp : TBitmap;
   col : TColor;
begin
   bmp:=TBitmap.Create;
   try
      bmp.Width:=16;
      bmp.Height:=16;
      col:=ColorToRGB(ColorDialog.Color);
      GLSceneViewer.Buffer.BackgroundColor:=col;
      with bmp.Canvas do begin
         Pen.Color:=col xor $FFFFFF;
         Brush.Color:=col;
         Rectangle(0, 0, 16, 16);
      end;
      MIBgColor.Bitmap:=bmp;
   finally
      bmp.Free;
   end;
end;

procedure TMain.ApplyTexturing;
var
   i : Integer;
begin
   with GLMaterialLibrary.Materials do for i:=0 to Count-1 do begin
      with Items[i].Material.Texture do begin
         if Enabled then
            Items[i].Tag:=Integer(True);
         Enabled:=Boolean(Items[i].Tag) and ACTexturing.Checked;
      end;
   end;
   FreeForm.StructureChanged;
end;

procedure TMain.ApplyFPS;
begin
   if ACFPS.Checked then begin
      Timer.Enabled:=True;
      GLCadencer.Enabled:=True;
   end else begin
      Timer.Enabled:=False;
      GLCadencer.Enabled:=False;
      StatusBar.Panels[1].Text:='--- FPS';
   end;
end;

procedure TMain.SetupFreeFormShading;
var
   i : Integer;
   libMat : TGLLibMaterial;
begin
   with GLMaterialLibrary do begin
      if Materials.Count=0 then begin
         FreeForm.Material.MaterialLibrary:=GLMaterialLibrary;
         libMat:=Materials.Add;
         FreeForm.Material.LibMaterialName:=libMat.Name;
         libMat.Material.FrontProperties.Diffuse.Red:=0;
      end;
      for i:=0 to Materials.Count-1 do
         with Materials[i].Material do BackProperties.Assign(FrontProperties);
   end;
   ApplyShadeMode;
   ApplyTexturing;
   ApplyFPS;
end;

procedure TMain.DoOpen(const fileName : String);
var
   min, max : TAffineVector;
begin
   if not FileExists(fileName) then Exit;

   Screen.Cursor:=crHourGlass;

   Caption:='GLSViewer - '+ExtractFileName(fileName);

   FreeForm.MeshObjects.Clear;
   GLMaterialLibrary.Materials.Clear;

   FreeForm.LoadFromFile(fileName);

   SetupFreeFormShading;

   StatusBar.Panels[0].Text:=IntToStr(FreeForm.MeshObjects.TriangleCount)+' tris';
   StatusBar.Panels[2].Text:=fileName;
   ACSaveTextures.Enabled:=(GLMaterialLibrary.Materials.Count>0);
   MIOpenTexLib.Enabled:=(GLMaterialLibrary.Materials.Count>0);
   lastFileName:=fileName;
   lastLoadWithTextures:=ACTexturing.Enabled;

   FreeForm.GetExtents(min, max);
   with CubeExtents do begin
      CubeWidth:=max[0]-min[0];
      CubeHeight:=max[1]-min[1];
      CubeDepth:=max[2]-min[2];
      Position.AsAffineVector:=VectorLerp(min, max, 0.5);
   end;

   DoResetCamera;
   FreeForm.StructureChanged;
   AddMeshObjectsAndFaces;
end;