📄 textures.pas
字号:
{------------------------------------------------------------------}
{ Loads 24 and 32bpp (alpha channel) TGA textures }
{------------------------------------------------------------------}
{$WARNINGS OFF}
function LoadTGATexture(Filename: String; var Texture: GLuint; LoadFromResource : Boolean): Boolean;
var
TGAHeader : 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;
TGAFile : File;
bytesRead : Integer;
image : Pointer; {or PRGBTRIPLE}
CompImage : Pointer;
Width, Height : Integer;
ColorDepth : Integer;
ImageSize : Integer;
BufferIndex : Integer;
currentByte : Integer;
CurrentPixel : Integer;
I : Integer;
Front: ^Byte;
Back: ^Byte;
Temp: Byte;
ResStream : TResourceStream; // used for loading from resource
// Copy a pixel from source to dest and Swap the RGB color values
procedure CopySwapPixel(const Source, Destination : Pointer);
asm
push ebx
mov bl,[eax+0]
mov bh,[eax+1]
mov [edx+2],bl
mov [edx+1],bh
mov bl,[eax+2]
mov bh,[eax+3]
mov [edx+0],bl
mov [edx+3],bh
pop ebx
end;
begin
result :=FALSE;
//GetMem(Image, 0);
if LoadFromResource then // Load from resource
begin
try
ResStream := TResourceStream.Create(hInstance, PChar(copy(Filename, 1, Pos('.', Filename)-1)), 'TGA');
ResStream.ReadBuffer(TGAHeader, SizeOf(TGAHeader)); // FileHeader
result :=TRUE;
except on
EResNotFound do
begin
MessageBox(0, PChar('File not found in resource - ' + Filename), PChar('TGA Texture'), MB_OK);
Exit;
end
else
begin
MessageBox(0, PChar('Unable to read from resource - ' + Filename), PChar('BMP Unit'), MB_OK);
Exit;
end;
end;
end
else
begin
if FileExists(Filename) then
begin
AssignFile(TGAFile, Filename);
Reset(TGAFile, 1);
// Read in the bitmap file header
BlockRead(TGAFile, TGAHeader, SizeOf(TGAHeader));
result :=TRUE;
end
else
begin
MessageBox(0, PChar('File not found - ' + Filename), PChar('TGA Texture'), MB_OK);
Exit;
end;
end;
if Result = TRUE then
begin
Result :=FALSE;
// Only support 24, 32 bit images
if (TGAHeader.ImageType <> 2) AND { TGA_RGB }
(TGAHeader.ImageType <> 10) then { Compressed RGB }
begin
Result := False;
CloseFile(tgaFile);
MessageBox(0, PChar('Couldn''t load "'+ Filename +'". Only 24 and 32bit TGA supported.'), PChar('TGA File Error'), MB_OK);
Exit;
end;
// Don't support colormapped files
if TGAHeader.ColorMapType <> 0 then
begin
Result := False;
CloseFile(TGAFile);
MessageBox(0, PChar('Couldn''t load "'+ Filename +'". Colormapped TGA files not supported.'), PChar('TGA File Error'), MB_OK);
Exit;
end;
// Get the width, height, and color depth
Width := TGAHeader.Width[0] + TGAHeader.Width[1] * 256;
Height := TGAHeader.Height[0] + TGAHeader.Height[1] * 256;
ColorDepth := TGAHeader.BPP;
ImageSize := Width*Height*(ColorDepth div 8);
if ColorDepth < 24 then
begin
Result := False;
CloseFile(TGAFile);
MessageBox(0, PChar('Couldn''t load "'+ Filename +'". Only 24 and 32 bit TGA files supported.'), PChar('TGA File Error'), MB_OK);
Exit;
end;
GetMem(Image, ImageSize);
if TGAHeader.ImageType = 2 then // Standard 24, 32 bit TGA file
begin
if LoadFromResource then // Load from resource
begin
try
ResStream.ReadBuffer(Image^, ImageSize);
ResStream.Free;
except
MessageBox(0, PChar('Unable to read from resource - ' + Filename), PChar('BMP Unit'), MB_OK);
Exit;
end;
end
else // Read in the image from file
begin
BlockRead(TGAFile, image^, ImageSize, bytesRead);
if bytesRead <> ImageSize then
begin
Result := False;
CloseFile(TGAFile);
MessageBox(0, PChar('Couldn''t read file "'+ Filename +'".'), PChar('TGA File Error'), MB_OK);
Exit;
end
end;
// TGAs are stored BGR and not RGB, so swap the R and B bytes.
// 32 bit TGA files have alpha channel and gets loaded differently
if TGAHeader.BPP = 24 then
begin
for I :=0 to Width * Height - 1 do
begin
Front := Pointer(Integer(Image) + I*3);
Back := Pointer(Integer(Image) + I*3 + 2);
Temp := Front^;
Front^ := Back^;
Back^ := Temp;
end;
Texture :=CreateTexture(Width, Height, GL_RGB, Image);
end
else
begin
for I :=0 to Width * Height - 1 do
begin
Front := Pointer(Integer(Image) + I*4);
Back := Pointer(Integer(Image) + I*4 + 2);
Temp := Front^;
Front^ := Back^;
Back^ := Temp;
end;
Texture :=CreateTexture(Width, Height, GL_RGBA, Image);
end;
end;
// Compressed 24, 32 bit TGA files
if TGAHeader.ImageType = 10 then
begin
ColorDepth :=ColorDepth DIV 8;
CurrentByte :=0;
CurrentPixel :=0;
BufferIndex :=0;
if LoadFromResource then // Load from resource
begin
try
GetMem(CompImage, ResStream.Size-sizeOf(TGAHeader));
ResStream.ReadBuffer(CompImage^, ResStream.Size-sizeOf(TGAHeader)); // load compressed date into memory
ResStream.Free;
except
MessageBox(0, PChar('Unable to read from resource - ' + Filename), PChar('BMP Unit'), MB_OK);
Exit;
end;
end
else
begin
GetMem(CompImage, FileSize(TGAFile)-sizeOf(TGAHeader));
BlockRead(TGAFile, CompImage^, FileSize(TGAFile)-sizeOf(TGAHeader), BytesRead); // load compressed data into memory
if bytesRead <> FileSize(TGAFile)-sizeOf(TGAHeader) then
begin
Result := False;
CloseFile(TGAFile);
MessageBox(0, PChar('Couldn''t read file "'+ Filename +'".'), PChar('TGA File Error'), MB_OK);
Exit;
end
end;
// Extract pixel information from compressed data
repeat
Front := Pointer(Integer(CompImage) + BufferIndex);
Inc(BufferIndex);
if Front^ < 128 then
begin
For I := 0 to Front^ do
begin
CopySwapPixel(Pointer(Integer(CompImage)+BufferIndex+I*ColorDepth), Pointer(Integer(image)+CurrentByte));
CurrentByte := CurrentByte + ColorDepth;
inc(CurrentPixel);
end;
BufferIndex :=BufferIndex + (Front^+1)*ColorDepth
end
else
begin
For I := 0 to Front^ -128 do
begin
CopySwapPixel(Pointer(Integer(CompImage)+BufferIndex), Pointer(Integer(image)+CurrentByte));
CurrentByte := CurrentByte + ColorDepth;
inc(CurrentPixel);
end;
BufferIndex :=BufferIndex + ColorDepth
end;
until CurrentPixel >= Width*Height;
if ColorDepth = 3 then
Texture :=CreateTexture(Width, Height, GL_RGB, Image)
else
Texture :=CreateTexture(Width, Height, GL_RGBA, Image);
end;
Result :=TRUE;
FreeMem(Image);
end;
end;
{$WARNINGS ON}
{------------------------------------------------------------------}
{ Determines file type and sends to correct function }
{------------------------------------------------------------------}
function LoadTexture(Filename: String; var Texture : GLuint; LoadFromRes : Boolean) : Boolean;
begin
Result:=False;
if copy(Uppercase(filename), length(filename)-3, 4) = '.BMP' then
Result:=LoadBMPTexture(Filename, Texture, LoadFromRes);
if copy(Uppercase(filename), length(filename)-3, 4) = '.JPG' then
Result:=LoadJPGTexture(Filename, Texture, LoadFromRes);
if copy(Uppercase(filename), length(filename)-3, 4) = '.TGA' then
Result:=LoadTGATexture(Filename, Texture, LoadFromRes);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -