gltexture.pas

这是三Ｄ开发的一些源码

			function GetHeight: Integer; override;

// 			property Picture;

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

			procedure Assign(Source: TPersistent); override;

			function GetBitmap32(target : TGLUInt) : TGLBitmap32; override;
			procedure ReleaseBitmap32; override;

			procedure SaveToFile(const fileName : String); override;
			procedure LoadFromFile(const fileName : String); override;
			class function FriendlyName : String; override;
			class function FriendlyDescription : String; override;

			class function NativeTextureTarget : TGLUInt; override;      
		published
         { Published Declarations }
         {: Width of the blank image (for memory allocation). }
			property Width : Integer read GetWidth write SetWidth default 256;
         {: Width of the blank image (for memory allocation). }
			property Height : Integer read GetHeight write SetHeight default 256;
	end;


   TGLLibMaterial = Class;

   // TGLShaderStyle
   //
   {: Define GLShader style application relatively to a material.<ul>
      <li>ssHighLevel: shader is applied before material application, and unapplied
            after material unapplication
      <li>ssLowLevel: shader is applied after material application, and unapplied
            before material unapplication
      <li>ssReplace: shader is applied in place of the material (and material
            is completely ignored)
      </ul> }
   TGLShaderStyle = (ssHighLevel, ssLowLevel, ssReplace);


   // TGLShaderFailedInitAction
   //
   {: Defines what to do if for some reason shader failed to initialize.<ul>
      <li>fiaSilentdisable:          just disable it
      <li>fiaRaiseHandledException:  raise an exception, and handle it right away
                                     (usefull, when debigging within Delphi)
      <li>fiaRaiseStardardException: raises the exception with a string from this
                                       function GetStardardNotSupportedMessage
      <li>fiaReRaiseException:       Re-raises the exception
      <li>fiaGenerateEvent:          Handles the exception, but generates an event
                                     that user can respond to. For example, he can
                                     try to compile a substitude shader, or replace
                                     it by a material.
                                     Note: HandleFailedInitialization does *not*
                                     create this event, it is left to user shaders
                                     which may chose to override this procedure.
                                     Commented out, because not sure if this
                                     option should exist, let other generations of
                                     developers decide ;)
      </ul> }
   TGLShaderFailedInitAction = (
                    fiaSilentDisable, fiaRaiseStandardException,
                    fiaRaiseHandledException, fiaReRaiseException
                    {,fiaGenerateEvent});

   // TGLShader
   //
   {: Generic, abstract shader class.<p>
      Shaders are modeled here as an abstract material-altering entity with
      transaction-like behaviour. The base class provides basic context and user
      tracking, as well as setup/application facilities.<br>
      Subclasses are expected to provide implementation for DoInitialize,
      DoApply, DoUnApply and DoFinalize. }
   TGLShader = class (TGLUpdateAbleComponent)
	   private
	      { Private Declarations }
         FEnabled : Boolean;
         FLibMatUsers : TList;
         FVirtualHandle : TGLVirtualHandle;
         FShaderStyle : TGLShaderStyle;
         FUpdateCount : Integer;
         FShaderActive, FShaderInitialized : Boolean;
         FFailedInitAction: TGLShaderFailedInitAction;

	   protected
			{ Protected Declarations }
         {: Invoked once, before the first call to DoApply.<p>
            The call happens with the OpenGL context being active. }
         procedure DoInitialize; dynamic;
         {: Request to apply the shader.<p>
            Always followed by a DoUnApply when the shader is no longer needed. }
         procedure DoApply(var rci : TRenderContextInfo; Sender : TObject); virtual; abstract;
         {: Request to un-apply the shader.<p>
            Subclasses can assume the shader has been applied previously.<br>
            Return True to request a multipass. }
         function DoUnApply(var rci : TRenderContextInfo) : Boolean; virtual; abstract;
         {: Invoked once, before the destruction of context or release of shader.<p>
            The call happens with the OpenGL context being active. }
         procedure DoFinalize; dynamic;

         function GetShaderInitialized : Boolean;
         procedure InitializeShader;
         procedure FinalizeShader;
         procedure OnVirtualHandleAllocate(sender : TGLVirtualHandle; var handle : Cardinal);
         procedure OnVirtualHandleDestroy(sender : TGLVirtualHandle; var handle : Cardinal);
         procedure SetEnabled(val : Boolean);

         property ShaderInitialized : Boolean read GetShaderInitialized;
         property ShaderActive : Boolean read FShaderActive;

         procedure RegisterUser(libMat : TGLLibMaterial);
         procedure UnRegisterUser(libMat : TGLLibMaterial);

         {: Used by the DoInitialize procedure of descendant classes to raise errors. }
         procedure HandleFailedInitialization(const LastErrorMessage: string = ''); virtual;

         {: May be this should be a function inside HandleFailedInitialization... }
         class function GetStardardNotSupportedMessage: string; virtual;

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

         {: Subclasses should invoke this function when shader properties are altered.
             This procedure can also be used to reset/recompile the shader. }
         procedure NotifyChange(Sender : TObject); override;
         procedure BeginUpdate;
         procedure EndUpdate;

         {: Apply shader to OpenGL state machine.}
         procedure Apply(var rci : TRenderContextInfo; Sender : TObject);
         {: UnApply shader.<p>
            When returning True, the caller is expected to perform a multipass
            rendering by re-rendering then invoking UnApply again, until a
            "False" is returned. }
         function UnApply(var rci : TRenderContextInfo) : Boolean;

         {: Shader application style (default is ssLowLevel). }
         property ShaderStyle : TGLShaderStyle read FShaderStyle write FShaderStyle default ssLowLevel;

         procedure Assign(Source: TPersistent); override;

         {: Defines if shader is supported by hardware/drivers.
            Default - always supported. Descendants are encouraged to override
            this function. }
         function  ShaderSupported: Boolean; virtual;

         {: Defines what to do if for some reason shader failed to initialize.
            Note, that in some cases it cannon be determined by just checking the
            required OpenGL extentions. You need to try to compile and link the
            shader - only at that stage you might catch an error }
         property FailedInitAction: TGLShaderFailedInitAction
                  read FFailedInitAction write FFailedInitAction default fiaRaiseStandardException;

      published
	      { Published Declarations }
         {: Turns on/off shader application.<p>
            Note that this only turns on/off the shader application, if the
            ShaderStyle is ssReplace, the material won't be applied even if
            the shader is disabled. }
         property Enabled : Boolean read FEnabled write SetEnabled default True;
   end;

   TGLShaderClass = class of TGLShader;

   // TGLTextureFormat
   //
   {: Texture format for OpenGL (rendering) use.<p>
      Internally, GLScene handles all "base" images as 32 Bits RGBA, but you can
      specify a generic format to reduce OpenGL texture memory use:<ul>
      <li>tfDefault : uses global default format
      <li>tfRGB : 24 bits RGB, 8 bits per component
      <li>tfRGBA : 32 bits RGBA, 8 bits per component
      <li>tfRGB16 : 16 bits RGB (5, 5, 5)
      <li>tfRGBA16 : 16 bits RGBA (4, 4, 4, 4)
      <li>tfAlpha : 8 Bits Alpha-channel only
      <li>tfLuminance : 8 bits Luminance only
      <li>tfLuminanceAlpha : 16 bits Luminance and Alpha channel (8, 8)
      <li>tfIntensity : 8 bits Intensity only
      <li>tfNormalMap : 24 bits RGB normal map, which is computed from the
         original texture (assumed to be an hightmap)
      </ul><br>The actual representation may differ, f.i. old 16bits boards
      may convert everything to 16bit formats, GeForce boards don't have
      a 24 bits format internally and will convert to 32 bits, etc. }
   TGLTextureFormat = (tfDefault, tfRGB, tfRGBA, tfRGB16, tfRGBA16, tfAlpha,
                       tfLuminance, tfLuminanceAlpha, tfIntensity, tfNormalMap,
                       tfRGBAFloat16, tfRGBAFloat32); // float_type

   // TGLTextureCompression
   //
   {: Texture compression option.<p>
      If OpenGL supports it, this will activate a compressed texture format:<ul>
      <li>tcDefault : uses global default compression option
      <li>tcNone : do not use compression
      <li>tcStandard : use standard compression, average quality, average rate
      <li>tcHighQuality : choose a high-quality, low-speed compression
      <li>tcHighSpeed : choose a high-speed, low-quality compression
      </ul>. }
   TGLTextureCompression = (tcDefault, tcNone, tcStandard, tcHighQuality, tcHighSpeed);

   // TGLTextureFilteringQuality
   //
   TGLTextureFilteringQuality = (tfIsotropic, tfAnisotropic);

   // TGLTextureMappingMode
   //
   TGLTextureMappingMode = (tmmUser, tmmObjectLinear, tmmEyeLinear, tmmSphere,
                            tmmCubeMapReflection, tmmCubeMapNormal,
                            tmmCubeMapLight0, tmmCubeMapCamera);

	// TGLTexture
	//
   {: Defines basic texturing properties.<p>
      You can control texture wrapping, smoothing/filtering and of course define
      the texture map (note that texturing is disabled by default).<p>
      A built-in mechanism (through ImageAlpha) allows auto-generation of an
      Alpha channel for all bitmaps (see TGLTextureImageAlpha). }
	TGLTexture = class (TGLUpdateAbleObject)
		private
	      { Private Declarations }
			FTextureHandle       : TGLTextureHandle;
			FTextureMode         : TGLTextureMode;
			FTextureWrap         : TGLTextureWrap;
         FTextureFormat       : TGLTextureFormat;
			FMinFilter           : TGLMinFilter;
			FMagFilter           : TGLMagFilter;
			FChanges             : TGLTextureChanges;
			FDisabled            : Boolean;
			FImage               : TGLTextureImage;
			FImageAlpha          : TGLTextureImageAlpha;
         FImageBrightness     : Single;
         FImageGamma          : Single;
         FMappingMode         : TGLTextureMappingMode;
         FMapSCoordinates     : TGLCoordinates4;
         FMapTCoordinates     : TGLCoordinates4;
         FOnTextureNeeded     : TTextureNeededEvent;
         FCompression         : TGLTextureCompression;
         FRequiredMemorySize  : Integer;
         FFilteringQuality    : TGLTextureFilteringQuality;
         FTexWidth, FTexHeight : Integer;
         FEnvColor            : TGLColor;
         FNormalMapScale      : Single;

		protected
			{ Protected Declarations }
         procedure NotifyImageChange;
         procedure NotifyParamsChange;

			procedure SetImage(AValue: TGLTextureImage);
			procedure SetImageAlpha(const val : TGLTextureImageAlpha);
         procedure SetImageBrightness(const val : Single);
         function  StoreBrightness : Boolean;
         procedure SetImageGamma(const val : Single);
         function  StoreGamma : Boolean;
			procedure SetMagFilter(AValue: TGLMagFilter);
			procedure SetMinFilter(AValue: TGLMinFilter);
			procedure SetTextureMode(AValue: TGLTextureMode);
			procedure SetTextureWrap(AValue: TGLTextureWrap);
         procedure SetTextureFormat(const val : TGLTextureFormat);
         procedure SetCompression(const val : TGLTextureCompression);
         procedure SetFilteringQuality(const val : TGLTextureFilteringQuality);