Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Bildervergleicher
| Uploader: |  csde_rats |
| Datum/Zeit: | 22.12.2010 22:27:33 |
' Copyright 2010 Marian Beermann (www.marianbeermann.de)
' Mal auf die schnelle fürs 3dc-forum gefrickelt
' http://www.forum-3dcenter.org/vbulletin/showthread.php?p=8464171&posted=1#post8464171
#Include "crt.bi"
Type TGAHeader Field=1
As Byte idlen 'length of optional identification sequence
As Byte cmtype 'indicates whether a palette is present
As Byte imtype 'image data type (e.g., uncompressed RGB)
As UShort cmorg 'first palette index, if present
As UShort cmcnt 'number of palette entries, if present
As Byte cmsize 'number of bits per palette entry
As UShort imxorg 'horiz pixel coordinate of lower left of image
As UShort imyorg 'vert pixel coordinate of lower left of image
As UShort imwidth 'image width in pixels
As UShort imheight 'image height in pixels
As Byte imdepth 'image color depth (bits per pixel)
As Byte imdes 'image attribute flags
End Type
Type pixel
As UByte red
As UByte blue
As UByte green
As UByte alpha
End Type
Dim Shared As Integer gWidth, gHeight
'Sub WritePixel (image As Any Ptr, pix As pixel Ptr, x As Integer, y As Integer)
' (Cast(pixel Ptr, image)[gWidth*y+x]) = *pix ' *(image+gWidth*y+x) = *pix; ??
'End Sub
'
'Sub ReadPixel (image As Any Ptr, pix As pixel Ptr, x As Integer, y As Integer)
' *pix = (Cast(pixel Ptr, image)[gWidth*y+x]) ' *pix = *(image+gWidth*y+x); ??
'End Sub
'Function PackFloatInByte (in As Double) As Byte
' Return Cast(Byte, ((in+1.0) / 2.0 * 255.0))
'End Function
Sub main()
Dim As String buff, inFile, outFile, inFile2
Dim As TGAHeader tga
Dim As ULong bytesRead
Dim As Integer x, y
Dim As Any Ptr descBytes
Dim As pixel pix, refpix
Dim As pixel Ptr srcImage, srcImage2, dstImage
Dim As Double dX, dY, nX, nY, nZ, oolen
inFile = Command(1)
inFile2 = Command(2)
outFile = Command(3)
Open inFile For Binary As #1
Open outFile For Binary As #2
Open inFile2 For Binary As #3
Get #1, , tga
Put #2, , tga
descBytes = Cast(UByte Ptr, Allocate(SizeOf(UByte) * tga.idlen))
Get #1, , tga.idlen
Put #2, , tga.idlen
gWidth = tga.imwidth
gHeight = tga.imheight
srcImage = Cast(pixel Ptr, Allocate(SizeOf(pixel) * gHeight * gWidth))
srcImage2 = Cast(pixel Ptr, Allocate(SizeOf(pixel) * gHeight * gWidth))
dstImage = Cast(pixel Ptr, Allocate(SizeOf(pixel) * gHeight * gWidth))
For y = 0 To gHeight
For x = 0 To gWidth
Get #1, , pix.blue
Get #1, , pix.green
Get #1, , pix.red
Get #3, , refpix.blue
Get #3, , refpix.green
Get #3, , refpix.red
If tga.imdepth = 32 Then
Get #1, , pix.alpha
Get #3, , refpix.alpha
Else
pix.alpha = 0
refpix.alpha = 0
EndIf
'Or _
' ( _
' ( _
' (pix.red < (refpix.red + refpix.red * TOL)) And _
' (pix.blue < (refpix.blue + refpix.blue * TOL)) And _
' (pix.green < (refpix.green + refpix.green * TOL)) _
' ) _
' And _
' ( _
' (pix.red > (refpix.red - refpix.red * TOL)) And _
' (pix.blue > (refpix.blue - refpix.blue * TOL)) And _
' (pix.green > (refpix.green - refpix.green * TOL)) _
' ) _
' ) _
Dim TOL As Double = 0.2
If _
( _
( _
(pix.red = refpix.red) And _
(pix.blue = refpix.blue) And _
(pix.green = refpix.green) _
) _
) _
Then
pix.blue = 0
pix.green = 0
pix.alpha = 0
pix.red = 0
Else
pix.blue = 0
pix.green = 255
pix.alpha = 0
pix.red = 0
EndIf
Put #2, , pix.blue
Put #2, , pix.green
Put #2, , pix.red
If tga.imdepth = 32 Then
Put #2, , pix.alpha
EndIf
Next x
Next y
DeAllocate(srcImage)
DeAllocate(dstImage)
DeAllocate(descBytes)
Close #1, #2, #3
End Sub
main()
End