经常用到的那个纹理载入单元

老外写的，很好用

//----------------------------------------------------------------------------
// 纹理载入
// 作者     : Jan Horn
// 用法     : LoadTexture(Filename,Texture,True):Boolean;
// 支持格式 : JPG、BMP、TGA
//----------------------------------------------------------------------------
unit Textures;

interface

uses
  Windows, OpenGL, Graphics, Classes, JPEG, SysUtils;

function LoadTexture(Filename: string; var Texture: GLuint; LoadFromRes: Boolean): Boolean;

implementation

function gluBuild2DMipmaps(Target: GLenum; Components, Width, Height: GLint; Format, atype: GLenum; Data: Pointer): GLint; stdcall; external glu32;

procedure glGenTextures(n: GLsizei; var Textures: GLuint); stdcall; external opengl32;

procedure glBindTexture(Target: GLenum; Texture: GLuint); stdcall; external opengl32;

{------------------------------------------------------------------}
{  Swap bitmap format from BGR to RGB                              }
{------------------------------------------------------------------}

procedure SwapRGB(Data: Pointer; Size: Integer);
asm
  mov ebx, eax
  mov ecx, size

@@loop :
  mov al,[ebx+0]
  mov ah,[ebx+2]
  mov [ebx+2],al
  mov [ebx+0],ah
  add ebx,3
  dec ecx
  jnz @@loop
end;

{------------------------------------------------------------------}
{  Create the Texture                                              }
{------------------------------------------------------------------}

function CreateTexture(Width, Height, Format: Word; pData: Pointer): Integer;
var
  Texture: GLuint;
begin
  glGenTextures(1, Texture);
  glBindTexture(GL_TEXTURE_2D, Texture);
  glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE); {Texture blends with object background}
  //  glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL);  {Texture does NOT blend with object background}

    { Select a filtering type. BiLinear filtering produces very good results with little performance impact
      GL_NEAREST               - Basic texture (grainy looking texture)
      GL_LINEAR                - BiLinear filtering
      GL_LINEAR_MIPMAP_NEAREST - Basic mipmapped texture
      GL_LINEAR_MIPMAP_LINEAR  - BiLinear Mipmapped texture
    }

  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); { only first two can be used }
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); { all of the above can be used }

  if Format = GL_RGBA then
    gluBuild2DMipmaps(GL_TEXTURE_2D, GL_RGBA, Width, Height, GL_RGBA, GL_UNSIGNED_BYTE, pData)
  else
    gluBuild2DMipmaps(GL_TEXTURE_2D, 3, Width, Height, GL_RGB, GL_UNSIGNED_BYTE, pData);
  //  glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_RGB, GL_UNSIGNED_BYTE, pData);  // Use when not wanting mipmaps to be built by openGL

  result := Texture;
end;

{------------------------------------------------------------------}
{  Load BMP textures                                               }
{------------------------------------------------------------------}

function LoadBMPTexture(Filename: string; var Texture: GLuint; LoadFromResource: Boolean): Boolean;
var
  FileHeader: BITMAPFILEHEADER;
  InfoHeader: BITMAPINFOHEADER;
  Palette: array of RGBQUAD;
  BitmapFile: THandle;
  BitmapLength: LongWord;
  PaletteLength: LongWord;
  ReadBytes: LongWord;
  Width, Height: Integer;
  pData: Pointer;

  // used for loading from resource
  ResStream: TResourceStream;
