Einzelnen Beitrag anzeigen

Benutzerbild von turboPASCAL
turboPASCAL

Registriert seit: 8. Mai 2005
Ort: Sondershausen
4.274 Beiträge
 
Delphi 6 Personal
 
#3

Re: BMP-Texture-LOADER [verDREHT]

  Alt 4. Mär 2008, 19:50
Zeig doch mal wie diene Bitmap-Laderoutiene ausschaut. Dann lässt es sich bestimmt leichter helfen.
MEin eingener (leichtester) Ansatz schaut so aus:

Delphi-Quellcode:
unit BmpTextures;


interface

uses
  Windows,
  OpenGL;

  function LoadBMPTexture(ImageName: PChar; var Texture : GLuint;
    LoadFromRes: Boolean) : Boolean;

  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;
  procedure glDeleteTextures(n: Integer; textures: PGLuint); stdcall; external OpenGL32;


implementation

resourcestring
  szUse4BitBitmaps = 'Use Bitmaps with 4Bits per Pixel or greater.';
  szBitmapNotFound = 'Bitmap not found (Resource or File)';

{------------------------------------------------------------------}
{  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);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);

  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);

  result := Texture;
end;

function LoadBMPTexture(ImageName: PChar; var Texture : GLuint;
  LoadFromRes: Boolean) : Boolean;
type
  TByteArray = array of byte;
var
  BitmapLength: LongWord;
  bmpBits: TByteArray;
  hBmp: HBitmap;
  bi: tagBITMAP;

  procedure _SwapRGB(pData: Pointer; Size: Integer; Alpha: Byte);
  asm
    push ebx
    test edx,edx
    jz @@end
  @@loop :
    mov bl,[eax+0]
    mov bh,[eax+2]
    mov [eax+2],bl
    mov [eax+0],bh
    mov [eax+3],cl
    add eax, 4
    sub edx, 4
    jnle @@loop
  @@end:
    pop ebx
  end;

begin
  Result := FALSE;

  if LoadFromRes
    then hBmp := Loadimage(HInstance, ImageName, IMAGE_BITMAP, 0, 0, 0)
    else hBmp := Loadimage(0, ImageName, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE);

  if hBmp > 0 then
  begin
    GetObject(hBmp, sizeof(bi), @bi);

    if bi.bmBitsPixel > 1 then
    begin
      BitmapLength := bi.bmWidth * bi.bmHeight * (bi.bmBitsPixel div 8);
      SetLength(bmpBits, BitmapLength+1);
      GetBitmapBits(hBmp, BitmapLength, @bmpBits[0]);

      // Bitmaps are stored BGR and not RGB, so swap the R and B bytes.
      if @bmpBits[0] <> nil then
      begin
        _SwapRGB(bmpBits, Length(bmpBits), 255);
        Texture := CreateTexture(bi.bmWidth, bi.bmHeight, GL_RGBA, @bmpBits[0]);
        Result := (Texture <> 0);
      end else
        Result := FALSE;

    end else
      MessageBox(0, PCHAR(szUse4BitBitmaps), 'Bitmap Formaterror:', MB_OK);
  end else
    MessageBox(0, PCHAR(szBitmapNotFound), 'Bitmap Formaterror:', MB_OK);
  

  DeleteObject(hBmp);
end;

end.
Matti
Meine Software-Projekte - Homepage - Grüße vom Rüsselmops -Mops Mopser
  Mit Zitat antworten Zitat