gltexture.pas

这是三Ｄ开发的一些源码

         procedure SetMappingMode(const val : TGLTextureMappingMode);
         function  GetMappingSCoordinates : TGLCoordinates4;
         procedure SetMappingSCoordinates(const val : TGLCoordinates4);
         function  GetMappingTCoordinates : TGLCoordinates4;
         procedure SetMappingTCoordinates(const val : TGLCoordinates4);
			procedure SetDisabled(AValue: Boolean);
         procedure SetEnabled(const val : Boolean);
         function GetEnabled : Boolean;
         procedure SetEnvColor(const val : TGLColor);
         procedure SetNormalMapScale(const val : Single);
         function StoreNormalMapScale : Boolean;

         function StoreImageClassName : Boolean;

			function GetHandle: TGLuint; virtual;
			//: Load texture to OpenGL subsystem
			procedure PrepareImage(target : TGLUInt); virtual;
			//: Setup OpenGL texture parameters
			procedure PrepareParams(target : TGLUInt); virtual;

         property OnTextureNeeded : TTextureNeededEvent read FOnTextureNeeded write FOnTextureNeeded;
         procedure DoOnTextureNeeded(Sender : TObject; var textureFileName : String);

		public
	      { Public Declarations }
			constructor Create(AOwner: TPersistent); override;
			destructor  Destroy; override;

         procedure PrepareBuildList;
         procedure ApplyMappingMode;
         procedure UnApplyMappingMode;
			procedure Apply(var rci : TRenderContextInfo);
         procedure UnApply(var rci : TRenderContextInfo);
         {: Applies to TEXTURE1_ARB }
         procedure ApplyAsTexture2(var rci : TRenderContextInfo; libMaterial : TGLLibMaterial);
         procedure UnApplyAsTexture2(var rci : TRenderContextInfo; libMaterial : TGLLibMaterial);
         {: N=1 for TEXTURE0_ARB, N=2 for TEXTURE1_ARB, etc. }
         procedure ApplyAsTextureN(n : Integer; var rci : TRenderContextInfo; libMaterial : TGLLibMaterial);
         procedure UnApplyAsTextureN(n : Integer; var rci : TRenderContextInfo; libMaterial : TGLLibMaterial);

			procedure Assign(Source: TPersistent); override;
			procedure NotifyChange(Sender : TObject); override;

			procedure DestroyHandles;

			procedure SetImageClassName(const val : String);
			function GetImageClassName : String;

         {: Returns the OpenGL memory used by the texture.<p>
            The compressed size is returned if, and only if texture compression
            if active and possible, and the texture has been allocated (Handle
            is defined), otherwise the estimated size (from TextureFormat
            specification) is returned. }
         function TextureImageRequiredMemory : Integer;
         {: Allocates the texture handle if not already allocated.<p>
            The texture is binded and parameters are setup, but no image data
            is initialized by this call - for expert use only. }
         function AllocateHandle : TGLuint;
         function IsHandleAllocated : Boolean;
         {: Returns OpenGL texture format corresponding to current options. }
         function OpenGLTextureFormat : Integer;
         {: Returns if of float data type}
         function IsFloatType: boolean;

         {: Copy texture image from texture memory to main memory.<p>
            Useful for retriving texture data generated with GPU.
            RenderingContext is needed because we need an activated rendering context
            to call OpenGL functions for accessing texture data.
            }
         procedure GetFloatTexImage(RenderingContext : TGLContext; data : pointer);
         procedure SetFloatTexImage(RenderingContext : TGLContext; data : pointer);

         {: Is the texture enabled?.<p>
            Always equals to 'not Disabled'. }
         property Enabled : Boolean read GetEnabled write SetEnabled;
         {: Handle to the OpenGL texture object.<p>
            If the handle hasn't already been allocated, it will be allocated
            by this call (ie. do not use if no OpenGL context is active!) }
			property Handle : TGLuint read GetHandle;

         {: Actual width used for last texture specification binding. }
         property TexWidth : Integer read FTexWidth;
         {: Actual width used for last texture specification binding. }
         property TexHeight : Integer read FTexHeight;

		published
	      { Published Declarations }

			{: Image ClassName for enabling True polymorphism.<p>
				This is ugly, but since the default streaming mechanism does a
				really bad job at storing	polymorphic owned-object properties,
				and neither TFiler nor TPicture allow proper use of the built-in
				streaming, that's the only way I found to allow a user-extensible
				mechanism. }
			property ImageClassName : String read GetImageClassName write SetImageClassName stored StoreImageClassName;
			{: Image data for the texture.<p> }
			property Image: TGLTextureImage read FImage write SetImage;

         {: Automatic Image Alpha setting.<p>
            Allows to control how and if the image's Alpha channel (transparency)
            is computed. }
			property ImageAlpha : TGLTextureImageAlpha read FImageAlpha write SetImageAlpha default tiaDefault;
         {: Texture brightness correction.<p>
            This correction is applied upon loading a TGLTextureImage, it's a
            simple saturating scaling applied to the RGB components of
            the 32 bits image, before it is passed to OpenGL, and before
            gamma correction (if any). }
         property ImageBrightness : Single read FImageBrightness write SetImageBrightness stored StoreBrightness;
         {: Texture gamma correction.<p>
            The gamma correction is applied upon loading a TGLTextureImage,
            applied to the RGB components of the 32 bits image, before it is
            passed to OpenGL, after brightness correction (if any). }
         property ImageGamma : Single read FImageGamma write SetImageGamma stored StoreGamma;

         {: Texture magnification filter. }
			property MagFilter: TGLMagFilter read FMagFilter write SetMagFilter default maLinear;
         {: Texture minification filter. }
			property MinFilter: TGLMinFilter read FMinFilter write SetMinFilter default miLinearMipMapLinear;
         {: Texture application mode. }
			property TextureMode: TGLTextureMode read FTextureMode write SetTextureMode default tmDecal;
         {: Wrapping mode for the texture. }
			property TextureWrap: TGLTextureWrap read FTextureWrap write SetTextureWrap default twBoth;

         {: Texture format for use by the renderer.<p>
            See TGLTextureFormat for details. }
         property TextureFormat : TGLTextureFormat read FTextureFormat write SetTextureFormat default tfDefault;
         {: Texture compression control.<p>
            If True the compressed TextureFormat variant (the OpenGL ICD must
            support GL_ARB_texture_compression, or this option is ignored). }
         property Compression : TGLTextureCompression read FCompression write SetCompression default tcDefault;
         {: Specifies texture filtering quality.<p>
            You can choose between bilinear and trilinear filetring (anisotropic).<p>
            The OpenGL ICD must support GL_EXT_texture_filter_anisotropic or
            this property is ignored. }
         property FilteringQuality : TGLTextureFilteringQuality read FFilteringQuality write SetFilteringQuality default tfIsotropic;

         {: Texture coordinates mapping mode.<p>
            This property controls automatic texture coordinates generation. }
         property MappingMode : TGLTextureMappingMode read FMappingMode write SetMappingMode default tmmUser;
         {: Texture mapping coordinates mode for S axis.<p>
            This property stores the coordinates for automatic texture
            coordinates generation. }
         property MappingSCoordinates : TGLCoordinates4 read GetMappingSCoordinates write SetMappingSCoordinates;
         {: Texture mapping coordinates mode for T axis.<p>
            This property stores the coordinates for automatic texture
            coordinates generation. }
         property MappingTCoordinates : TGLCoordinates4 read GetMappingTCoordinates write SetMappingTCoordinates;

         {: Texture Environment color. }
         property EnvColor : TGLColor read FEnvColor write SetEnvColor;

         {: If true, the texture is disabled (not used). }
			property Disabled: Boolean read FDisabled write SetDisabled default True;

         {: Normal Map scaling.<p>
            Only applies when TextureFormat is tfNormalMap, this property defines
            the scaling that is applied during normal map generation (ie. controls
            the intensity of the bumps). }
         property NormalMapScale : Single read FNormalMapScale write SetNormalMapScale stored StoreNormalMapScale;
	end;

   // TGLTextureExItem
   //
   TGLTextureExItem = class (TCollectionItem)
      private
         { Private Decalarations }
         FTexture : TGLTexture;
         FTextureIndex : Integer;
         FTextureOffset, FTextureScale : TGLCoordinates;
         FTextureMatrixIsIdentity : Boolean;
         FTextureMatrix : TMatrix;
         FApplied : Boolean;

      protected
         { Protected Decalarations }
         function GetDisplayName : String; override;
         function GetOwner : TPersistent; override;
         procedure SetTexture(const Value : TGLTexture);
         procedure SetTextureIndex(const Value : Integer);
         procedure SetTextureOffset(const Value : TGLCoordinates);
         procedure SetTextureScale(const Value : TGLCoordinates);
         procedure NotifyTexMapChange(Sender : TObject);

         procedure CalculateTextureMatrix;

         procedure OnNotifyChange(Sender : TObject);

      public
         { Public Decalarations }
         constructor Create(ACollection : TCollection); override;
         destructor Destroy; override;

         procedure Assign(Source: TPersistent); override;
         procedure NotifyChange(Sender : TObject);

         procedure Apply(var rci : TRenderContextInfo);
         procedure UnApply(var rci : TRenderContextInfo);

      published
         { Published Decalarations }
         property Texture : TGLTexture read FTexture write SetTexture;
         property TextureIndex : Integer read FTextureIndex write SetTextureIndex;
         property TextureOffset : TGLCoordinates read FTextureOffset write SetTextureOffset;
         property TextureScale : TGLCoordinates read FTextureScale write SetTextureScale;

   end;

   // TGLTextureEx
   //
   TGLTextureEx = class (TCollection)
      private
         FMaterial : TGLMaterial;

      protected
         { Protected Decalarations }
         procedure SetItems(index : Integer; const Value : TGLTextureExItem);
         function GetItems(index : Integer) : TGLTextureExItem;
         function GetOwner : TPersistent; override;
         procedure Loaded;

      public
         { Public Decalarations }
         constructor Create(AOwner : TGLMaterial);

         procedure NotifyChange(Sender : TObject);
         procedure Apply(var rci : TRenderContextInfo);
         procedure UnApply(var rci : TRenderContextInfo);
         function IsTextureEnabled(Index : Integer) : Boolean;

         function Add : TGLTextureExItem;

         property Items[index : Integer] : TGLTextureExItem read GetItems write SetItems; default;
   end;

	TShininess = 0..128;
   TPolygonMode = (pmFill, pmLines, pmPoints);

   // TGLFaceProperties
   //
   {: Stores basic face lighting properties.<p>
      The lighting is described with the standard ambient/diffuse/emission/specular
      properties that behave like those of most rendering tools.<br>
      You also have control over shininess (governs specular lighting) and
      polygon mode (lines / fill). }
	TGLFaceProperties = class (TGLUpdateAbleObject)
	   private
	      { Private Declarations }
         FAmbient, FDiffuse, FSpecular, FEmission  : TGLColor;
         FPolygonMode : TPolygonMode;
         FShininess : TShininess;

      protected
	      { Protected Declarations }
         procedure SetAmbient(AValue: TGLColor);
         procedure SetDiffuse(AValue: TGLColor);
         procedure SetEmission(AValue: TGLColor);
         procedure SetSpecular(AValue: TGLColor);
         procedure SetPolygonMode(AValue: TPolygonMode);
         procedure SetShininess(AValue: TShininess);

	   public
			{ Public Declarations }
         constructor Create(AOwne