Page 1 of 2 12 LastLast
Results 1 to 10 of 13

Thread: Create OpenGL Texture from TBitmap

  1. #1

    Create OpenGL Texture from TBitmap

    I'm trying to create a texture from a TBitmap and not directly from a *.bmp file, because my bitmaps are loaded from a resource file(but it is a type of resource file created by me - and it is working fine).

    This is my class TNewBitmap descendant of TBitmap, and it has a FBitmapIntF(TLazIntFImage) and FTexture(gluint) variables - an how I am trying to load the texture:
    Code:
    procedure TNewBitmap.UpdateTexture;
    var
      BData: Array of Byte;
      BIndexX, BIndexY : Integer;
    begin
      Self.FBitmapIntF := TLazIntFImage.Create(Self.Width, Self.Height);
      Self.FBitmapIntF.LoadFromBitmap(Self.Handle, Self.MaskHandle);
      
      SetLength(BData, Self.Width * Self.Height * 3);
      for BIndexY := 0 to Self.Height - 1 do
      begin
        for BIndexX := 0 to Self.Width - 1 do
        begin
          BData[(BIndexY * BIndexX) + BIndexX + 0] := GetBValue(Self.FBitmapIntF.Pixels[BIndexX, BIndexY]);
          BData[(BIndexY * BIndexX) + BIndexX + 1] := GetGValue(Self.FBitmapIntF.Pixels[BIndexX, BIndexY]);
          BData[(BIndexY * BIndexX) + BIndexX + 2] := GetRValue(Self.FBitmapIntF.Pixels[BIndexX, BIndexY]);
        end;
      end;
    
      Self.FTexture := CreateTexture(Width, Height, @BData);
    
      Self.LoadFromIntFImage(Self.FBitmapIntF);
      Self.FBitmapIntF.Free;
    end;
    
    function CreateTexture(Width, Height: Integer; pData : Pointer) : GLUInt;
    var
      Texture : GLuint;
    begin
      glEnable(GL_TEXTURE_2D);
      glGenTextures(1, Texture);
      glBindTexture(GL_TEXTURE_2D, Texture);
    
      glPixelStorei(GL_UNPACK_ALIGNMENT, 4);
      glPixelStorei(GL_UNPACK_ROW_LENGTH, 0);
      glPixelStorei(GL_UNPACK_SKIP_ROWS, 0);
      glPixelStorei(GL_UNPACK_SKIP_PIXELS, 0);
    
      glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
      glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
      glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT);
      glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT);
      glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_RGB, GL_UNSIGNED_BYTE, pData);
    
      Result := Texture;
    end;
    And this is how I'm try to draw the texture in the screen - this is in the render procedure:
    Code:
      glViewport(0, 0, FMainForm.Width, FMainForm.Height);
      glMatrixMode(GL_PROJECTION);
      glLoadIdentity();
      glOrtho(0, FMainForm.Width, 0, FMainForm.Height, -100, 100);
      glMatrixMode(GL_MODELVIEW);
      glClearColor(1.0, 1.0, 1.0, 1.0);
      
      glEnable(GL_DEPTH_TEST);
      glDepthMask(GL_TRUE);
      
      glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
      glLoadIdentity();
      glPushMatrix();
     
        // loop for each object in game:
        glEnable(GL_TEXTURE_2D);
        glBindTexture(GL_TEXTURE_2D, BSprite.FTexture);  // Bind the Texture of the the object
        glTranslatef(BObjectPosX + BObjectCenterX, BObjectPosY + BObjectCenterY, 0.0);
        glRotatef(BSprite.FAngle, 0.0, 0.0, 1.0);
        glNormal3f( 0.0, 0.0, 1.0);
    
        glBegin(GL_QUADS);
          //glColor3f(0, 0.35, 0.5);
          glTexCoord2f(0.0, 0.0);  glVertex3f(-32.0, -32.0,  1.0);
          glTexCoord2f(1.0, 0.0);  glVertex3f( 32.0, -32.0,  1.0);
          glTexCoord2f(1.0, 1.0);  glVertex3f( 32.0,  32.0,  1.0);
          glTexCoord2f(0.0, 1.0);  glVertex3f(-32.0,  32.0,  1.0);
        glEnd();
        // end of the loop for;
    
      glPopMatrix;
      SwapBuffers(GetDC(FMainForm.Handle));
      glFlush;

  2. #2
    Does it work if you comment this out? Seems to do nothing useful, if i read the code right...
    Code:
      //Self.LoadFromIntFImage(Self.FBitmapIntF);
      Self.FBitmapIntF.Free;
    Also you don't need to use Self. that often It does give clarity in some cases, but many people don't do that. For example:
    Code:
    label1.caption := 'Test';
    Looks tidier than with "Self".

  3. #3
    But still, the texture is not being displayed in the screen.

  4. #4
    You are REALLY overthinking this IMHO... don't waste time making a copy, just send it tbitmap.canvas.pixels. You seem to be expanding tBitmap for no good reason near as I can tell...

    Literally if your expanded object inherits from tBitmap, why aren't you just doing:

    Code:
    procedure TNewBitmap.UpdateTexture;
    begin
    	self.FTexture:=CreateTexture(width,height,@canvas.pixels);
    end;
    I'm not getting what all that extra code is even in there for.

    Likewise, once I've bound it, I'd release tbitmap -- I'd probably have tbitmap as a property of the texture instead of the other way around -- if I had it a property at all and not a local var in the constructor. Load it, bind it, release the tbitmap, continue on your merry way -- unless you really need to keep allocating and releasing it because you're running dry on available memory on the GPU.
    Last edited by deathshadow; 18-06-2012 at 10:13 AM.
    The accessibility of a website from time to time must be refreshed with the blood of designers and owners. It is its natural manure

  5. #5
    Quote Originally Posted by FelipeFS View Post
    But still, the texture is not being displayed in the screen.
    You didn't say that in first post I assumed it is working code just in need of optimizations.

    Code:
    self.FTexture:=CreateTexture(width,height,@canvas.pixels);
    You won't be able to do that. Pixels is a property with GetPixel(X, Y: Integer): TColor function internally. But you are able to read the pixels without converting to TLazIntFImage. You can also send the TBitmap as parameter, and then read from its canvas pixels[] or colors[] property.
    (Canvas.Colors[] is record structure divided in R,G,B, but works for freepascal only)
    Last edited by User137; 18-06-2012 at 11:05 AM.

  6. #6
    Hi guys, I know that the code can be improved, but the most important part that is display the texture is not working, after accomplish that, I could improve it. Still got nothingwith @canvas.pixels or @canvas.colors.

    I found this code on internet:
    Code:
    function LoadTexture(Filename: String; var Texture : GLuint) : Boolean;
    var
      FileHeader : BITMAPFILEHEADER;
      InfoHeader : BITMAPINFOHEADER;
      Palette    : array of RGBQUAD;
      pData      : Pointer;
      BitmapFile    : THandle;
      BitmapLength  : LongWord;
      PaletteLength : LongWord;
      ReadBytes     : LongWord;
      Width, Height : Integer;
    begin
      result :=FALSE;
    
      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);
    
      // 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;
    and I changed to this - Putting some showmessage() commands to know as far the code goes without crash, and after ShowMessage('4') the program crashes:
    Code:
    procedure TNewBitmap.UpdateTexture;
    var
      FileHeader : BITMAPFILEHEADER;
      InfoHeader : BITMAPINFOHEADER;
      Palette    : array of RGBQUAD;
      pData      : Pointer;
      BitmapFile    : THandle;
      BitmapLength  : LongWord;
      PaletteLength : LongWord;
      ReadBytes     : LongWord;
      Width, Height : Integer;
    begin
      ShowMessage('1');
      BitmapFile := Self.Handle; //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 bitmap'), PChar('BMP Unit'), MB_OK);
        Exit;
      end;
    
      ShowMessage('2');
      // Get header information
      ReadFile(BitmapFile, FileHeader, SizeOf(FileHeader), ReadBytes, nil);
      ReadFile(BitmapFile, InfoHeader, SizeOf(InfoHeader), ReadBytes, nil);
    
      ShowMessage('3');
      // Get palette
      PaletteLength := InfoHeader.biClrUsed;
    
      ShowMessage('4');
      SetLength(Palette, PaletteLength);
    
      ShowMessage('5');
      ReadFile(BitmapFile, Palette, PaletteLength, ReadBytes, nil);
      if (ReadBytes <> PaletteLength) then begin
        MessageBox(0, PChar('Error reading palette'), PChar('BMP Unit'), MB_OK);
        Exit;
      end;
    
      ShowMessage('6');
      BitmapLength := InfoHeader.biSizeImage;
      if BitmapLength = 0 then
        BitmapLength := Width * Height * InfoHeader.biBitCount Div 8;
    
      ShowMessage('7');
      // 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;
    
      ShowMessage('8');
      SwapRGB(pData, Width*Height);
      FTexture :=CreateTexture(Width, Height, GL_RGB, pData);
      FreeMem(pData);
      ShowMessage('7');  
    end;
    In the palette part, the program crashes. My bitmap to be loaded is a 24 bit depth color(also the bitmap loaded by the original code - and it loads fine). The main change was "BitmapFile := Self.Handle;"
    But even so, the texture is not being displayed. =(

    What I accomplished so far was display shapes like triangles. And the place which should display the texture, displays a colored square, instead.

  7. #7
    Quote Originally Posted by User137 View Post
    You won't be able to do that. Pixels is a property with GetPixel(X, Y: Integer): TColor function internally. But you are able to read the pixels without converting to TLazIntFImage. You can also send the TBitmap as parameter, and then read from its canvas pixels[] or colors[] property.
    (Canvas.Colors[] is record structure divided in R,G,B, but works for freepascal only)
    Is that a recent change or something? I thought that was the pointer to the buffer just like scanlines[0] would be...

    Or did they go the retard route and stop providing you an actual pointer to the pixel buffer?

    I stopped using delphi because of idiocy like that and went to FPC. Several times I've ended up screaming at the display "lands sake just let me access the data I just loaded!" -- SDL_image or using your own loader has far, far less headaches.

    Actually, I use a bit harsher language than that. If you have to make a second copy of it using some idiotic array like scanlines or via pixel[x,y], then IMHO tBitmap is useless bull... that ends up being THREE copies just to load one image into openGL; if that's not idiotic nonsensical BS, I don't know what is.

    would scanline[0] then work? Or do they not even guarantee that scanlines are contiguous in memory?

    If I was forced to use code like that because tBitmap won't even provide a proper pointer to the buffer the bitmap is stored in, I'd say {expletive omitted} that {even nastier expletive omitted}, kick tBitmap to the curb, forget that resources BS, and just make my own loader... because if that's how it works, it's not worth even TRYING to use.

    But then I've never liked resource files to begin with. Royal PITA... and if I was writing for OpenGL, Delphi would be pretty far down my list of choices -- but that's probably because FPC+SDL+OPENGL is so bloody brilliant from a functionality and ease of use standpoint.
    The accessibility of a website from time to time must be refreshed with the blood of designers and owners. It is its natural manure

  8. #8
    That new code looks much, much more promising, though it's not really all that versatile in terms of BMP formats... gimme a bit to play with that. I'll compare it to my PHP code for loading BMP files (which shockingly PHP/gd has no support for -- WBMP != BMP).


    I suspect the unsized palette array is the contributing factor to it's failure... though using all the stock data types could also be it since there's no guarantee they match the physical header info across compilation targets.

    Have you tried outputting the values from the header read to make sure it actually is getting valid header data from reading 'self'? I didn't think a handle to tBitmap would be file readable?

    If you put it in an external file, does it work? If you can load it from an external file, then the problem lies with how you're trying to use a resource and/or tBitmap. Start going through and eliminating possible causes.
    Last edited by deathshadow; 18-06-2012 at 10:44 PM.
    The accessibility of a website from time to time must be refreshed with the blood of designers and owners. It is its natural manure

  9. #9
    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;
    Games:
    Seafox


    Pages:
    Syntax Error Software itch.io page

    Online Chess
    http://gameknot.com/#paul_nicholls

  10. #10
    Best i can come up with is to pitch tBitmap in the trash, it does NOT provide the information you need to do this in a reasonable manner.

    Code:
    function createGlTextureFromResource(h:hInstance; resId:integer):glInt;
    var
    	textureStream:tResourceStream;
    	fileHeader:BITMAPFILEHEADER;
    	infoHeader:BITMAPINFOHEADER;
    	data:pointer;
    	dataSize:longint;
    begin
    	ShowMessage('Opening Bitmap File');
    	textureStream:=tResourceStream.createFromId(h,resID,RT_RCDATA);
    	
    	showMessage('Loading Headers');
    	// Get header information
    	textureStream.read(fileHeader,sizeOf(fileHeader));
    	textureStream.read(infoHeader,sizeOf(infoHeader));
    	
    	if not(infoHeader.biBitcount=24) then begin
    		MessageBox(
    			0,
    			PChar('Error - Attempt to load non 24 bit texture'),
    			PChar('BMP Unit'),
    			MB_OK
    		);
    		exit;
    	end;
    	
    	// 24 bit means we don't need the palette, so let's skip it!
    	
    	textureStream.seek(fileHeader.bfOffBits);
    	
    	dataSize:=(
    		infoHeader.width *
    		infoHeader.height * 
    		infoHeader.biBitCount div 8
    	);
    	getMem(data,dataSize);
    
    	showMessage('Loading bitmap data');
    	// Get the actual pixel data
    	textureStream.read(data^,dataSize);
    	
    	showMessage('Assigning bitmap to OpenGL texture');
    	
    	createGlTextureFromResource:=createTexture(
    		infoHeader.biWidth,
    		infoHeader.biHeight,
    		GL_RGB,
    		data
    	);
    	
    	showMessage('Unallocating bitmap memory');
    	
    	freeMem(dData,dataSize);
    	
    	showMessage('Bitmap resource to OpenGL texture complete');
    end;
    Is roughly how I'd go about it. Note you have to pass the application hInstance to it... untested, so I'm not sure if you should be forcing it to be rcdata, or rcBitmap -- I suspect the latter may have 'issues'... also not sure if you need to rgbswap or not. (sdl_image's load_img seems to handle that for me)... if you do need the swap, rather than wasting time flipping it manually, why not send gl_BGR to the texture loader?
    The accessibility of a website from time to time must be refreshed with the blood of designers and owners. It is its natural manure

Page 1 of 2 12 LastLast

Tags for this Thread

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •