TextureGL.pas

Top  Previous  Next

unit TextureGL;

 

interface

 

Uses

Windows, Messages, Classes, Graphics, Forms, ExtCtrls, Menus,

Controls, Dialogs, SysUtils, OpenGL, Math;

 

Type

 

TTextureGL = class

public

       //for file mapping

       hf, hMap : THandle;

   dwFileSize, m_dwSize : DWORD;

       m_fileBuf : PByteArray;

public

   Texture_pointer : glUint;

   nWidth,nHeight : word;

   pBits : pByteArray;

 

   bFileMapping : Boolean;

   constructor Create;

   Destructor Destroy; override;

   procedure LoadFrom_bmp_File1( const AFileName : String);

   procedure LoadFrom_bmp_File2(B : TBitmap);

   procedure LoadFrom_bmp_File3(sPath : string);

   procedure LoadFrom_Txr_File( const AFileName : String);

   procedure Enable;

   procedure Disable;

end;

 

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

procedure glBindTexture(target: GLenum; texture: GLuint); stdcall; external opengl32;

 

procedure Gene_Txr_from_BMP( const bmp,txr_f : String);

function inc_bytes(a,b:byte):word;

procedure res_bytes(z:word;var a,b:byte);

 

 

implementation

 

Destructor TTextureGL.Destroy;

begin

       if bFileMapping then begin

               CloseHandle(hMap);

           CloseHandle(hf);

   end;

       if not bFileMapping then begin

               if Assigned(pBits) then FreeMem(pBits, nWidth * nHeight * 3);

   end;

       Inherited Destroy;

end;

 

 

function ReadBitmap(const FileName : String;

                   var sWidth, tHeight: GLsizei): pointer;

const

szh = SizeOf(TBitmapFileHeader);

szi = SizeOf(TBitmapInfoHeader);

type

TRGB = record

   r, g, b : GLbyte;

end;

TWrap = Array [0..0] of TRGB;

var

BmpFile : File;

bfh : TBitmapFileHeader;

bmi : TBitmapInfoHeader;

x, nsize: GLint;

temp: GLbyte;

begin

AssignFile (BmpFile, FileName);

Reset (BmpFile, 1);

nSize := FileSize (BmpFile) - szh - szi;

Blockread(BmpFile, bfh, szh);

BlockRead (BmpFile, bmi, szi);

If Bfh.bfType <> $4D42 then begin

   MessageBox(0, 'Invalid Bitmap', 'Error', MB_OK);

   Result := nil;

   Exit;

end;

sWidth := bmi.biWidth;

tHeight := bmi.biHeight;

GetMem (Result, nSize);

BlockRead(BmpFile, Result^, nSize);

 

try

For x := 0 to nSize -1 do

   With TWrap(Result^)[x] do begin

     temp := r;

     r := b;

     b := temp;

end;

except

       showmessage(inttostr(x) + ',' +IntToStr(nSize))

end;

end;

 

procedure TTextureGl.LoadFrom_bmp_File1( const AFileName : String);

var

       buf : Pointer;

   B : TBitmap;

   I, J : integer;

       sWidth, tHeight : GLsizei;

begin

//         buf := ReadBitmap(aFileName, sWidth, tHeight);

   B := TBitmap.Create;

 

   B.LoadFromFile(AFileName);

 

   nWidth := B.Width;

 

   nHeight := B.Height;

 

   GetMem(pBits,nWidth*nHeight*3); // ӧէ֧ݧڧ ѧާ էݧ էѧߧߧ

 

   for j := 0 to nHeight - 1 do begin

       for i := 0 to nWidth - 1 do begin

           pBits[(j*nWidth + i)*3] := GetRValue(B.Canvas.Pixels[i,j]); // ֧֧ߧ֧ էѧߧߧ ӧ֧ѧ ڧܧ֧ݧ֧

           pBits[(j*nWidth + i)*3+1] := GetGValue(B.Canvas.Pixels[i,j]); // ڧ ҧ֧ܧ TBitmap

           pBits[(j*nWidth + i)*3+2] := GetBValue(B.Canvas.Pixels[i,j]); // ҧ֧ܧ TTextureGL

       end;

   end;

 

       glGenTextures(1, Texture_pointer);

       glBindTexture(GL_TEXTURE_2D, Texture_pointer);

       glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);

       glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);

       glTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, sWidth, tHeight,0, GL_RGBa, GL_UNSIGNED_BYTE, pBits);

   B.Free; // ӧҧէڧ ҧ֧ܧ TBitmap

 

end;

 

 

 

procedure TTextureGl.LoadFrom_bmp_File2(B : TBitmap);

const nDem = 4;

var

   i,j,a : Integer;

   c:byte;

begin

nWidth := B.Width;

nHeight := B.Height;

 

GetMem(pBits,nWidth*nHeight*nDem);

 

for j := 0 to nHeight - 1 do begin

   for i := 0 to nWidth - 1 do begin

     pBits[(j*nWidth + i) * nDem] := GetRValue(B.Canvas.Pixels[i,j]);

     c:=GetRValue(B.Canvas.Pixels[i,j]);

     pBits[(j*nWidth + i) * nDem + 1] := GetGValue(B.Canvas.Pixels[i,j]);

     c:=c+GetgValue(B.Canvas.Pixels[i,j]);

     pBits[(j*nWidth + i) * nDem + 2] := GetBValue(B.Canvas.Pixels[i,j]);

     c:=c+GetbValue(B.Canvas.Pixels[i,j]);

     pBits[(j*nWidth + i) * nDem +3] := 255;

     if c=0 then pBits[(j*nWidth + i)*nDem+3] := 0;

   end;

end;

 

glGenTextures(1, Texture_pointer);

