Schärfen eines Bildes von Vertex
[code:1:30524e45ab]
; ------------------------------------------------------------
Graphics 640,480,32,2
SetBuffer BackBuffer()
; ------------------------------------------------------------

; ------------------------------------------------------------
Image = LoadImage("Test.png")
Dim Buffer(ImageWidth(Image),ImageHeight(Image))
Dim Picture(ImageWidth(Image),ImageHeight(Image))
; ------------------------------------------------------------

; ------------------------------------------------------------
SetBuffer ImageBuffer(Image)
LockBuffer ImageBuffer(Image)

For X = 0 To ImageWidth(Image)
For Y = 0 To ImageHeight(Image)
Buffer(X,Y) = ReadPixelFast(X,Y)
Next
Next

For X = 0 To ImageWidth(Image) - 3
For Y = 0 To ImageHeight(Image)
BufferR1 = GetR(Buffer(X,Y))
BufferG1 = GetG(Buffer(X,Y))
BufferB1 = GetB(Buffer(X,Y))

BufferR2 = GetR(Buffer(X + 3,Y))
BufferG2 = GetG(Buffer(X + 3,Y))
BufferB2 = GetB(Buffer(X + 3,Y))

TempR = BufferR1 + 0.5 * (BufferR1 - BufferR2)
If TempR > 255 Then TempR = 255
If TempR < 0 Then TempR = 0

TempG = BufferG1 + 0.5 * (BufferG1 - BufferG2)
If TempG > 255 Then TempG = 255
If TempG < 0 Then TempG = 0

TempB = BufferB1 + 0.5 * (BufferB1 - BufferB2)
If TempB > 255 Then TempB = 255
If TempB < 0 Then TempB = 0

Picture(X,Y) = GetRGB(TempR,TempG,TempB)
Next
Next

For X = 0 To ImageWidth(Image) - 3
For Y = 0 To ImageHeight(Image)
WritePixelFast X,Y,Picture(X,Y)
Next
Next

For X = ImageWidth(Image) - 3 To ImageWidth(Image)
For Y = ImageHeight(Image) To ImageHeight(Image)
WritePixelFast X,Y,Buffer(X,Y)
Next
Next
UnlockBuffer ImageBuffer(Image)
; ------------------------------------------------------------

; ------------------------------------------------------------
Dim Buffer(0,0)
Dim Picture(0,0)
; ------------------------------------------------------------

; ------------------------------------------------------------
SetBuffer BackBuffer()
DrawImage Image,0,0 : Flip
; ------------------------------------------------------------

; ------------------------------------------------------------
WaitKey : FreeImage Image : End
; ------------------------------------------------------------

; ------------------------------------------------------------
Function GetR(RGB)
Return (RGB And $FF0000) / $10000
End Function

Function GetG(RGB)
Return (RGB And $FF00) / $100
End Function

Function GetB(RGB)
Return RGB And $FF
End Function

Function GetRGB(R,G,B)
Return R * $10000 + G * $100 + B
End Function
; ------------------------------------------------------------
[/code:1:30524e45ab]
mfg olli
===
von ???
sehr schön
===
von ???
....da kann man sich nur anschließen.....



Suche:
(unterstützt mySQL Wildcards ala %)
Titel:
Text:
Autor: