gltexture.pas

这是三Ｄ开发的一些源码

            Subclasses should invoke inherited which will take care of the
            "OnTextureNeeded" stuff. }
			procedure LoadFromFile(const fileName : String); dynamic;
			{: Returns a user-friendly denomination for the class.<p>
				This denomination is used for picking a texture image class
				in the IDE expert. }
			class function FriendlyName : String; virtual; abstract;
			{: Returns a user-friendly description for the class.<p>
				This denomination is used for helping the user when picking a
				texture image class in the IDE expert. If it's not overriden,
				takes its value from FriendlyName. }
			class function FriendlyDescription : String; virtual;
         {: Native opengl texture target.<p>
            Usually GL_TEXTURE_2D (default) or GL_TEXTURE_CUBE_MAP_ARB. }
         class function NativeTextureTarget : TGLUInt; virtual;

			{: Request reload/refresh of data upon next use. }
			procedure Invalidate; dynamic;

			{: Returns image's bitmap handle.<p>
            The specified target can be TEXTURE_2D or one of the cube maps targets.<br>
				If the actual image is not a windows bitmap (BMP), descendants should
				take care of properly converting to bitmap. }
			function GetBitmap32(target : TGLUInt) : TGLBitmap32; virtual; abstract;
			{: Request for unloading bitmapData, to free some memory.<p>
				This one is invoked when GLScene no longer needs the Bitmap data
				it got through a call to GetHBitmap.<br>
				Subclasses may ignore this call if the HBitmap was obtained at
				no particular memory cost. }
			procedure ReleaseBitmap32; virtual;
     //{: AsBitmap : Returns the TextureImage as a TBitmap }
      function  AsBitmap : TGLBitmap;
      procedure AssignToBitmap(aBitmap:TGLBitmap);

			property Width : Integer read GetWidth;
			property Height : Integer read GetHeight;
	end;

	TGLTextureImageClass = class of TGLTextureImage;

   // TGLTextureImageEditor
   //
   TGLTextureImageEditor = class(TObject)
		public
         { Public Properties }
			{: Request to edit a textureImage.<p>
				Returns True if changes have been made.<br>
				This method may be invoked from the IDE or at run-time. }
			class function Edit(aTexImage : TGLTextureImage) : Boolean; virtual; abstract;
   end;

   TGLTextureImageEditorClass = class of TGLTextureImageEditor;

	// TGLBlankImage
	//
	{: A texture image with no specified content, only a size.<p>
      This texture image type is of use if the context of your texture is
      calculated at run-time (with a TGLMemoryViewer for instance). }
	TGLBlankImage = class(TGLTextureImage)
		private
         { Private Declarations }
			FBitmap : TGLBitmap32;
         FWidth, FHeight : Integer;

		protected
         { Protected Declarations }
         procedure SetWidth(val : Integer);
		   function GetWidth: Integer; override;
         procedure SetHeight(val : Integer);
			function GetHeight: Integer; override;

		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;

		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;

	// TGLPictureImage
	//
	{: Base class for image data classes internally based on a TPicture. }
	TGLPictureImage = class(TGLTextureImage)
		private
         { Private Declarations }
			FBitmap : TGLBitmap32;
			FGLPicture : TGLPicture;
			FUpdateCounter : Integer;

		protected
         { Protected Declarations }
			function GetHeight: Integer; override;
			function GetWidth: Integer; override;

         function  GetPicture : TGLPicture; 
			procedure SetPicture(const aPicture : TGLPicture);
			procedure PictureChanged(Sender: TObject);

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

			procedure Assign(Source: TPersistent); override;

			{: Use this function if you are going to modify the Picture directly.<p>
				Each invokation MUST be balanced by a call to EndUpdate. }
			procedure BeginUpdate;
         {: Ends a direct picture modification session.<p>
            Follows a BeginUpdate. }
			procedure EndUpdate;
			function GetBitmap32(target : TGLUInt) : TGLBitmap32; override;
			procedure ReleaseBitmap32; override;

         {: Holds the image content. }
			property Picture : TGLPicture read GetPicture write SetPicture;
	end;

	// TGLPersistentImage
	//
	{: Stores any image compatible with Delphi's TPicture mechanism.<p>
		The picture's data is actually stored into the DFM, the original
		picture name or path is not remembered. It is similar in behaviour
		to Delphi's TImage.<p>
		Note that if original image is for instance JPEG format, only the JPEG
		data will be stored in the DFM (compact) }
	TGLPersistentImage = class(TGLPictureImage)
		public
         { Public Declarations }
			constructor Create(AOwner: TPersistent); override;
			destructor Destroy; override;

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

		published
         { Published Declarations }
			property Picture;
	end;

	// TGLPicFileImage
	//
	{: Uses a picture whose data is found in a file (only filename is stored).<p>
      The image is unloaded after upload to OpenGL. }
	TGLPicFileImage = class(TGLPictureImage)
		private
			FPictureFileName : String;
			FAlreadyWarnedAboutMissingFile : Boolean;
      FWidth: Integer;
      FHeight: Integer;
		protected
			procedure SetPictureFileName(const val : String);
			function GetHeight: Integer; override;
			function GetWidth: Integer; override;
		public
         { Public Declarations }
			constructor Create(AOwner: TPersistent); override;
			destructor Destroy; override;

			procedure Assign(Source: TPersistent); override;

			//: Only picture file name is saved
			procedure SaveToFile(const fileName : String); override;
         {: Load picture file name or use fileName as picture filename.<p>
            The autodetection is based on the filelength and presence of zeros. }
			procedure LoadFromFile(const fileName : String); override;
			class function FriendlyName : String; override;
			class function FriendlyDescription : String; override;

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

		published
         {: Filename of the picture to use. } 
			property PictureFileName : String read FPictureFileName write SetPictureFileName;
	end;

   // TGLCubeMapTarget
   //
   TGLCubeMapTarget = (cmtPX, cmtNX, cmtPY, cmtNY, cmtPZ, cmtNZ);

	// TGLCubeMapImage
	//
	{: A texture image used for specifying and stroing a cube map.<p>
      Not unlike TGLPictureImage, but storing 6 of them instead of just one.<br>
      Saving & loading as a whole currently not supported. }
	TGLCubeMapImage = class(TGLTextureImage)
		private
         { Private Declarations }
			FBitmap : TGLBitmap32;
			FUpdateCounter : Integer;
         FPicture : array [cmtPX..cmtNZ] of TGLPicture;
		protected
         { Protected Declarations }
		   function GetWidth: Integer; override;
			function GetHeight: Integer; override;
         procedure SetPicture(index : TGLCubeMapTarget; const val : TGLPicture);
         function GetPicture(index : TGLCubeMapTarget) : TGLPicture;

			procedure PictureChanged(Sender: TObject);

		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;

			{: Use this function if you are going to modify the Picture directly.<p>
				Each invokation MUST be balanced by a call to EndUpdate. }
			procedure BeginUpdate;
			procedure EndUpdate;

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

         {: Indexed access to the cube map's sub pictures. }
         property Picture[index : TGLCubeMapTarget] : TGLPicture read GetPicture write SetPicture;

		published
         { Public Declarations }
         property PicturePX : TGLPicture index cmtPX read GetPicture write SetPicture;
         property PictureNX : TGLPicture index cmtNX read GetPicture write SetPicture;
         property PicturePY : TGLPicture index cmtPY read GetPicture write SetPicture;
         property PictureNY : TGLPicture index cmtNY read GetPicture write SetPicture;
         property PicturePZ : TGLPicture index cmtPZ read GetPicture write SetPicture;
         property PictureNZ : TGLPicture index cmtNZ read GetPicture write SetPicture;
	end;

	// TGLFloatDataImage
	//
	{: A texture image of float data type.<p>
      Currently only support dynamic nvidia 32bit/16bit RGBA. }
	TGLFloatDataImage = class(TGLTextureImage)
		private
         { Private Declarations }
			FBitmap : TGLBitmap32;
         FWidth, FHeight : Integer;

		protected
         { Protected Declarations }
         procedure SetWidth(val : Integer);
		   function GetWidth: Integer; override;
         procedure SetHeight(val : Integer);