begin
  result := False;

  if LoadFromResource then // Load from resource
  begin
    try
      ResStream := TResourceStream.Create(hInstance, pchar(copy(Filename, 1, Pos('.', Filename) - 1)), 'BMP');
      ResStream.ReadBuffer(FileHeader, SizeOf(FileHeader)); // FileHeader
      ResStream.ReadBuffer(InfoHeader, SizeOf(InfoHeader)); // InfoHeader
      PaletteLength := InfoHeader.biClrUsed;
      SetLength(Palette, PaletteLength);
      ResStream.ReadBuffer(Palette, PaletteLength); // Palette

      Width := InfoHeader.biWidth;
      Height := InfoHeader.biHeight;

      BitmapLength := InfoHeader.biSizeImage;
      if BitmapLength = 0 then
        BitmapLength := Width * Height * InfoHeader.biBitCount div 8;

      GetMem(pData, BitmapLength);
      ResStream.ReadBuffer(pData^, BitmapLength); // Bitmap Data
      ResStream.Free;
    except on
      EResNotFound do
      begin
        MessageBox(0, pchar('File not found in resource - ' + Filename), pchar('BMP Texture'), MB_OK);
        Exit;
      end
    else
      begin
        MessageBox(0, pchar('Unable to read from resource - ' + Filename), pchar('BMP Unit'), MB_OK);
        Exit;
      end;
    end;
  end
  else
  begin // Load image from file
    BitmapFile := CreateFile(pchar(Filename), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
    if (BitmapFile = INVALID_HANDLE_VALUE) then
    begin
      MessageBox(0, pchar('Error opening ' + Filename), pchar('BMP Unit'), MB_OK);
      Exit;
    end;

    // Get header information
    ReadFile(BitmapFile, FileHeader, SizeOf(FileHeader), ReadBytes, nil);
    ReadFile(BitmapFile, InfoHeader, SizeOf(InfoHeader), ReadBytes, nil);

    // Get palette
    PaletteLength := InfoHeader.biClrUsed;
    SetLength(Palette, PaletteLength);
    ReadFile(BitmapFile, Palette, PaletteLength, ReadBytes, nil);
    if (ReadBytes <> PaletteLength) then
    begin
      MessageBox(0, pchar('Error reading palette'), pchar('BMP Unit'), MB_OK);
      Exit;
    end;

    Width := InfoHeader.biWidth;
    Height := InfoHeader.biHeight;
    BitmapLength := InfoHeader.biSizeImage;
    if BitmapLength = 0 then
      BitmapLength := Width * Height * InfoHeader.biBitCount div 8;

    // Get the actual pixel data
    GetMem(pData, BitmapLength);
    ReadFile(BitmapFile, pData^, BitmapLength, ReadBytes, nil);
    if (ReadBytes <> BitmapLength) then
    begin
      MessageBox(0, pchar('Error reading bitmap data'), pchar('BMP Unit'), MB_OK);
      Exit;
    end;
    CloseHandle(BitmapFile);
  end;

  // Bitmaps are stored BGR and not RGB, so swap the R and B bytes.
  SwapRGB(pData, Width * Height);

  Texture := CreateTexture(Width, Height, GL_RGB, pData);
  FreeMem(pData);
  result := True;
end;

{------------------------------------------------------------------}
{  Load JPEG textures                                              }
{------------------------------------------------------------------}

function LoadJPGTexture(Filename: string; var Texture: GLuint; LoadFromResource: Boolean): Boolean;
var
  Data: array of LongWord;
  W, Width: Integer;
  H, Height: Integer;
  BMP: TBitmap;
  JPG: TJPEGImage;
  C: LongWord;
  Line: ^LongWord;
  ResStream: TResourceStream; // used for loading from resource
begin
  result := False;
  JPG := TJPEGImage.Create;

  if LoadFromResource then // Load from resource
  begin
    try
      ResStream := TResourceStream.Create(hInstance, pchar(copy(Filename, 1, Pos('.', Filename) - 1)), 'JPEG');
      JPG.LoadFromStream(ResStream);
      ResStream.Free;
    except on
      EResNotFound do
      begin
        MessageBox(0, pchar('File not found in resource - ' + Filename), pchar('JPG Texture'), MB_OK);
        Exit;
      end
    else
      begin
        MessageBox(0, pchar('Couldn''t load JPG Resource - "' + Filename + '"'), pchar('BMP Unit'), MB_OK);
        Exit;
      end;
    end;
  end
  else
  begin
    try
      JPG.LoadFromFile(Filename);
    except
      MessageBox(0, pchar('Couldn''t load JPG - "' + Filename + '"'), pchar('BMP Unit'), MB_OK);
      Exit;
    end;
  end;

  // Create Bitmap
  BMP := TBitmap.Create;
  BMP.pixelformat := pf32bit;
  BMP.Width := JPG.Width;
  BMP.Height := JPG.Height;
  BMP.canvas.draw(0, 0, JPG); // Copy the JPEG onto the Bitmap

  //  BMP.SaveToFile('D:/test.bmp');
  Width := BMP.Width;
  Height := BMP.Height;
  SetLength(Data, Width * Height);

  for H := 0 to Height - 1 do
  begin
    Line := BMP.scanline[Height - H - 1]; // flip JPEG
    for W := 0 to Width - 1 do
    begin
      C := Line^ and $FFFFFF; // Need to do a color swap
      Data[W + (H * Width)] := (((C and $FF) shl 16) + (C shr 16) + (C and $FF00)) or $FF000000; // 4 channel.
      inc(Line);
    end;
  end;

  BMP.Free;
  JPG.Free;

  Texture := CreateTexture(Width, Height, GL_RGBA, addr(Data[0]));
  result := True;
end;

{------------------------------------------------------------------}
{  Loads 24 and 32bpp (alpha channel) TGA textures                 }
{------------------------------------------------------------------}

function LoadTGATexture(Filename: string; var Texture: GLuint; LoadFromResource: Boolean): Boolean;
var
  TGAHeader: packed record // Header type for TGA images
    FileType: Byte;
    ColorMapType: Byte;
    ImageType: Byte;
    ColorMapSpec: array[0..4] of Byte;
    OrigX: array[0..1] of Byte;
    OrigY: array[0..1] of Byte;
    Width: array[0..1] of Byte;
    Height: array[0..1] of Byte;
    BPP: Byte;
    ImageInfo: Byte;
  end;
  TGAFile: file;
  bytesRead: Integer;
  image: Pointer; {or PRGBTRIPLE}
  CompImage: Pointer;
  Width, Height: Integer;
  ColorDepth: Integer;
  ImageSize: Integer;
  BufferIndex: Integer;
  currentByte: Integer;
  CurrentPixel: Integer;
  i: Integer;
  Front: ^Byte;
  Back: ^Byte;
  Temp: Byte;

  ResStream: TResourceStream; // used for loading from resource

  // Copy a pixel from source to dest and Swap the RGB color values

  procedure CopySwapPixel(const Source, Destination: Pointer);
  asm
    push ebx
    mov bl,[eax+0]
    mov bh,[eax+1]
    mov [edx+2],bl
    mov [edx+1],bh
    mov bl,[eax+2]
    mov bh,[eax+3]
    mov [edx+0],bl
    mov [edx+3],bh
    pop ebx
  end;

begin
  result := False;
  GetMem(image, 0);
  if LoadFromResource then // Load from resource
  begin
    try
      ResStream := TResourceStream.Create(hInstance, pchar(copy(Filename, 1, Pos('.', Filename) - 1)), 'TGA');
      ResStream.ReadBuffer(TGAHeader, SizeOf(TGAHeader)); // FileHeader
      result := True;
    except on
      EResNotFound do
      begin
        MessageBox(0, pchar('File not found in resource - ' + Filename), pchar('TGA Texture'), MB_OK);
        Exit;
      end
    else
      begin
        MessageBox(0, pchar('Unable to read from resource - ' + Filename), pchar('BMP Unit'), MB_OK);
        Exit;
      end;
    end;
  end
  else
  begin
    if FileExists(Filename) then
    begin
      AssignFile(TGAFile, Filename);
      Reset(TGAFile, 1);

      // Read in the bitmap file header
      BlockRead(TGAFile, TGAHeader, SizeOf(TGAHeader));
      result := True;
    end
    else
    begin
      MessageBox(0, pchar('File not found  - ' + Filename), pchar('TGA Texture'), MB_OK);
      Exit;
    end;
  end;

  if result = True then
  begin
    result := False;

    // Only support 24, 32 bit images
    if (TGAHeader.ImageType <> 2) and { TGA_RGB }
      (TGAHeader.ImageType <> 10) then { Compressed RGB }
    begin
      result := False;
      CloseFile(TGAFile);
      MessageBox(0, pchar('Couldn''t load "' + Filename + '". Only 24 and 32bit TGA supported.'), pchar('TGA File Error'), MB_OK);
      Exit;
    end;

    // Don't support colormapped files
    if TGAHeader.ColorMapType <> 0 then
    begin
      result := False;
      CloseFile(TGAFile);
      MessageBox(0, pchar('Couldn''t load "' + Filename + '". Colormapped TGA files not supported.'), pchar('TGA File Error'), MB_OK);
      Exit;
    end;

    // Get the width, height, and color depth
    Width := TGAHeader.Width[0] + TGAHeader.Width[1] * 256;
    Height := TGAHeader.Height[0] + TGAHeader.Height[1] * 256;
    ColorDepth := TGAHeader.BPP;
    ImageSize := Width * Height * (ColorDepth div 8);

    if ColorDepth < 24 then
    begin
      result := False;
      CloseFile(TGAFile);
      MessageBox(0, pchar('Couldn''t load "' + Filename + '". Only 24 and 32 bit TGA files supported.'), pchar('TGA File Error'), MB_OK);
      Exit;
    end;

    GetMem(image, ImageSize);

    if TGAHeader.ImageType = 2 then // Standard 24, 32 bit TGA file
    begin
      if LoadFromResource then // Load from resource
      begin
        try
          ResStream.ReadBuffer(image^, ImageSize);
          ResStream.Free;
        except
          MessageBox(0, pchar('Unable to read from resource - ' + Filename), pchar('BMP Unit'), MB_OK);
          Exit;
        end;
      end
      else // Read in the image from file
      begin
        BlockRead(TGAFile, image^, ImageSize, bytesRead);
        if bytesRead <> ImageSize then
        begin
          result := False;
          CloseFile(TGAFile);
          MessageBox(0, pchar('Couldn''t read file "' + Filename + '".'), pchar('TGA File Error'), MB_OK);
          Exit;
        end
      end;

      // TGAs are stored BGR and not RGB, so swap the R and B bytes.
      // 32 bit TGA files have alpha channel and gets loaded differently
      if TGAHeader.BPP = 24 then
      begin
        for i := 0 to Width * Height - 1 do
        begin
          Front := Pointer(Integer(image) + i * 3);
          Back := Pointer(Integer(image) + i * 3 + 2);
          Temp := Front^;
          Front^ := Back^;
          Back^ := Temp;
        end;
        Texture := CreateTexture(Width, Height, GL_RGB, image);
      end
      else
      begin
        for i := 0 to Width * Height - 1 do
        begin
          Front := Pointer(Integer(image) + i * 4);
          Back := Pointer(Integer(image) + i * 4 + 2);
          Temp := Front^;
          Front^ := Back^;
          Back^ := Temp;
        end;
        Texture := CreateTexture(Width, Height, GL_RGBA, image);
      end;
    end;

    // Compressed 24, 32 bit TGA files
    if TGAHeader.ImageType = 10 then
    begin
      ColorDepth := ColorDepth div 8;
      currentByte := 0;
      CurrentPixel := 0;
      BufferIndex := 0;

      if LoadFromResource then // Load from resource
      begin
        try
          GetMem(CompImage, ResStream.Size - SizeOf(TGAHeader));
          ResStream.ReadBuffer(CompImage^, ResStream.Size - SizeOf(TGAHeader)); // load compressed date into memory
          ResStream.Free;
        except
          MessageBox(0, pchar('Unable to read from resource - ' + Filename), pchar('BMP Unit'), MB_OK);
          Exit;
        end;
      end
      else
      begin
        GetMem(CompImage, FileSize(TGAFile) - SizeOf(TGAHeader));
        BlockRead(TGAFile, CompImage^, FileSize(TGAFile) - SizeOf(TGAHeader), bytesRead); // load compressed data into memory
        if bytesRead <> FileSize(TGAFile) - SizeOf(TGAHeader) then
        begin
          result := False;
          CloseFile(TGAFile);
          MessageBox(0, pchar('Couldn''t read file "' + Filename + '".'), pchar('TGA File Error'), MB_OK);
          Exit;
        end
      end;

      // Extract pixel information from compressed data
      repeat
        Front := Pointer(Integer(CompImage) + BufferIndex);
        inc(BufferIndex);
        if Front^ < 128 then
        begin
          for i := 0 to Front^ do
          begin
            CopySwapPixel(Pointer(Integer(CompImage) + BufferIndex + i * ColorDepth), Pointer(Integer(image) + currentByte));
            currentByte := currentByte + ColorDepth;
            inc(CurrentPixel);
          end;
          BufferIndex := BufferIndex + (Front^ + 1) * ColorDepth
        end
        else
        begin
          for i := 0 to Front^ - 128 do
          begin
            CopySwapPixel(Pointer(Integer(CompImage) + BufferIndex), Pointer(Integer(image) + currentByte));
            currentByte := currentByte + ColorDepth;
            inc(CurrentPixel);
          end;
          BufferIndex := BufferIndex + ColorDepth
        end;
      until CurrentPixel >= Width * Height;

      if ColorDepth = 3 then
        Texture := CreateTexture(Width, Height, GL_RGB, image)
      else
        Texture := CreateTexture(Width, Height, GL_RGBA, image);
    end;

    result := True;
    FreeMem(image);
  end;
end;

{------------------------------------------------------------------}
{  Determines file type and sends to correct function              }
{------------------------------------------------------------------}

function LoadTexture(Filename: string; var Texture: GLuint; LoadFromRes: Boolean): Boolean;
begin
  if copy(Uppercase(Filename), length(Filename) - 3, 4) = '.BMP' then
    LoadBMPTexture(Filename, Texture, LoadFromRes);
  if copy(Uppercase(Filename), length(Filename) - 3, 4) = '.JPG' then
    LoadJPGTexture(Filename, Texture, LoadFromRes);
  if copy(Uppercase(Filename), length(Filename) - 3, 4) = '.TGA' then
    LoadTGATexture(Filename, Texture, LoadFromRes);
  result := True;
end;

end.