Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Verzerren + Scaliren von Bildern
| Uploader: |  XOR |
| Datum/Zeit: | 27.01.2011 21:33:02 |
' Verzerren + Scaliren von Bildern
' von: XOR 27.01.2011
' Hinweis: Dieser code kann fehler enthalten!
' ILGetPixel1D(IMAGE as IL_IMAGE Ptr, X as Single, Weite as Single)
' Gibt euch die Farbe der Pixelkette zurueck.
' ILGetPixel2D(IMAGE as IL_IMAGE Ptr, X as Single, Y as Single, Weite as Single, Hohe as Single)
' Gibt euch die Farbe der PixelQuadrates zurueck.
' ILScaleImage(IMAGE as IL_IMAGE Ptr, Weite as Single, Hohe as Single, BBP as Single)
' Scaliert das Bild entsprechend. ist Weite, Hohe, BBP = 0 bleibt dieser Punkt wie er war.
' ILVerzerre(IMAGE as IL_IMAGE Ptr, Stuct As IL_VERZERR Ptr, IMAGE2 As IL_IMAGE Ptr)
' Verzerrt das Bild IMAGE. Ist IMAGE2 = 0 wird das IMAGE-Bild durch das Verzerrte ersetzt.
' Stuct gibt die Verzerrstructur an.
' Verzerrstructur = IL_VERZERR
' Hat den Parameter Point(0 to 3) welche die 4 eckpunkte im Format IL_COORD angibt.
' IL_COORD
' X = XPosition , Y = YPosition , S = XCordinate , T = YCordinate
' ILGetFBImageBuffer(IMAGE As IL_IMAGE Ptr)
' gibt einen FBBuffer zuruck, der mit Put gezeichnet werden kann.
' !! -> Dieser Buffer muss mit Deallocate entfernt werden.
'' ILGetILImageBuffer(Buffer As Any Ptr)
' gibt einen ILBuffer zuruck.
#Define Pi 3.14159265358979323846
Type IL_IMAGE
Width As Integer
Hight As Integer
BBP As Integer
Pointer As UByte Ptr
End Type
Type IL_PIXEL
Red As UByte
Green As UByte
Blue As UByte
Alpha As UByte
End Type
Type IL_COORD
X As Integer
Y As Integer
S As Integer
T As Integer
End Type
Type IL_VERZERR
Point(0 To 3) As IL_COORD
End Type
Function ILGetPixel1D(ByVal IMAGEZeiger As IL_IMAGE Ptr, ByVal X As Single, ByVal Weite As Single)As IL_PIXEL
Dim Zurueck As IL_PIXEL
Dim As Integer Red, Green, Blue, Alp
Dim PixelZeiger As UByte ptr
Dim Reader As Integer
Dim BBP As UByte
PixelZeiger = IMAGEZeiger->Pointer
BBP = IMAGEZeiger->BBP / 8
Weite -= 1
Red = PixelZeiger[Int(X)*BBP] * (1-(X - Int(X)))
If BBP > 1 Then
Green = PixelZeiger[Int(X)*BBP+1] * (1-(X - Int(X)))
If BBP > 2 Then
Blue = PixelZeiger[Int(X)*BBP+2] * (1-(X - Int(X)))
If BBP > 3 Then
Alp = PixelZeiger[Int(X)*BBP+3] * (1-(X - Int(X)))
EndIf
EndIf
EndIf
Reader = Int(X+1)
Do Until Reader > X + Weite
Red += PixelZeiger[Reader*BBP]
If BBP > 1 Then
Green += PixelZeiger[Reader*BBP+1]
If BBP > 2 Then
Blue += PixelZeiger[Reader*BBP+2]
If BBP > 3 Then
Alp += PixelZeiger[Reader*BBP+3]
EndIf
EndIf
EndIf
Reader += 1
Loop
If (((X+Weite) - Int(X+Weite)))<>0 then
Red += PixelZeiger[Int(X+Weite+1)*BBP] * (((X+Weite) - Int(X+Weite)))
If BBP > 1 Then
Green += PixelZeiger[Int(X+Weite+1)*BBP+1] * (((X+Weite) - Int(X+Weite)))
If BBP > 2 Then
Blue += PixelZeiger[Int(X+Weite+1)*BBP+2] * (((X+Weite) - Int(X+Weite)))
If BBP > 3 Then
Alp += PixelZeiger[Int(X+Weite+1)*BBP+3] * (((X+Weite) - Int(X+Weite)))
EndIf
EndIf
EndIf
EndIf
Zurueck.Red = Red/(Weite+1)
Zurueck.Green = Green/(Weite+1)
Zurueck.Blue = Blue/(Weite+1)
Zurueck.Alpha = Alp/(Weite+1)
Return Zurueck
End Function
Function ILGetPixel2D(ByVal IMAGEZeiger As IL_IMAGE Ptr, ByVal X As Single, ByVal Y As Single, ByVal Weite As Single, ByVal Hohe As Single) As IL_PIXEL
Dim Zwischen As Single
Dim PixelZeiger As IL_IMAGE
Dim PixelZeiger2 As IL_IMAGE
Dim Pixel As IL_PIXEL
PixelZeiger.Width = Hohe+1
PixelZeiger.Hight = 1
PixelZeiger.BBP = IMAGEZeiger->BBP
PixelZeiger.Pointer = Allocate(PixelZeiger.Width * PixelZeiger.BBP/8)
For i As Integer = 0 To Int(Hohe)
If Y + i > IMAGEZeiger->Hight Then Exit for
PixelZeiger2.Width = Weite+1
PixelZeiger2.Hight = 1
PixelZeiger2.BBP = IMAGEZeiger->BBP
PixelZeiger2.Pointer = @IMAGEZeiger->Pointer[(Int(X) + Int(Y+i)*IMAGEZeiger->Width)*IMAGEZeiger->BBP/8]
Pixel = ILGetPixel1D(@PixelZeiger2,X - Int(X),Weite)
PixelZeiger.Pointer[i*PixelZeiger2.BBP/8] = Pixel.Red
If PixelZeiger2.BBP > 8 Then
PixelZeiger.Pointer[i*PixelZeiger2.BBP/8+1] = Pixel.Green
If PixelZeiger2.BBP > 16 Then
PixelZeiger.Pointer[i*PixelZeiger2.BBP/8+2] = Pixel.Blue
If PixelZeiger2.BBP > 24 Then
PixelZeiger.Pointer[i*PixelZeiger2.BBP/8+3] = Pixel.Alpha
EndIf
EndIf
EndIf
Next
Pixel = ILGetPixel1D(@PixelZeiger,Y-Int(Y),Hohe)
DeAllocate(PixelZeiger.Pointer)
Return Pixel
End Function
Sub ILScaleImage(ByVal IMAGEZeiger As IL_IMAGE Ptr, ByVal Weite As Integer, ByVal Hohe As Integer, ByVal BBP As Integer)
If BBP = 0 Then
BBP = IMAGEZeiger->BBP
EndIf
If Weite = 0 Then
Weite = IMAGEZeiger->Width
EndIf
If Hohe = 0 Then
Hohe = IMAGEZeiger->Hight
EndIf
If BBP <> IMAGEZeiger->BBP Then
Dim Zeiger As UByte Ptr
Zeiger = Allocate(IMAGEZeiger->Width * IMAGEZeiger->Hight * BBP/8)
For i As ULongInt = 0 To IMAGEZeiger->Width * IMAGEZeiger->Hight
Zeiger[i*BBP/8] = IMAGEZeiger->Pointer[i*IMAGEZeiger->BBP/8]
Zeiger[i*BBP/8+1] = IMAGEZeiger->Pointer[i*IMAGEZeiger->BBP/8+1]
Zeiger[i*BBP/8+2] = IMAGEZeiger->Pointer[i*IMAGEZeiger->BBP/8+2]
If BBP = 32 Then
Zeiger[i*BBP/8] = 255
EndIf
Next
DeAllocate(IMAGEZeiger->Pointer)
IMAGEZeiger->Pointer = Zeiger
IMAGEZeiger->BBP = BBP
EndIf
Dim Zeiger As UByte Ptr
Dim Pixel As IL_PIXEL
Dim X As Single
Dim Y As Single
X = IMAGEZeiger->Width/Weite
If X < 1 Then X = 1
Y = IMAGEZeiger->Hight/Hohe
If Y < 1 Then Y = 1
Dim X1 As Single
Dim Y1 As Single
X1 = Weite/IMAGEZeiger->Width
Y1 = Hohe/IMAGEZeiger->Hight
Zeiger = Allocate(Weite * Hohe * BBP/8)
For j As Integer = 0 To Hohe - 1
For i As Integer = 0 To Weite - 1
Pixel = ILGetPixel2D(IMAGEZeiger,i*IMAGEZeiger->Width/(Weite+X1),j*IMAGEZeiger->Hight/(Hohe+Y1),X,Y)
Zeiger[(j*Weite+i)*BBP/8] = Pixel.Red
Zeiger[(j*Weite+i)*BBP/8+1] = Pixel.Green
Zeiger[(j*Weite+i)*BBP/8+2] = Pixel.Blue
If BBP = 32 Then
Zeiger[(j*Weite+i)*BBP/8+3] = Pixel.Alpha
EndIf
Next
Next
DeAllocate(IMAGEZeiger->Pointer)
IMAGEZeiger->Pointer = Zeiger
IMAGEZeiger->Width = Weite
IMAGEZeiger->Hight = Hohe
End Sub
Sub ILVerzerre(ByVal IMAGEZeiger As IL_IMAGE Ptr, ByVal Stuct As IL_VERZERR Ptr, ByVal IMAGEZeiger2 As IL_IMAGE Ptr)
Dim SortX(0 To 3,0 To 1) As Integer
Dim SortY(0 To 3,0 To 1) As Integer
Dim Zwischen As Integer
Dim XMinus As Integer
Dim YMinus As Integer
for i as Integer = 0 to 3
SortX(i,0) = Stuct->Point(i).X
SortX(i,1) = i
SortY(i,0) = Stuct->Point(i).Y
SortY(i,1) = i
Next
For j As Integer = 2 To 0 Step -1
For i As Integer = 0 To j
If SortX(i,0) > SortX(i+1,0) Then
Zwischen = SortX(i,0)
SortX(i,0) = SortX(i+1,0)
SortX(i+1,0) = Zwischen
Zwischen = SortX(i,1)
SortX(i,1) = SortX(i+1,1)
SortX(i+1,1) = Zwischen
EndIf
Next
Next
For j As Integer = 2 To 0 Step -1
For i As Integer = 0 To j
If SortY(i,0) > SortY(i+1,0) Then
Zwischen = SortY(i,0)
SortY(i,0) = SortY(i+1,0)
SortY(i+1,0) = Zwischen
Zwischen = SortY(i,1)
SortY(i,1) = SortY(i+1,1)
SortY(i+1,1) = Zwischen
EndIf
Next
Next
For i As Integer = 0 To 2
If SortY(i,0) = SortY(i+1,0) Then
If Stuct->Point(SortY(i,1)).X > Stuct->Point(SortY(i+1,1)).X Then
Zwischen = SortY(i,0)
SortY(i,0) = SortY(i+1,0)
SortY(i+1,0) = Zwischen
Zwischen = SortY(i,1)
SortY(i,1) = SortY(i+1,1)
SortY(i+1,1) = Zwischen
EndIf
EndIf
Next
XMinus = SortX(0,0)
YMinus = SortY(0,0)
Dim NewImage As IL_IMAGE
Dim Linie(0 To 1,0 To 1) As Integer
Dim TexPoints(0 To 3) As Single
Dim Points(0 To 1) As Integer
Dim Ent As Single
Dim Posi As Single
Dim Starke As Single
Dim As Single StepX, StepY, TexX, TexY
Dim Pixel As IL_PIXEL
NewImage.Width = SortX(3,0)+1
NewImage.Hight = SortY(3,0)+1
NewImage.BBP = 32
NewImage.Pointer = Allocate(NewImage.Width*NewImage.Hight*4)
Linie(0,0) = SortY(0,1)
Linie(0,1) = SortY(1,1)
Linie(1,0) = SortY(0,1)
Linie(1,1) = SortY(2,1)
For j As Integer = YMinus To NewImage.Hight-1
If j > Stuct->Point(Linie(0,1)).Y Then
Linie(0,0) = SortY(3,1)
EndIf
If j > Stuct->Point(Linie(1,1)).Y Then
Linie(1,0) = SortY(3,1)
EndIf
If (Stuct->Point(Linie(0,0)).Y-Stuct->Point(Linie(0,1)).Y) = 0 Then
Points(0) = Stuct->Point(Linie(0,0)).X
Points(1) = Stuct->Point(Linie(0,1)).X
TexPoints(0) = Stuct->Point(Linie(0,1)).S
TexPoints(1) = Stuct->Point(Linie(0,1)).T
TexPoints(2) = Stuct->Point(Linie(0,0)).S
TexPoints(3) = Stuct->Point(Linie(0,0)).T
Else
Points(0) = Stuct->Point(Linie(0,0)).X+(Stuct->Point(Linie(0,0)).X - Stuct->Point(Linie(0,1)).X)/(Stuct->Point(Linie(0,0)).Y-Stuct->Point(Linie(0,1)).Y)*(j-Stuct->Point(Linie(0,0)).Y)
Points(1) = Stuct->Point(Linie(1,0)).X+(Stuct->Point(Linie(1,0)).X - Stuct->Point(Linie(1,1)).X)/(Stuct->Point(Linie(1,0)).Y-Stuct->Point(Linie(1,1)).Y)*(j-Stuct->Point(Linie(1,0)).Y)
Ent = (Stuct->Point(Linie(0,0)).X - Stuct->Point(Linie(0,1)).X)^2+(Stuct->Point(Linie(0,0)).Y-Stuct->Point(Linie(0,1)).Y)^2
Posi = (Stuct->Point(Linie(0,0)).X - Points(0))^2+(Stuct->Point(Linie(0,0)).Y-j)^2
If Ent = 0 Then
Starke = 0
Else
Starke = Posi^0.5/Ent^0.5
EndIf
TexPoints(0) = Stuct->Point(Linie(0,0)).S*(1-Starke)+Stuct->Point(Linie(0,1)).S*(Starke)
TexPoints(1) = Stuct->Point(Linie(0,0)).T*(1-Starke)+Stuct->Point(Linie(0,1)).T*(Starke)
Ent = (Stuct->Point(Linie(1,0)).X - Stuct->Point(Linie(1,1)).X)^2+(Stuct->Point(Linie(1,0)).Y-Stuct->Point(Linie(1,1)).Y)^2
Posi = (Stuct->Point(Linie(1,0)).X - Points(1))^2+(Stuct->Point(Linie(1,0)).Y-j)^2
If Ent = 0 Then
Starke = 0
Else
Starke = Posi^0.5/Ent^0.5
EndIf
TexPoints(2) = Stuct->Point(Linie(1,0)).S*(1-Starke)+Stuct->Point(Linie(1,1)).S*(Starke)
TexPoints(3) = Stuct->Point(Linie(1,0)).T*(1-Starke)+Stuct->Point(Linie(1,1)).T*(Starke)
EndIf
Points(0) = Abs(Points(0))
Points(1) = Abs(Points(1))
If Points(0) > Points(1) Then
Zwischen = Points(1)
Points(1) = Points(0)
Points(0) = Zwischen
Zwischen = TexPoints(0)
TexPoints(0) = TexPoints(2)
TexPoints(2) = Zwischen
Zwischen = TexPoints(1)
TexPoints(1) = TexPoints(3)
TexPoints(3) = Zwischen
EndIf
If TexPoints(0)-TexPoints(2)= 0 Then
StepX = 0
Else
StepX = TexPoints(2)-TexPoints(0)
EndIf
If TexPoints(1)-TexPoints(3)= 0 Then
StepY = 0
Else
StepY = TexPoints(3)-TexPoints(1)
EndIf
StepX /= -(Points(1)-Points(0))
StepY /= -(Points(1)-Points(0))
TexX = TexPoints(2)
TexY = TexPoints(3)
For i As Integer = NewImage.Width-1 To 0 step -1
If i >= Points(0) And i <= Points(1) Then
Pixel = ILGetPixel2D(IMAGEZeiger,TexX,TexY,1,1)
NewImage.Pointer[(j*NewImage.Width + i)*4] = Pixel.Red
NewImage.Pointer[(j*NewImage.Width + i)*4+1] = Pixel.Green
NewImage.Pointer[(j*NewImage.Width + i)*4+2] = Pixel.Blue
NewImage.Pointer[(j*NewImage.Width + i)*4+3] = Pixel.Alpha
TexX += StepX
TexY += StepY
Else
NewImage.Pointer[(j*NewImage.Width + i)*4] = 0
NewImage.Pointer[(j*NewImage.Width + i)*4+1] = 0
NewImage.Pointer[(j*NewImage.Width + i)*4+2] = 0
NewImage.Pointer[(j*NewImage.Width + i)*4+3] = 0
EndIf
Next
Next
If IMAGEZeiger2 = 0 Then
DeAllocate(IMAGEZeiger->Pointer)
IMAGEZeiger->Pointer = NewImage.Pointer
IMAGEZeiger->Width = NewImage.Width
IMAGEZeiger->Hight = NewImage.Hight
IMAGEZeiger->BBP = NewImage.BBP
Else
For j As Integer = 0 To NewImage.Hight-1
For i As Integer = 0 To NewImage.Width-1
If NewImage.Pointer[(j*NewImage.Width+i)*4+3] <> 0 Then
For BBp As Integer = 0 To IMAGEZeiger2->BBP/8-1
IMAGEZeiger2->Pointer[(j*IMAGEZeiger2->Width+i)*IMAGEZeiger2->BBP/8+BBP] = NewImage.Pointer[(j*NewImage.Width+i)*4+BBP]
Next
EndIf
Next
Next
DeAllocate(NewImage.Pointer)
EndIf
End Sub
Function ILGetFBImageBuffer(ByVal IMAGEZeiger As IL_IMAGE Ptr) As Any Ptr
Dim As Integer Weite, Hohe, BBP
Dim Buffer As Any Ptr
Weite = IMAGEZeiger->Width
Hohe = IMAGEZeiger->Hight
BBP = IMAGEZeiger->BBP/8
Buffer = Allocate(32 + ( Hohe * (( Weite * 4 + 15 ) AND -16 )))
Cast(UInteger Ptr,Buffer)[0] = 7
Cast(Integer Ptr,Buffer)[1] = 4
Cast(UInteger Ptr,Buffer)[2] = Weite
Cast(UInteger Ptr,Buffer)[3] = Hohe
Cast(UInteger Ptr,Buffer)[4] = (( Weite * 4 + 15 ) AND -16 )
For j As Integer = 0 To Hohe - 1
For i As Integer = 0 To Weite - 1
Cast(UByte Ptr,Buffer)[32+i*4+j*(( Weite * 4 + 15 ) AND -16 )] = IMAGEZeiger->Pointer[j*Weite*BBP+i*BBP]
Cast(UByte Ptr,Buffer)[32+i*4+j*(( Weite * 4 + 15 ) AND -16 )+1] = IMAGEZeiger->Pointer[j*Weite*BBP+i*BBP+1]
Cast(UByte Ptr,Buffer)[32+i*4+j*(( Weite * 4 + 15 ) AND -16 )+2] = IMAGEZeiger->Pointer[j*Weite*BBP+i*BBP+2]
If BBP > 3 Then
Cast(UByte Ptr,Buffer)[32+i*4+j*(( Weite * 4 + 15 ) AND -16 )+3] = IMAGEZeiger->Pointer[j*Weite*BBP+i*BBP+3]
Else
Cast(UByte Ptr,Buffer)[32+i*4+j*(( Weite * 4 + 15 ) AND -16 )+3] = 255
EndIf
Next
Next
Return Buffer
End Function
Function ILGetILImageBuffer(ByVal Buffer As Any Ptr)As IL_IMAGE
Dim Image As IL_IMAGE
Dim As Integer Weite, Hohe, BBP
Image.Width = Cast(UInteger Ptr,Buffer)[2]
Image.Hight = Cast(UInteger Ptr,Buffer)[3]
Image.BBP = 32
Weite = Image.Width
Hohe = Image.Hight
BBP = Image.BBP/8
Image.Pointer = Allocate(Image.Width*Image.Hight*Image.BBP/8)
For j As Integer = 0 To Hohe - 1
For i As Integer = 0 To Weite - 1
Image.Pointer[j*Weite*BBP+i*BBP] = Cast(UByte Ptr,Buffer)[32+i*4+j*(( Weite * 4 + 15 ) AND -16 )]
Image.Pointer[j*Weite*BBP+i*BBP+1] = Cast(UByte Ptr,Buffer)[32+i*4+j*(( Weite * 4 + 15 ) AND -16 )+1]
Image.Pointer[j*Weite*BBP+i*BBP+2] = Cast(UByte Ptr,Buffer)[32+i*4+j*(( Weite * 4 + 15 ) AND -16 )+2]
Image.Pointer[j*Weite*BBP+i*BBP+3] = Cast(UByte Ptr,Buffer)[32+i*4+j*(( Weite * 4 + 15 ) AND -16 )+3]
Next
Next
Return Image
End Function
Dim Image As IL_IMAGE
Dim Screenw As IL_IMAGE
Dim FBImage As UByte Ptr
Dim Pixel As IL_PIXEL
Dim VerzerrStruct As IL_VERZERR
Screenres 800,600,32
Screenw.Width = 800
Screenw.Hight = 600
Screenw.BBP = 32
Screenw.Pointer = ScreenPtr
FBImage = ImageCreate(512,512,,32)
BLoad "Test.bmp",FBImage
Image = ILGetILImageBuffer(FBImage)
VerzerrStruct.Point(0).X = 100
VerzerrStruct.Point(0).Y = 0
VerzerrStruct.Point(0).S = 0
VerzerrStruct.Point(0).T = 0
VerzerrStruct.Point(1).X = 300
VerzerrStruct.Point(1).Y = 00
VerzerrStruct.Point(1).S = 512
VerzerrStruct.Point(1).T = 0
VerzerrStruct.Point(2).X = 400
VerzerrStruct.Point(2).Y = 400
VerzerrStruct.Point(2).S = 512
VerzerrStruct.Point(2).T = 512
VerzerrStruct.Point(3).X = 0
VerzerrStruct.Point(3).Y = 400
VerzerrStruct.Point(3).S = 0
VerzerrStruct.Point(3).T = 512
ScreenLock
ILVerzerre(@Image,@VerzerrStruct,@Screenw)
ScreenUnLock
DeAllocate(Image.Pointer)
ImageDestroy(FBImage)
Sleep
End