fmain.pas

这是三Ｄ开发的一些源码

{: GLSViewer main form.<p>

   Requires RxLib to compile
   (go to http://sourceforge.net/projects/rxlib for Delphi6 version)
   and Mike Lischke's GraphicEx
   (http://www.delphi-gems.com/)
}
unit FMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ActnList, Menus, ImgList, ToolWin, ComCtrls, GLMisc,
  GLScene, GLWin32Viewer, GLVectorFileObjects, GLObjects, VectorGeometry,
  GLTexture, OpenGL1x, GLContext, ExtDlgs, VectorLists, GLCadencer,
  ExtCtrls, JPEG, TGA, XPMenu, dgToolsSave3DS, StdCtrls, GLBitmapFont,
  GLWindowsFont, GLHUDObjects;

type
  TMain = class(TForm)
    MainMenu: TMainMenu;
    ImageList: TImageList;
    MIFile: TMenuItem;
    MIAbout: TMenuItem;
    Open1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    StatusBar: TStatusBar;
    GLSceneViewer: TGLSceneViewer;
    GLScene: TGLScene;
    MIOptions: TMenuItem;
    MIAntiAlias: TMenuItem;
    MIAADefault: TMenuItem;
    MIAA2x: TMenuItem;
    MIAA4X: TMenuItem;
    MIView: TMenuItem;
    ZoomIn1: TMenuItem;
    ZoomOut1: TMenuItem;
    FreeForm: TGLFreeForm;
    OpenDialog: TOpenDialog;
    GLLightSource: TGLLightSource;
    GLMaterialLibrary: TGLMaterialLibrary;
    CubeExtents: TGLCube;
    Resetview1: TMenuItem;
    N2: TMenuItem;
    Smoothshading1: TMenuItem;
    Flatshading1: TMenuItem;
    Hiddenlines1: TMenuItem;
    Wireframe1: TMenuItem;
    Faceculling1: TMenuItem;
    N3: TMenuItem;
    MIBgColor: TMenuItem;
    ColorDialog: TColorDialog;
    MITexturing: TMenuItem;
    OpenPictureDialog: TOpenPictureDialog;
    MIPickTexture: TMenuItem;
    DCTarget: TGLDummyCube;
    GLCamera: TGLCamera;
    DCAxis: TGLDummyCube;
    FlatShadingwithlines1: TMenuItem;
    MIActions: TMenuItem;
    InvertNormals1: TMenuItem;
    N4: TMenuItem;
    Saveas1: TMenuItem;
    SaveDialog: TSaveDialog;
    ReverseRenderingOrder1: TMenuItem;
    ConverttoIndexedTriangles1: TMenuItem;
    FramesPerSecond1: TMenuItem;
    GLCadencer: TGLCadencer;
    Timer: TTimer;
    GLLightmapLibrary: TGLMaterialLibrary;
    SDTextures: TSaveDialog;
    Savetextures1: TMenuItem;
    MIOpenTexLib: TMenuItem;
    ODTextures: TOpenDialog;
    Optimize1: TMenuItem;
    N5: TMenuItem;
    Stripify1: TMenuItem;
    N6: TMenuItem;
    Lighting1: TMenuItem;
    XPMenu1: TXPMenu;
    GLWindowsBitmapFont1: TGLWindowsBitmapFont;
    GLHUDText1: TGLHUDText;
    ActionList: TActionList;
    ACOpen: TAction;
    ACExit: TAction;
    ACSaveAs: TAction;
    ACZoomIn: TAction;
    ACZoomOut: TAction;
    ACResetView: TAction;
    ACShadeSmooth: TAction;
    ACFlatShading: TAction;
    ACFlatLined: TAction;
    ACHiddenLines: TAction;
    ACWireframe: TAction;
    ACCullFace: TAction;
    ACTexturing: TAction;
    ACInvertNormals: TAction;
    ACReverseRenderingOrder: TAction;
    ACConvertToIndexedTriangles: TAction;
    ACFPS: TAction;
    ACSaveTextures: TAction;
    ACOptimize: TAction;
    ACStripify: TAction;
    ACLighting: TAction;
    ToolBar: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton13: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    ToolButton5: TToolButton;
    ToolButton12: TToolButton;
    TBLighting: TToolButton;
    ToolButton11: TToolButton;
    ToolButton10: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    Panel1: TPanel;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    ListBox1: TListBox;
    ListBox2: TListBox;
    Label1: TLabel;
    Label2: TLabel;
    Image1: TImage;
    Label3: TLabel;
    procedure MIAboutClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ACOpenExecute(Sender: TObject);
    procedure GLSceneViewerMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure GLSceneViewerMouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure GLSceneViewerMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ACZoomInExecute(Sender: TObject);
    procedure ACZoomOutExecute(Sender: TObject);
    procedure ACExitExecute(Sender: TObject);
    procedure ACShadeSmoothExecute(Sender: TObject);
    procedure GLSceneViewerBeforeRender(Sender: TObject);
    procedure MIAADefaultClick(Sender: TObject);
    procedure GLSceneViewerAfterRender(Sender: TObject);
    procedure ACResetViewExecute(Sender: TObject);
    procedure ACCullFaceExecute(Sender: TObject);
    procedure MIBgColorClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure GLMaterialLibraryTextureNeeded(Sender: TObject;
      var textureFileName: String);
    procedure ACTexturingExecute(Sender: TObject);
    procedure MIPickTextureClick(Sender: TObject);
    procedure MIFileClick(Sender: TObject);
    procedure ACInvertNormalsExecute(Sender: TObject);
    procedure ACSaveAsExecute(Sender: TObject);
    procedure ACSaveAsUpdate(Sender: TObject);
    procedure ACReverseRenderingOrderExecute(Sender: TObject);
    procedure ACConvertToIndexedTrianglesExecute(Sender: TObject);
    procedure GLCadencerProgress(Sender: TObject; const deltaTime,
      newTime: Double);
    procedure ACFPSExecute(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure ACSaveTexturesExecute(Sender: TObject);
    procedure MIOpenTexLibClick(Sender: TObject);
    procedure ACOptimizeExecute(Sender: TObject);
    procedure ACStripifyExecute(Sender: TObject);
    procedure ACLightingExecute(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
    procedure ListBox2Click(Sender: TObject);
  private
    { Private declarations }
    procedure DoResetCamera;
    procedure SetupFreeFormShading;
    procedure ApplyShadeModeToMaterial(aMaterial : TGLMaterial);
    procedure ApplyShadeMode;
    procedure ApplyFSAA;
    procedure ApplyFaceCull;
    procedure ApplyBgColor;
    procedure ApplyTexturing;
    procedure ApplyFPS;

    procedure DoOpen(const fileName : String);
    function AllocMeshObject( mesh: TGLBaseMesh; name: string ): TMeshObject;
    function AllocFacegroup( mo: TMeshobject; matname: string ): TFGVertexNormalTexIndexList;
    procedure RebuildOneMeshObject( mesh: TGLFreeform );
    procedure SmoothMesh( mesh: TGLFreeform );
    procedure AddMeshObjectsAndFaces;
  public
    { Public declarations }
    md, nthShow : Boolean;
    mx, my : Integer;
    hlShader : TGLShader;
    lastFileName : String;
    lastLoadWithTextures : Boolean;
    ToolSave3DS: TOXToolSave3DS;
  end;

var
  Main: TMain;
  TabSheet: array of TTabSheet;
  ImageTexture: array of TImage;

implementation

{$R *.dfm}

{
  RebuildOneMeshObject(FreeForm );
  FreeForm.StructureChanged;
  SetupFreeFormShading;
}

uses GLKeyBoard, GLGraphics, PersistentClasses, MeshUtils,
     GLFileOBJ, GLFileSTL, GLFileLWO, GLFileQ3BSP, GLFileOCT, GLFileMS3D,
     GLFileNMF, GLFileMD3, GLFile3DS, GLFileMD2, GLFileSMD, GLFileTIN,
     GLFilePLY, GLFileGTS, GLFileVRML, GLFileMD5, GLMeshOptimizer,
     GLState;

type
  THiddenLineShader = class( TGLShader )
    private
      LinesColor: TColorVector;
      BackgroundColor: TColorVector;
      PassCount: Integer;
    public
      procedure DoApply(var rci: TRenderContextInfo; Sender: TObject); override;
      function DoUnApply(var rci: TRenderContextInfo): Boolean; override;
   end;

procedure THiddenLineShader.DoApply(var rci : TRenderContextInfo; Sender : TObject);
begin
   PassCount:=1;
   rci.GLStates.SetGLPolygonMode(GL_FRONT_AND_BACK, GL_FILL);
   glPushAttrib(GL_ENABLE_BIT);
   glPushAttrib(GL_CURRENT_BIT+GL_ENABLE_BIT);
   glColor3fv(@BackgroundColor);
   glDisable(GL_TEXTURE_2D);
   glEnable(GL_POLYGON_OFFSET_FILL);
   glPolygonOffset(1, 2);
end;

function THiddenLineShader.DoUnApply(var rci : TRenderContextInfo) : Boolean;
begin
   case PassCount of
      1 : begin
         PassCount:=2;
         rci.GLStates.SetGLPolygonMode(GL_FRONT_AND_BACK, GL_LINE);
         glPopAttrib;
         glColor3fv(@LinesColor);
         glDisable(GL_LIGHTING);
         Result:=True;
      end;
      2 : begin
         glPopAttrib;
         Result:=False;
      end;
   else
      // doesn't hurt to be cautious
      Assert(False);
      Result:=False;
   end;
end;

procedure TMain.SmoothMesh( mesh: TGLFreeform );
var
  i, j: Integer;
  tris, norms, tex, buf, morphTris, morphNorms: TAffineVectorList;
  indices, texIndices: TIntegerlist;
  firstRemap, subdivideRemap, bufRemap: TIntegerList;
  t: Int64;
  MatName: string;
begin
  for i:= 0 to mesh.MeshObjects.Count -1 do begin
    tex:= TAffineVectorList.Create;
    with mesh.MeshObjects[i] do begin
      tris:= ExtractTriangles( tex );
    end;
    indices:= BuildVectorCountOptimizedIndices( tris );
    firstRemap:= TIntegerList( indices.CreateClone );
    RemapAndCleanupReferences( tris, indices );
    norms:= BuildNormals( tris, indices );
    texIndices:= BuildVectorCountOptimizedIndices( tex );
    RemapAndCleanupReferences( tex, texIndices );
    buf:= TAffineVectorList.Create;
    try
      ConvertIndexedListToList( tris, indices, buf );
      tris.Assign( buf );
      buf.Count:= 0;
      ConvertIndexedListToList( norms, indices, buf );
      norms.Assign( buf );
      buf.Count:= 0;
      ConvertIndexedListToList( tex, texIndices, buf );
      tex.Assign( buf );
    finally
      buf.Free;
    end;
    indices.Free;
    indices:= BuildVectorCountOptimizedIndices( tris, norms, tex );
    subdivideRemap:= TIntegerList( indices.CreateClone );
    RemapReferences( norms, indices );
    RemapReferences( tex, indices );
    RemapAndCleanupReferences( tris, indices );
    IncreaseCoherency( indices, 13 );
    //
    with mesh.MeshObjects[i] as TMeshObject do begin
      //bufRemap:= TIntegerList.Create;
      {for j:= 0 to MorphTargets.Count -1 do begin
        //MorphTo( j );
        morphTris:= ExtractTriangles;
            bufRemap.Assign(firstRemap);
            RemapAndCleanupReferences(morphTris, bufRemap);

            morphNorms:=MeshUtils.BuildNormals(morphTris, bufRemap);

            SubdivideTriangles(TrackBar1.Position*0.1, morphTris, bufRemap, morphNorms);

            buf:=TAffineVectorList.Create;
            try
               ConvertIndexedListToList(morphTris, bufRemap, buf);
               morphTris.Assign(buf);
               ConvertIndexedListToList(morphNorms, bufRemap, buf);
               morphNorms.Assign(buf);
            finally
               buf.Free;
            end;
            RemapReferences(morphTris, subdivideRemap);
            RemapReferences(morphNorms, subdivideRemap);

            MorphTargets[j].Vertices:=morphTris;
            MorphTargets[j].Normals:=morphNorms;

            morphTris.Free;
            morphNorms.Free;
         end;}
         //bufRemap.Free;

         Vertices:= tris;
         Normals:= norms;
         TexCoords:= tex;
         MatName:= FaceGroups[i].MaterialName;
         FaceGroups.Clear;
         with TFGVertexIndexList.CreateOwned( FaceGroups ) do begin