Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!Code-Beispiel
TGA Datei speichern
| Lizenz: | Erster Autor: | Letzte Bearbeitung: |
| k. A. |  csde_rats |  23.09.2007 |
Wie man eine TGA Bild speichern kann, demonstriert dieses Programm.
#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
| Zusätzliche Informationen und Funktionen | |||||||
|---|---|---|---|---|---|---|---|
|
|||||||
Bearbeiten
Versionen