Create OpenGL Texture from TBitmap

**paul_nicholls** · 18-06-2012, 10:48 PM

Here are my texture units I made for a game engine that you could look at for ideas

unit_ImageBuffer32

Code:

unit unit_ImageBuffer32;(*
Copyright (c) 2012, Paul Nicholls (paulfnicholls AT gmail DOT com)
All rights reserved.


Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met: 


1. Redistributions of source code must retain the above copyright notice, this
   list of conditions and the following disclaimer. 
2. Redistributions in binary form must reproduce the above copyright notice,
   this list of conditions and the following disclaimer in the documentation
   and/or other materials provided with the distribution. 


THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)
{$ifdef fpc}
{$mode Delphi}
{$endif}
{$H+}


interface


uses
  Classes;


type
  PRGBA = ^TRGBA;
  TRGBA = packed record
    case Integer of
      0 : (r,g,b,a: Byte);
      1 : (Value: LongWord);
  end;


  PRGBAArray = ^TRGBAArray;
  TRGBAArray = array[0..(MaxInt div SizeOf(TRGBA)) - 1] of TRGBA;


  TImageBuffer32 = class
  private
    FWidth  : Word;
    FHeight : Word;
    FPixels : array of TRGBA;


    function  GetScanLine(y: Word): Pointer;
    function  GetBit(Index: Integer): TRGBA;
    procedure SetBit(Index: Integer; Color: TRGBA);
  public
    constructor Create;
    destructor  Destroy; override;


    procedure SetSize(aWidth,aHeight: Word);
    procedure SetBitRGBA(Index: Integer; r,g,b,a: Byte);
    function  GetPixels: Pointer;


    function  LoadFromStream(Stream: TStream): Boolean;
    function  LoadFromFile(FileName: String): Boolean;
    function  LoadBMPFromFile(FileName: String): Boolean;
    function  LoadPNGFromFile(FileName: String): Boolean;
    function  LoadTGAFromFile(FileName: String): Boolean;


    property Width : Word read FWidth;
    property Height: Word read FHeight;
    property ScanLine[y: Word]: Pointer  read GetScanLine;
    property Bits[Index: Integer]: TRGBA read GetBit write SetBit;
  end;


implementation


uses
  SysUtils,
  unit_bmp_loader,
  unit_tga_loader,
  unit_png_loader;


type
  TImageType = (itUnknown,itBMP,itPNG,itTGA);


function  GetImageTypeFromStream(Stream: TStream): TImageType;
type
  TTGAHeader = 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;


const
  cBMPSig = $4d42;
  cPNGSig: array[0..7] of Byte = (137, 80, 78, 71, 13, 10, 26, 10);
var
  BMPSig   : Word;
  PNGSig   : array[0..7] of Byte;
  TGAHeader: TTGAHeader;
  i        : Integer;
  OldPos   : Int64;
  Image    : AnsiString;
begin
  Result := itUnknown;


  OldPos := Stream.Position;
  try
    // check for BMP
    Stream.Read(BMPSig, SizeOf(BMPSig));
    if BMPSig = cBMPSig then
    begin
      Result := itBMP;
      Exit;
    end;


    //check for PNG
    Result := itPNG;
    Stream.Seek(OldPos,soFromBeginning);
    Stream.Read(PNGSig,SizeOf(PNGSig));
    for i := 0 to 7 do
    begin
      if PNGSig[i] <> cPNGSig[i] then
      begin
        Result := itUnknown;
        Break;
      end;
    end;


    if Result = itPNG then Exit;


    Result := itUnknown;


    //check for TGA
    Stream.Seek(OldPos,soFromBeginning);
    Stream.Read(TGAHeader,SizeOf(TGAHeader));


    // Only support 24, 32 bit images
    if (TGAHeader.ImageType <> 2) and    { TGA_RGB }
       (TGAHeader.ImageType <> 10) then  { Compressed RGB }
    begin
      Exit;
    end;


    // Don't support colormapped files
    if TGAHeader.ColorMapType <> 0 then
    begin
      Exit;
    end;


    Result := itTGA;
{    SetLength(Image,Stream.Size);
    Stream.Read(PAnsiChar(Image)^,Stream.Size);
    if Pos('TRUEVISION-XFILE',Image) > 0 then
    begin
      Result := itTGA;
      Exit;
    end;}
  finally
    Stream.Seek(OldPos,soFromBeginning);
  end;
end;


function  NewRGBA(r,g,b,a: Byte): TRGBA;
begin
  Result.r := r;
  Result.g := g;
  Result.b := b;
  Result.a := a;
end;


constructor TImageBuffer32.Create;
begin
  inherited Create;


  SetSize(0,0);
