Bilder schärfen

Übersicht BlitzBasic Codearchiv

Neue Antwort erstellen

Triton

Betreff: Bilder schärfen

BeitragMi, März 03, 2004 18:32
Antworten mit Zitat
Benutzer-Profile anzeigen
Dieser Code bewirkt das Gegenteil vom Blureffekt: er schärft ein Bild.

Das verbessert in vielen fällen die Bildqualität.



Code: [AUSKLAPPEN]
;*** Bilder schärfen
;*** ursprünglich von ??? verbessert und ausgebaut von Triton
;*** www.silizium-net.de
Graphics 1024,768,16,2

pic = LoadImage("005.jpg")      ;dieses Bild wird geschärft
pic2 = LoadImage("005.jpg")      ;nochmal als vergleich

sharp=1                     ;Schärferadius  (0 = garnicht, 1 = moderat, 2 = erhöht, 3 => stark)

Dim Buffer(ImageWidth(pic),ImageHeight(pic))
Dim Picture(ImageWidth(pic),ImageHeight(pic))


DrawImage pic2,0,20
Text 10, 0, "Schärferadius = 0"
sharpen(pic,sharp)
Text ImageWidth(pic)+10, 0, "Schärferadius = "+sharp
DrawImage pic,ImageWidth(pic),20

WaitKey
FreeImage pic
End

;---
Function sharpen(image,sharp)
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) - sharp
   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 + sharp,Y))
      BufferG2 = GetG(Buffer(X + sharp,Y))
      BufferB2 = GetB(Buffer(X + sharp,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) - sharp
   For Y = 0 To ImageHeight(Image)
      WritePixelFast X,Y,Picture(X,Y)
   Next
Next

For X = ImageWidth(Image) - sharp To ImageWidth(Image)
   For Y = ImageHeight(Image) To ImageHeight(Image)
      WritePixelFast X,Y,Buffer(X,Y)
   Next
Next
UnlockBuffer ImageBuffer(Image)
SetBuffer FrontBuffer()
End Function


;---
Function sharpen2(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)
SetBuffer FrontBuffer()
End Function


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


Neue Antwort erstellen


Übersicht BlitzBasic Codearchiv

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group