glBindTexture(GL_TEXTURE_2D, Texture_pointer);

 

//  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);

glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);

glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);

glTexImage2D(GL_TEXTURE_2D,0,GL_RGBA,nWidth,nHeight,0,GL_RGBA,GL_UNSIGNED_BYTE,pBits);

end;

 

procedure TTextureGl.LoadFrom_Txr_File( const AFileName : String);

var

   i,j,a : Integer;

   f:file of byte;

   c,b:byte;

begin

assignfile(f,afilename);

reset(f);

 

read(f,c);  read(f,b);

nheight:=inc_bytes(c,b);

read(f,c);  read(f,b);

nwidth:=inc_bytes(c,b);

 

 

GetMem(pBits,nWidth*nHeight*4);

 

for j := 0 to nHeight - 1 do begin

   for i := 0 to nWidth - 1 do begin

     read(f,pBits[(j*nWidth + i)*4 ]);

     read(f,pBits[(j*nWidth + i)*4+1]);

     read(f,pBits[(j*nWidth + i)*4+2]);

     pBits[(j * nWidth + i)*4+3] := 255;

   end;

end;

 

closefile(f);

 

glGenTextures(1, Texture_pointer);

glBindTexture(GL_TEXTURE_2D, Texture_pointer);

glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);

glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);

glTexImage2D(GL_TEXTURE_2D,0,GL_RGBA,nWidth,nHeight,0,GL_RGBa,GL_UNSIGNED_BYTE,pBits);

freemem(pBits);

end;

 

 

procedure TTextureGL.Enable;

begin

glEnable(GL_TEXTURE_2D);

glBindTexture(GL_TEXTURE_2D, Texture_pointer);

end;

 

procedure TTextureGL.Disable;

begin

glDisable(GL_TEXTURE_2D);

end;

 

procedure Gene_Txr_from_BMP( const bmp,txr_f : String);

var B : TBitmap;

   i,j : Integer;

   f:file of byte;

   c:byte;

   a:byte;

begin

B := TBitmap.Create;

B.LoadFromFile(bmp);

 

assignfile(f,txr_f);

rewrite(f);

 

res_bytes(B.Height,c,a);

write(f,c); write(f,a);

res_bytes(B.width,c,a);

write(f,c); write(f,a);

 

for j := 0 to b.Height - 1 do begin

   for i := 0 to b.Width - 1 do begin

     c:=GetRValue(B.Canvas.Pixels[i,j]);

     write(f,c);

     c:=GetgValue(B.Canvas.Pixels[i,j]);

     write(f,c);

     c:=GetbValue(B.Canvas.Pixels[i,j]);

     write(f,c);

   end;

end;

 

closefile(f);

B.Free;

end;

 

function dec_in_bin(ch,bits:word):string;

var i,j:integer;

   temp1,temp2:string;

   ost:byte;

begin

  temp2:='';

  temp1:='';

  for i:=1 to bits do

  begin

    ost:=ch mod 2;

    ch:=ch div 2;

    str(ost,temp1);

    if temp1<>'' then temp2:=temp1+temp2

    else temp2:='0'+temp2;

  end;

  dec_in_bin:=temp2;

end;

 

function bin_in_dec(s:string):word;

var i,j:integer;

   ch,temp:word;

   code:integer;

begin

  ch:=0;

  for i:=1 to length(s) do

  begin

    val(s[i],temp,code);

 

    ch:=(ch+temp)*2;

  end;

  bin_in_dec:=(ch div 2);

end;

 

function inc_bytes(a,b:byte):word;

var s1,s2,s3:string[50];

begin

s1:=dec_in_bin(a,8);

s2:=dec_in_bin(b,8);

s3:=s1+s2;

inc_bytes:=bin_in_dec(s3);

end;

 

procedure res_bytes(z:word;var a,b:byte);

var s1,s2,s3:string[50];

begin

s3:=dec_in_bin(a,16);

 

s1:=copy(s3,1,8);

s2:=copy(s3,9,8);

 

a:=bin_in_dec(s1);

b:=bin_in_dec(s2);

end;

 

 

procedure TTextureGL.LoadFrom_bmp_File3(sPath: string);

var

       pBuf : Pointer;

begin

       hf := CreateFile(PChar(sPath),GENERIC_READ,FILE_SHARE_READ,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL or FILE_FLAG_RANDOM_ACCESS,0);

 

       if INVALID_HANDLE_VALUE <> hf then begin

               dwFileSize := GetFileSize(hf,nil);

               hMap := CreateFileMapping(hf,nil,PAGE_READONLY,0,0,0);

 

               if(hMap <> 0) then begin

                       pBits := MapViewOfFile(hMap,FILE_MAP_READ,0,0,0);

                       if(pBits <> nil) then begin

                               m_dwSize := dwFileSize;

 

//                pBits := Addr(m_fileBuf[SizeOf(TBitmapFileHeader) + SizeOf(TBitmapInfoHeader)]);

               bFileMapping := TRUE;

 

               glGenTextures(1, Texture_pointer);

               glBindTexture(GL_TEXTURE_2D, Texture_pointer);

 

               //  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);

               glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);

               glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);

               glTexImage2D(GL_TEXTURE_2D,0,GL_RGBA,Round(Sqrt(m_dwSize / 4)),Round(Sqrt(m_dwSize / 4)),0,GL_RGBA,GL_UNSIGNED_BYTE,pBits);

 

               Exit;

                       end

                       else begin

                               CloseHandle(hMap);

                               hMap := 0;

                       end;

               end;

               CloseHandle(hf);

       end;

end;

 

constructor TTextureGL.Create;

begin

       bFileMapping := FALSE;

end;

 

end.