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..... |