end;


destructor  TImageBuffer32.Destroy;
begin
  SetSize(0,0);


  inherited Destroy;
end;


procedure TImageBuffer32.SetSize(aWidth,aHeight: Word);
var
  i: Integer;
begin
  FWidth  := aWidth;
  FHeight := aHeight;


  SetLength(FPixels,FWidth * FHeight);


  for i := 0 to FWidth * FHeight - 1 do
    FPixels[i].Value := 0;
end;


function  TImageBuffer32.GetScanLine(y: Word): Pointer;
begin
  Result := @FPixels[y * FWidth];
end;


function  TImageBuffer32.GetBit(Index: Integer): TRGBA;
begin
  Result := FPixels[Index];
end;


procedure TImageBuffer32.SetBit(Index: Integer; color: TRGBA);
begin
  FPixels[Index] := color;
end;


procedure TImageBuffer32.SetBitRGBA(Index: Integer; r,g,b,a: Byte);
begin
  FPixels[Index].r := r;
  FPixels[Index].g := g;
  FPixels[Index].b := b;
  FPixels[Index].a := a;
end;


function  TImageBuffer32.GetPixels: Pointer;
begin
  Result := nil;


  if Length(FPixels) = 0 then Exit;


  Result := @FPixels[0];
end;


function  TImageBuffer32.LoadFromStream(Stream: TStream): Boolean;
var
  ImgType: TImageType;
begin
  Result := False;


  ImgType := GetImageTypeFromStream(Stream);


  case ImgType of
    itBMP : Result :=  LoadBMPFromStream(Stream,Self);
    itPNG : Result :=  LoadPNGFromStream(Stream,Self);
    itTGA : Result :=  LoadTGAFromStream(Stream,Self);
  else
  end;
end;


function  TImageBuffer32.LoadFromFile(FileName: String): Boolean;
var
  Ext: String;
begin
  Result := False;


  if not FileExists(FileName) then Exit;


  Ext := LowerCase(ExtractFileExt(FileName));


  if      Ext = '.bmp' then Result := unit_bmp_loader.LoadBMPFromFile(FileName,Self)
  else if Ext = '.tga' then Result := unit_tga_loader.LoadTGAFromFile(FileName,Self)
  else if Ext = '.png' then Result := unit_png_loader.LoadPNGFromFile(FileName,Self);
end;


function  TImageBuffer32.LoadBMPFromFile(FileName: String): Boolean;
begin
  Result := False;


  if not FileExists(FileName) then Exit;


  Result := unit_bmp_loader.LoadBMPFromFile(FileName,Self);
end;


function  TImageBuffer32.LoadPNGFromFile(FileName: String): Boolean;
begin
  Result := False;


  if not FileExists(FileName) then Exit;


  Result := unit_png_loader.LoadPNGFromFile(FileName,Self);
end;


function  TImageBuffer32.LoadTGAFromFile(FileName: String): Boolean;
begin
  Result := False;


  if not FileExists(FileName) then Exit;


  Result := unit_tga_loader.LoadTGAFromFile(FileName,Self);
end;


end.

unit_bmp_loader

Code:

unit unit_bmp_loader;
(*
Copyright (c) 2012, Paul Nicholls (paulfnicholls AT gmail DOT com)
All rights reserved.


Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met: 


1. Redistributions of source code must retain the above copyright notice, this
   list of conditions and the following disclaimer. 
2. Redistributions in binary form must reproduce the above copyright notice,
   this list of conditions and the following disclaimer in the documentation
   and/or other materials provided with the distribution. 


THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*){$ifdef fpc}
{$mode Delphi}
{$endif}
{$H+}


interface


uses
  Classes,
  unit_ImageBuffer32;


function  LoadBMPFromStream(Stream: TStream;  Buffer: TImageBuffer32): Boolean;
function  LoadBMPFromFile(FileName: String; Buffer: TImageBuffer32): Boolean;


implementation


uses
  SysUtils;


type
  //File information header
  //provides general information about the file
  TBITMAPFILEHEADER = packed record
    bfType      : Word;
    bfSize      : LongWord;
    bfReserved1 : Word;
    bfReserved2 : Word;
    bfOffBits   : LongWord;
  end;


  //Bitmap information header
  //provides information specific to the image data
  TBITMAPINFOHEADER = packed record
    biSize          : LongWord;
    biWidth         : LongInt;
    biHeight        : LongInt;
    biPlanes        : Word;
    biBitCount      : Word;
    biCompression   : LongWord;
    biSizeImage     : LongWord;
    biXPelsPerMeter : LongInt;
    biYPelsPerMeter : LongInt;
    biClrUsed       : LongWord;
    biClrImportant  : LongWord;
  end;


  //Colour palette
  TRGBQUAD = packed record
    rgbBlue     : Byte;
    rgbGreen    : Byte;
    rgbRed      : Byte;
    rgbReserved : Byte;
  end;


  PBitmapPixel = ^TBitmapPixel;
  TBitmapPixel = packed record
    b,g,r: Byte;
  end;


