glfileobj.pas

这是三Ｄ开发的一些源码

                        try
                           with libMat.Material.Texture do begin
                              Image.LoadFromFile(texName);
                              Disabled:=False;
                              TextureMode:=tmModulate;
                           end;
                        except
                           on E: ETexture do begin
                              if not Owner.IgnoreMissingTextures then
                                 raise;
                           end;
                        end;
                     end;
                  finally
                     objMtl.Free;
                     fs.Free;
                  end;
               end;
            end else Result:=matName;
         end else Result:='';
      end;
   end;

var
   command, objMtlFileName, curMtlName : String;
{$IFDEF STATS}
   t0, t1, t2 : Integer;
{$ENDIF}
begin
   {$IFDEF STATS}
   t0:=GLGetTickCount;
   {$ENDIF}

   FEof:=False;
   FSourceStream:=aStream;
   FLineNo:=0;
   objMtlFileName:='';
   curMtlName:='';

   mesh:=TMeshObject.CreateOwned(Owner.MeshObjects);
   mesh.Mode:=momFaceGroups;

   faceGroupNames:=TStringList.Create;
   faceGroupNames.Duplicates:=dupAccept;
   faceGroupNames.Sorted:=True;
   try

      faceGroup:=nil;

      while not FEof do begin
         ReadLine;
         if FLine='' then
            Continue; { Skip blank line }
         if FLine[1] in ['#', '$'] then
            Continue; { Skip comment and alternate comment }

         command:=AnsiUpperCase(NextToken(FLine, ' '));

         if command='V' then begin
            ReadHomogeneousVector;
            Mesh.Vertices.Add(hv[0], hv[1], hv[2]);
         end else if command='VT' then begin
            ReadAffineVector;
            Mesh.TexCoords.Add(av[0], av[1], 0);
         end else if command='VN' then begin
            ReadAffineVector;
            Mesh.Normals.Add(av[0], av[1], av[2]);
         end else if command='VP' then begin
            { Parameter Space Vertex: Ignore }
         end else if command='G' then begin
            { Only the first name on the line, multiple groups not supported. }
            SetCurrentFaceGroup(NextToken(FLine, ' '), curMtlName);
         end else if command='F' then begin
            ReadFace(curMtlName);
         end else if command='O' then begin
            { Object Name:  Ignore };
         end else if command='MTLLIB' then begin
            objMtlFileName:=NextToken(FLine, ' ');
         end else if command='USEMTL' then begin
            curMtlName:=GetOrAllocateMaterial(objMtlFileName, NextToken(FLine, ' '));
            if faceGroup=nil then
               SetCurrentFaceGroup('', curMtlName)
            else SetCurrentFaceGroup(faceGroup.FName, curMtlName);
         end else if command='S' then begin
            { Smooth Group: Ignore }
         end else if command='T' then begin
            ReadTriangleStrip;
         end else if command='Q' then begin
            ReadTriangleStripContinued;
         end else Error('Unsupported Command '''+command+'''');
      end;

      mesh.FaceGroups.SortByMaterial;

      {$IFDEF STATS}
      t1:=GLGetTickCount;
      {$ENDIF}

      CalcMissingOBJNormals(mesh);

      {$IFDEF STATS}
      t2:=GLGetTickCount;
      InformationDlg(Format('TGLOBJVectorFile Loaded in %dms'#13+
                         #13+
                         '    %dms spent reading'#13+
                         '    %dms spent calculating normals'#13+
                         '    %d Geometric Vertices'#13+
                         '    %d Texture Vertices'#13+
                         '    %d Normals'#13+
                         '    %d FaceGroups/Strips',
                         [t2-t0,
                          t1-t0,
                          t2-t1,
                          Mesh.Vertices.Count,
                          Mesh.TexCoords.Count,
                          Mesh.Normals.Count,
                          Mesh.FaceGroups.Count]));
      {$ENDIF}
   finally
      faceGroupNames.Free;
   end;
end;

procedure TGLOBJVectorFile.SaveToStream(aStream:TStream);
var OldDecimalSeparator:char;
    
  procedure Write(s:string);
  begin
    if s<>'' then aStream.Write(s[1],Length(s));
  end;

  procedure WriteLn(s:string);
  begin
    Write(s);
    Write(#13#10);
  end;

  procedure WriteHeader;
  begin
    WriteLn('# oxNewton Track editor 2007 by Dave Gravel.');
    WriteLn('# oxTrack editor OBJ SAVE.');
    WriteLn('# Wavefront .OBJ');
    WriteLn('# http://www.dave.serveusers.com');
    WriteLn( '# This editor is based on the Fig track editor code.' );
    WriteLn( '# http://fig.emperion-empire.com' );
  end;

  procedure WriteVertices;
  var s:string;
      j, i, n:integer;
  begin
    n := 0;
    Writeln('mtllib '+CurrentMatName+'.mtl');
    for j:=0 to Owner.MeshObjects.Count-1 do begin
      Writeln(Format('# Mesh %d',[j+1]));
      with Owner.MeshObjects[j].Vertices do begin
      for i:=0 to Count-1 do
        begin
          s:=Format('v %g %g %g',[List^[i][0],List^[i][1],List^[i][2]]);
          Writeln(s);
        end;
        Inc(n,Count);
      end;
    end;
    WriteLn(Format('# %d Vertices',[n]));
    WriteLn('');
  end;

  procedure WriteNormals;
  var s:string;
      j, i, n:integer;
  begin
    n := 0;
    for j:=0 to Owner.MeshObjects.Count-1 do begin
      Writeln(Format('# Mesh %d',[j+1]));
      with Owner.MeshObjects[j].Normals do begin
      for i:=0 to Count-1 do
        begin
          s:=Format('vn %g %g %g',[List^[i][0],List^[i][1],List^[i][2]]);
          Writeln(s);
        end;
        Inc(n,Count);
      end;
    end;
    WriteLn(Format('# %d Normals',[n]));
    WriteLn('');
  end;

  procedure WriteTexCoords;
  var s:string;
      j, i, n:integer;
  begin
    n := 0;
    for j:=0 to Owner.MeshObjects.Count-1 do begin
      Writeln(Format('# Mesh %d',[j+1]));
      with Owner.MeshObjects[j].TexCoords do begin
      for i:=0 to Count-1 do
        begin
          s:=Format('vt %g %g',[List^[i][0],List^[i][1]]);
          Writeln(s);
        end;
        Inc(n,Count);
      end;
    end;
    WriteLn(Format('# %d Texture-Coordinates',[n]));
    WriteLn('');
  end;

  procedure WriteOBJFaceGroup(aFaceGroup:TOBJFGVertexNormalTexIndexList; o : Integer = 0);
  var vIdx,nIdx,tIdx:integer;
      i,Index,Polygon:integer;
      Line,t:string;
  begin
    with aFaceGroup do
      begin
        Index:=0;
        for Polygon:=0 to PolygonVertices.Count-1 do
          begin
            Line:='f ';
            for i:=1 to PolygonVertices[Polygon] do
              begin
                vIdx:=VertexIndices[Index]+1+o;
                nIdx:=NormalIndices[Index]+1+o;
                tIdx:=TexCoordIndices[Index]+1+o;
                t:=IntToStr(vIdx)+'/';
                if tIdx=-1 then t:=t+'/' else t:=t+IntToStr(tIdx)+'/';
                if nIdx=-1 then t:=t+'/' else t:=t+IntToStr(nIdx)+'/';
                Line:=Line+Copy(t,1,length(t)-1)+' ';
                inc(Index);
              end;
            Writeln(Line);
          end;
      end;
    Writeln('');
  end;

   procedure WriteVertexIndexList(fg : TFGVertexIndexList; o : Integer = 0);
   var
      i, n : Integer;
   begin
      Writeln( 'usemtl ' + fg.MaterialName );
      case fg.Mode of
        fgmmTriangles :
        Begin
          n:=fg.VertexIndices.Count-3;
          i:=0; while i<=n do begin
             Writeln(Format('f %d/%0:d %d/%1:d %d/%2:d',
                            [fg.VertexIndices[i]+1+o,
                             fg.VertexIndices[i+1]+1+o,
                             fg.VertexIndices[i+2]+1+o]));
             Inc(i, 3);
          End;
        End;
        fgmmTriangleFan :
        Begin
          Write('f ');
          n:=fg.VertexIndices.Count-1;
          i:=0; while i<=n do begin
             If i<n then
               Write(Format('%d/%0:d ',[fg.VertexIndices[i]+1+o]))
             else
               Writeln(Format('%d/%0:d',[fg.VertexIndices[i]+1+o]));
             Inc(i);
          End;
        End;
        fgmmTriangleStrip :
        Begin
          n:=fg.VertexIndices.Count-3;
          i:=0; while i<=n do begin
             Writeln(Format('f %d/%0:d %d/%1:d %d/%2:d',
                            [fg.VertexIndices[i]+1+o,
                             fg.VertexIndices[i+1]+1+o,
                             fg.VertexIndices[i+2]+1+o]));

             Inc(i);
          End;
        End;
      end;
   end;

   procedure WriteFaceGroups;
   var
      j, i, k: Integer;
      fg : TFaceGroup;
      MoName: string;
   begin
     k := 0;
     for j:=0 to Owner.MeshObjects.Count-1 do begin
       MoName := Owner.MeshObjects[j].Name;
       if MoName = '' then MoName := Format('Mesh%d',[j+1]);
         Writeln('g ' + MoName);
        for i:=0 to Owner.MeshObjects[j].FaceGroups.Count-1 do begin
           //Writeln('o ' + Owner.MeshObjects[j].FaceGroups[i].MaterialName);
           Writeln(Format('s %d',[i+1]));
           fg:=Owner.MeshObjects[j].FaceGroups[i];
         if fg is TOBJFGVertexNormalTexIndexList then begin
              WriteOBJFaceGroup(TOBJFGVertexNormalTexIndexList(fg),k);
         end else if fg is TFGVertexIndexList then begin
              WriteVertexIndexList(TFGVertexIndexList(fg),k);
           end else Assert(False); //unsupported face group
        end;
        //advance vertex index offset
        Inc(k,Owner.MeshObjects[j].Vertices.Count);
      end;
   end;

begin
  Assert(Owner is TGLFreeForm,'Can only save FreeForms.');

  OldDecimalSeparator:=DecimalSeparator;
  DecimalSeparator:='.';
  { Better not call anything that wants the system-locale intact
    from this block }
  try
    WriteHeader;
        WriteVertices;
        WriteNormals;
        WriteTexCoords;
        WriteFaceGroups;
  finally
    DecimalSeparator:=OldDecimalSeparator;
  end;
end;

// ------------------
// ------------------ TGLMTLFile ------------------
// ------------------

// Prepare
//
procedure TGLMTLFile.Prepare;
var
   i : Integer;
   buf : String;
begin
   // "standardize" the mtl file lines
   for i:=Count-1 downto 0 do begin
      buf:=UpperCase(Trim(Strings[i]));
      if (buf='') or (buf[1] in ['#', '$']) then
         Delete(i)
      else begin
         Strings[i]:=StringReplace(buf, #9, #32, [rfIgnoreCase]);
      end;
   end;
end;

// MaterialStringProperty
//
function TGLMTLFile.MaterialStringProperty(const materialName, propertyName : String) : String;
var
   i, n : Integer;
   buf, line : String;
begin
   buf:='NEWMTL '+UpperCase(materialName);
   i:=IndexOf(buf);
   if i>=0 then begin
      buf:=UpperCase(propertyName)+' ';
      n:=Length(buf);
      Inc(i);
      while i<Count do begin
         line:=Strings[i];
         if Copy(line, 1, 7)='NEWMTL ' then Break;
         if Copy(line, 1, n)=buf then begin
            Result:=Copy(Strings[i], n+1, MaxInt);
            Exit;
         end;
         Inc(i);
      end;
   end;
   Result:='';
end;

// MaterialVectorProperty
//
function TGLMTLFile.MaterialVectorProperty(const materialName, propertyName : String;
                                           const defaultValue : TVector) : TVector;
var
   i : Integer;
   sl : TStringList;
begin
   sl:=TStringList.Create;
   try
      sl.CommaText:=MaterialStringProperty(materialName, propertyName);
      if sl.Count>0 then begin
         Result:=NullHmgVector;
         for i:=0 to 3 do
            if sl.Count>i then
               Result[i]:=GLUtils.StrToFloatDef(sl[i])
            else Break;
      end else Result:=defaultValue;
   finally
      sl.Free;
   end;
end;

initialization

   { Register this Fileformat-Handler with GLScene }
   RegisterVectorFileFormat('obj','WaveFront model file',TGLOBJVectorFile);
   RegisterVectorFileFormat('objf','Stripe model file',  TGLOBJVectorFile);

end.