CreateDIBSection / OpenGL

[turboPASCAL]

In etwa so klappts:

Delphi-Quellcode:

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}

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

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);
  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, 'Use Bitmaps with 4Bits per Pixel or greater.',
        'Bitmap Formaterror:', MB_OK);

  DeleteObject(hBmp);
end;