function  LoadBMPFromStream(Stream: TStream;  Buffer: TImageBuffer32): Boolean;
  var
    FileHeader    : TBITMAPFILEHEADER;
    InfoHeader    : TBITMAPINFOHEADER;
    Palette       : array of TRGBQUAD;
    BitmapLength  : LongWord;
    PaletteLength : LongWord;
    ReadBytes     : LongWord;
    Width,Height  : Integer;
    BitmapPixels  : PBitmapPixel;
    BitmapAddr    : PBitmapPixel;
    BufferRow     : PRGBAArray;
    x,y           : LongWord;
    OldPos        : Int64;
begin
  OldPos := Stream.Position;


  // Get header information
  Stream.Read(FileHeader, SizeOf(FileHeader));


  if FileHeader.bfType <> $4d42 then
  // not a BMP file!
  begin
    // reset position
    Stream.Seek(OldPos,soFromBeginning);


    Exit;
  end;


  Stream.Read(InfoHeader, SizeOf(InfoHeader));


  if InfoHeader.biBitCount <> 24 then
  // only supports 24 bit bitmaps!
    Exit;


  // Get palette
  PaletteLength := InfoHeader.biClrUsed;


  if PaletteLength > 0 then
  begin
    SetLength(Palette, PaletteLength);
    ReadBytes := Stream.Read(Palette,PaletteLength);
    if (ReadBytes <> PaletteLength) then
    begin
  //  MessageBox(0, PChar('Error reading palette'), PChar('BMP Loader'), MB_OK);
      Exit;
    end;
  end;


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


  Buffer.SetSize(Width,Height);


  BitmapLength := InfoHeader.biSizeImage;


  if BitmapLength = 0 then
    BitmapLength := Width * Height * (InfoHeader.biBitCount Div 8);


  // Get the actual pixel data
  GetMem(BitmapPixels, BitmapLength);
  try
    ReadBytes := Stream.Read(BitmapPixels^, BitmapLength);
    if (ReadBytes <> BitmapLength) then
    begin
  //    MessageBox(0, PChar('Error reading bitmap data'), PChar('BMP Unit'), MB_OK);
      Exit;
    end;


    BitmapAddr := BitmapPixels;
    // copy bitmap pixels to buffer pixels
    for y := 0 to Height - 1 do
    begin
      BufferRow := Buffer.ScanLine[(Height - 1) - y];
      for x := 0 to Width - 1 do
      begin
        BufferRow^[x].r := BitmapAddr^.r;
        BufferRow^[x].g := BitmapAddr^.g;
        BufferRow^[x].b := BitmapAddr^.b;
        BufferRow^[x].a := 255;
        Inc(BitmapAddr);
      end;
    end;
  finally
    FreeMem(BitmapPixels)
  end;
end;


function  LoadBMPFromFile(Filename: String;  Buffer: TImageBuffer32): Boolean;
var
  BMPFile : TFileStream;
begin
  Result := False;


  if not FileExists(FileName) then Exit;


  BMPFile := TFileStream.Create(FileName,fmOpenRead or fmShareDenyWrite);
  try
    Result := LoadBMPFromStream(BMPFile,Buffer);
  finally
    BMPFile.Free;
  end;
end;


end.

and this is how I create an OpenGL texture from the imagebuffer:

Code:

procedure TxeTexture.GenerateTexture;
begin
  glEnable(GL_TEXTURE_2D);
  glDeleteTextures(1,@FId);
  glGenTextures(1, @FId);
  glBindTexture(GL_TEXTURE_2D,FId);


  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 }


//  gluBuild2DMipmaps(GL_TEXTURE_2D, GL_RGBA, FBuffer.Width, FBuffer.Height, GL_RGBA, GL_UNSIGNED_BYTE, FBuffer.GetPixels);
  glTexImage2D     (GL_TEXTURE_2D, 0, 4, FBuffer.Width, FBuffer.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, FBuffer.GetPixels);  // Use when not wanting mipmaps to be built by openGL


//  glDisable(GL_TEXTURE_2D);
end;

Thread: Create OpenGL Texture from TBitmap

Thread Tools

Display

Threaded View

Tags for this Thread

Bookmarks

Bookmarks

Posting Permissions