Загрузка и сохранение изображений формата TGA
Примеры того, как можно загружать и сохранять изображения формата TGA без всяких сторонних библиотек.
Платформы: Windows, Linux
Авторы: yetifoot и
csde_rats
Пример загрузки:
' TGA Loader v0.4 by yetifoot ' PUBLIC DOMAIN ' ' This program loads 16/24/32 bit Targa images, in uncompressed, or RLE format. ' ' The important function is TGA_Load ' Passing a filename to this function will return a pointer to a 32bit FB GFX compatible ' buffer. Failure will result in a NULL pointer. ' ' Credit is due to NeHe ' http://nehe.gamedev.net/data/lessons/lesson.asp?lesson=33 ' Also to Paul Bourke ' http://astronomy.swin.edu.au/~pbourke/dataformats/tga/ #IFNDEF __TGALOAD_BI__ ' See If The Header Has Been Defined Yet #DEFINE __TGALOAD_BI__ ' If Not, Define It. #INCLUDE "crt.bi" ' Standard Header For File I/O Type TGA_HEADER Field = 1 idlength As Ubyte colourmaptype As Ubyte datatypecode As Ubyte colourmaporigin As Ushort colourmaplength As Ushort colourmapdepth As Ubyte x_origin As Ushort y_origin As Ushort Width As Ushort height As Ushort bitsperpixel As Ubyte imagedescriptor As Ubyte End Type ' Type 2 (Uncompressed RGB) Function TGA_Load_2(hFile As FILE Ptr, tga_info As TGA_HEADER Ptr) As Any Ptr Dim As Ubyte Ptr img_buf, tmp_buf Dim FBGFXHeader As Uinteger Dim As Integer i, y Dim numpixels As Uinteger Dim tmpcol As Ushort Dim As Uinteger w, h ' w & h need to be integer for calculations, not the short they are in the header w = tga_info->Width h = tga_info->height ' Calculate number of pixels in image. numpixels = w * h ' Allocate a buffer for the image (to be compatible with PUT etc) img_buf = Allocate((numpixels * 4) + 4) ' Read uncompressed data into buffer If fread(@img_buf[4], 1, numpixels * (tga_info->bitsperpixel / 8), hFile) <> numpixels * (tga_info->bitsperpixel / 8) Then Deallocate(img_buf) Return NULL End If ' If stored in file as 16/24 bit then we need to expand it to the ' 32 bits we will be returning If tga_info->bitsperpixel = 16 Or tga_info->bitsperpixel = 24 Then ' Create a temporary buffer tmp_buf = Allocate((numpixels * 4) + 4) If tmp_buf = NULL Then Deallocate(img_buf) Return NULL End If ' Fix if 16bit If tga_info->bitsperpixel = 16 Then For i = 0 To numpixels - 1 tmpcol = img_buf[(i * 2) + 4] Or (img_buf[(i * 2) + 5] Shl 8) tmp_buf[(i * 4) + 4] = ((tmpcol And &H001F) * &HFF) / &H1F tmp_buf[(i * 4) + 5] = (((tmpcol And &H03E0) Shr 5) * &HFF) / &H1F tmp_buf[(i * 4) + 6] = (((tmpcol And &H7C00) Shr 10) * &HFF) / &H1F tmp_buf[(i * 4) + 7] = 255 Next i End If ' Fix if 24bit If tga_info->bitsperpixel = 24 Then For i = 0 To numpixels - 1 tmp_buf[(i * 4) + 4] = img_buf[(i * 3) + 4] tmp_buf[(i * 4) + 5] = img_buf[(i * 3) + 5] tmp_buf[(i * 4) + 6] = img_buf[(i * 3) + 6] tmp_buf[(i * 4) + 7] = 255 Next i End If ' Free image buffer, and set the pointer to the temporary buffer Deallocate(img_buf) img_buf = tmp_buf tmp_buf = NULL End If ' Add the FB GFX style header FBGFXHeader = (h Shl 16) Or (w Shl 3) Or 4 memcpy(@img_buf[0], @FBGFXHeader, 4) ' Return a pointer to the 32 bit FB GFX compatible buffer Return img_buf End Function ' Type 10 (RLE Compressed RGB) Function TGA_Load_10(hFile As FILE Ptr, tga_info As TGA_HEADER Ptr) As Any Ptr Dim img_buf As Ubyte Ptr Dim FBGFXHeader As Uinteger Dim numpixels As Uinteger Dim tmpcol As Uinteger Dim As Uinteger w, h Dim file_buf As Ubyte Ptr Dim file_buf_pos As Uinteger Dim file_buf_size As Uinteger Dim t_pos As Uinteger Dim counter As Short Dim colorbuffer As Ubyte Ptr Dim bytesPerPixel As Integer Dim As Uinteger currentpixel ' Current Pixel We Are Reading From Data Dim As Uinteger currentbyte ' Current Byte We Are Writing Into Imagedata Dim As Ubyte chunkheader ' Variable To Store The Value Of The Id Chunk ' w & h need to be integer for calculations, not the short they are in the header w = tga_info->Width h = tga_info->height ' find out the size of the remaining data (save and restore file pos) t_pos = ftell(hFile) fseek(hFile, 0, SEEK_END) file_buf_size = ftell(hFile) - t_pos fseek(hFile, t_pos, SEEK_SET) ' Calculate number of pixels in image. numpixels = w * h ' Allocate a buffer for the image (to be compatible with PUT etc) img_buf = Allocate((numpixels * 4) + 4) If img_buf = NULL Then Return NULL End If ' Allocate a buffer for the files compressed data (to avoid 1 byte reads) file_buf = Allocate(file_buf_size) If file_buf = NULL Then Deallocate(img_buf) Return NULL End If ' Load files compressed data to buffer If fread(file_buf, 1, file_buf_size, hFile) <> file_buf_size Then Deallocate(file_buf) Deallocate(img_buf) Return NULL End If bytesPerPixel = tga_info->bitsperpixel / 8 Do ' Start Loop chunkheader = file_buf[file_buf_pos] file_buf_pos += 1 If chunkheader < 128 Then ' If The Chunk Is A 'RAW' Chunk chunkheader += 1 ' Add 1 To The Value To Get Total Number Of Raw Pixels ' Start Pixel Reading Loop For counter = 0 To chunkheader - 1 ' Try To Read 1 Pixel colorbuffer = @file_buf[file_buf_pos] file_buf_pos += bytesPerPixel If bytesPerPixel = 2 Then ' If It's A 16bpp Image... tmpcol = colorbuffer[0] Or (colorbuffer[1] Shl 8) img_buf[currentbyte + 4] = ((tmpcol And &H001F) * &HFF) / &H1F img_buf[currentbyte + 5] = (((tmpcol And &H03E0) Shr 5) * &HFF) / &H1F img_buf[currentbyte + 6] = (((tmpcol And &H7C00) Shr 10) * &HFF) / &H1F img_buf[currentbyte + 7] = 255 ' Write Dummy 'A' Byte End If If bytesPerPixel = 3 Then ' If It's A 24bpp Image... img_buf[currentbyte + 4] = colorbuffer[0] img_buf[currentbyte + 5] = colorbuffer[1] img_buf[currentbyte + 6] = colorbuffer[2] img_buf[currentbyte + 7] = 255 ' Write Dummy 'A' Byte End If If bytesPerPixel = 4 Then ' If It's A 32bpp Image... img_buf[currentbyte + 4] = colorbuffer[0] img_buf[currentbyte + 5] = colorbuffer[1] img_buf[currentbyte + 6] = colorbuffer[2] img_buf[currentbyte + 7] = colorbuffer[3] End If ' Increment The Byte Counter By The Number Of Bytes In A Pixel currentbyte += 4 ' Always 4 because output is 32 bit currentpixel += 1 ' Increment The Number Of Pixels By 1 Next counter Else ' If It's An RLE Header chunkheader -= 127 ' Subtract 127 To Get Rid Of The ID Bit ' Read The Next Pixel colorbuffer = @file_buf[file_buf_pos] file_buf_pos += bytesPerPixel ' Start The Loop For counter = 0 To chunkheader - 1 If bytesPerPixel = 2 Then ' If It's A 16bpp Image... tmpcol = colorbuffer[0] Or (colorbuffer[1] Shl 8) img_buf[currentbyte + 4] = ((tmpcol And &H001F) * &HFF) / &H1F img_buf[currentbyte + 5] = (((tmpcol And &H03E0) Shr 5) * &HFF) / &H1F img_buf[currentbyte + 6] = (((tmpcol And &H7C00) Shr 10) * &HFF) / &H1F img_buf[currentbyte + 7] = 255 ' Write Dummy 'A' Byte End If If bytesPerPixel = 3 Then ' If It's A 24bpp Image... img_buf[currentbyte + 4] = colorbuffer[0] img_buf[currentbyte + 5] = colorbuffer[1] img_buf[currentbyte + 6] = colorbuffer[2] img_buf[currentbyte + 7] = 255 ' Write Dummy 'A' Byte End If If bytesPerPixel = 4 Then ' If It's A 32bpp Image img_buf[currentbyte + 4] = colorbuffer[0] img_buf[currentbyte + 5] = colorbuffer[1] img_buf[currentbyte + 6] = colorbuffer[2] img_buf[currentbyte + 7] = colorbuffer[3] End If ' Increment The Byte Counter currentbyte += 4 ' Always 4 because output is 32 bit currentpixel += 1 ' Increment The Pixel Counter Next counter End If Loop While(currentpixel < numpixels) ' More Pixels To Read? ... Start Loop Over ' Free the file buffer Deallocate(file_buf) ' Add the FB GFX style header FBGFXHeader = (h Shl 16) Or (w Shl 3) Or 4 memcpy(@img_buf[0], @FBGFXHeader, 4) ' Return a pointer to the 32 bit FB GFX compatible buffer Return img_buf End Function Function TGA_Load(filename As Zstring Ptr) As Any Ptr Dim tga_info As TGA_HEADER Dim hFile As FILE Ptr Dim tga_id As Ubyte Ptr Dim As Ubyte Ptr img_buf, tmp_buf Dim y As Integer Dim numpixels As Uinteger Dim As Uinteger w, h ' Open file hFile = fopen(filename, "rb") If hFile = NULL Then Return NULL End If ' Read header If fread(@tga_info, 1, Sizeof(TGA_HEADER), hFile) <> Sizeof(TGA_HEADER) Then fclose(hFile) Return NULL End If ' Read ID String if there is one If tga_info.idlength <> 0 Then tga_id = Allocate(tga_info.idlength) If fread(@tga_id, 1, tga_info.idlength, hFile) <> tga_info.idlength Then Deallocate(tga_id) fclose(hFile) Return NULL End If Deallocate(tga_id) End If ' Load to buffer depending on image type Select Case tga_info.datatypecode Case 2 ' Uncompressed RGB img_buf = TGA_Load_2(hFile, @tga_info) Case 10 ' Compressed RGB img_buf = TGA_Load_10(hFile, @tga_info) Case Else fclose(hFile) Return NULL End Select ' Vertical flip if necessary If ((tga_info.imagedescriptor And 32) Shr 5) = 0 Then w = tga_info.width h = tga_info.height numpixels = w * h ' Create a temporary buffer tmp_buf = Allocate((numpixels * 4) + 4) If tmp_buf = NULL Then Deallocate(img_buf) fclose(hFile) Return NULL End If For y = 0 To h - 1 memcpy(@tmp_buf[(y * w * 4) + 4], @img_buf[(((h - 1) - y) * w * 4) + 4], w * 4) Next y ' Copy FB GFX Header memcpy(@tmp_buf[0], @img_buf[0], 4) ' Free image buffer, and set the pointer to the temporary buffer Deallocate(img_buf) img_buf = tmp_buf tmp_buf = NULL End If ' Close the file fclose(hFile) ' Return a pointer to the 32 bit FB GFX compatible buffer Return img_buf End Function #ENDIF ' __TGALOAD_BI__ End Inclusion Guard Dim Handle As Any Ptr Handle = tga_load("1.tga") Screenres 320, 240, 32 Put (0, 0),Handle , Alpha Sleep
Пример сохранения:
#INCLUDE "fbgfx.bi" Type TGAHEADER Field=1 As Byte idlength As Byte colourmaptype As Byte datatypecode As Short colourmaporigin As Short colourmaplength As Byte colourmapdepth As Short x_origin As Short y_origin As Short Width As Short height As Byte bitsperpixel As Byte imagedescriptor End Type Enum TGAERRORS err_ok =0 err_file err_format err_size End Enum Function SaveTGA(Byval filename As String , _ Byval img As fb.image Ptr=0, _ Byval targetbits As Integer = 32) As Integer Dim As TGAHEADER hdr Dim As Integer l,w,h,b,p,hFile Dim As Byte Ptr lpPixels If Len(filename)=0 Then Return err_file ' file must be in 24 or 32 bits If targetbits<>24 And _ targetbits<>32 Then Return err_format End If ' no screen or screenres active If screenptr=0 Then Return err_format ' must pixels be locked for reading? l=iif(img=0,1,0) If l Then ' get values from screen Screeninfo w,h,,b,p Else ' get values from image w=img->Width:h=img->height:b=img->bpp:p=img->pitch End If If b<4 Then Return err_format If w<1 Then Return err_format If h<1 Then Return err_format ' try to open a file with write access hFile=Freefile If Open(filename For Binary Access Write As #hFile) Then Return err_file End If ' build header for uncompressed TGA With hdr .datatypecode =2 ' RGB .width =w ' size x .height =h ' size y .bitsperpixel =targetbits End With Put #hFile,,hdr ' write TGA header If l Then Screenlock lpPixels=ScreenPtr ' first tripel in first row Else lpPixels=cptr(Byte Ptr,img) lpPixels+=32 ' first tripel in first row End If w Shl=2 ' width in bytes If targetbits=32 Then ' 32 bits save row by row While h Put #hFile,,*lpPixels,w ' width in pixels lpPixels+=p '+ pitch in bytes = one row h-=1 Wend Else ' 24 bits save r,g,b row by row While h For x As Integer=0 To w-4 Step 4 Put #hFile,,lpPixels[x+0] ' red Put #hFile,,lpPixels[x+1] ' green Put #hFile,,lpPixels[x+2] ' blue Next lpPixels+=p '+ pitch in bytes = one row h-=1 Wend End If ' close the file Close hFile ' must be unlocked? If l Then Screenunlock Return err_ok End Function Screenres 640,480,24 ' or 32 Dim As FB.image Ptr test=imagecreate(320,200,0) Circle test,(160,100),50,Rgb(&HFF, 0, 0) ' red Circle test,(160,100),49,Rgb( 0, 0,&HFF),,,,F ' blue Circle (320,240),50,Rgb( 0,&HFF, 0) ' green Circle (320,240),49,Rgb(&HFF,&HFF, 0),,,,F ' yellow If SaveTGA("screen32.tga") Then' save the whole screen as 32bit tga Beep:? "error screen32.tga" End If If SaveTGA("image32.tga",test) Then' save the image as 32bit tga Beep:? "error image32.tga" End If If SaveTGA("screen24.tga",,24) Then' save the whole screen as 24bit tga Beep:? "error screen24.tga" End If If SaveTGA("image24.tga",test,24) Then' save the image as 24bit tga Beep:? "error image24.tga" End If Sleep 1000 Imagedestroy test End
