Attribute VB_Name = "Effekte"
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long

Private ImagePixels(0 To 2, 0 To 500, 0 To 500) As Integer
Private PixelsRead As Boolean

'Bilder drehen



'Bilder weichzeichnen
'PictureBox
Public Sub SmoothPicture(picPictureBox As PictureBox)
   Dim I As Integer, j As Integer
   Dim red As Integer, green As Integer, blue As Integer
   Dim X As Integer, Y As Integer
   
   ReadPixels picPictureBox
   
   picPictureBox.ScaleMode = 3
   X = picPictureBox.ScaleWidth
   Y = picPictureBox.ScaleHeight
   
   For I = 1 To Y - 2
      For j = 1 To X - 2
         red = ImagePixels(0, I - 1, j - 1) + ImagePixels(0, I - 1, j) + ImagePixels(0, I - 1, j + 1) + _
         ImagePixels(0, I, j - 1) + ImagePixels(0, I, j) + ImagePixels(0, I, j + 1) + _
         ImagePixels(0, I + 1, j - 1) + ImagePixels(0, I + 1, j) + ImagePixels(0, I + 1, j + 1)
         
         green = ImagePixels(1, I - 1, j - 1) + ImagePixels(1, I - 1, j) + ImagePixels(1, I - 1, j + 1) + _
         ImagePixels(1, I, j - 1) + ImagePixels(1, I, j) + ImagePixels(1, I, j + 1) + _
         ImagePixels(1, I + 1, j - 1) + ImagePixels(1, I + 1, j) + ImagePixels(1, I + 1, j + 1)
         
         blue = ImagePixels(2, I - 1, j - 1) + ImagePixels(2, I - 1, j) + ImagePixels(2, I - 1, j + 1) + _
         ImagePixels(2, I, j - 1) + ImagePixels(2, I, j) + ImagePixels(2, I, j + 1) + _
         ImagePixels(2, I + 1, j - 1) + ImagePixels(2, I + 1, j) + ImagePixels(2, I + 1, j + 1)
         
         picPictureBox.PSet (j, I), RGB(red / 9, green / 9, blue / 9)
      Next
   Next
End Sub

'Bilder überbelichten
'PictureBox
Public Sub SolarizePicture(picPictureBox As PictureBox)
   Dim I As Integer, j As Integer
   Dim red As Integer, green As Integer, blue As Integer
   Dim X As Integer, Y As Integer
   
  ReadPixels picPictureBox
   
   picPictureBox.ScaleMode = 3
   X = picPictureBox.ScaleWidth
   Y = picPictureBox.ScaleHeight
   
   For I = 1 To Y - 2
      For j = 1 To X - 2
         red = ImagePixels(0, I, j)
         green = ImagePixels(1, I, j)
         blue = ImagePixels(2, I, j)
         If ((red < 128) Or (red > 255)) Then red = 255 - red
         If ((green < 128) Or (green > 255)) Then green = 255 - green
         If ((blue < 128) Or (blue > 255)) Then blue = 255 - blue
         picPictureBox.PSet (j, I), RGB(red, green, blue)
      Next
   Next
End Sub

'Bilder schärfen
'PictureBox
Public Sub SharpenPicture(picPictureBox As PictureBox)
   Dim I As Integer, j As Integer
   Dim red As Integer, green As Integer, blue As Integer
   Dim X As Integer, Y As Integer
   Const Dx As Byte = 1
   Const Dy As Byte = 1
   
    ReadPixels picPictureBox
   
   picPictureBox.ScaleMode = 3
   X = picPictureBox.ScaleWidth
   Y = picPictureBox.ScaleHeight
   
   For I = 1 To Y - 2
      For j = 1 To X - 2
         red = ImagePixels(0, I, j) + 0.5 * (ImagePixels(0, I, j) - ImagePixels(0, I - Dx, j - Dy))
         green = ImagePixels(1, I, j) + 0.5 * (ImagePixels(1, I, j) - ImagePixels(1, I - Dx, j - Dy))
         blue = ImagePixels(2, I, j) + 0.5 * (ImagePixels(2, I, j) - ImagePixels(2, I - Dx, j - Dy))
         If red > 255 Then red = 255
         If red < 0 Then red = 0
         If green > 255 Then green = 255
         If green < 0 Then green = 0
         If blue > 255 Then blue = 255
         If blue < 0 Then blue = 0
         picPictureBox.PSet (j, I), RGB(red, green, blue)
      Next
   Next
End Sub

'Bilder prägen
'PictureBox
Public Sub EmbossPicture(picPictureBox As PictureBox)
   Dim I As Integer, j As Integer
   Dim red As Integer, green As Integer, blue As Integer
   Dim X As Integer, Y As Integer
   Const Dx As Integer = 1
   Const Dy As Integer = 1
   
   ReadPixels picPictureBox
   
   picPictureBox.ScaleMode = 3
   X = picPictureBox.ScaleWidth
   Y = picPictureBox.ScaleHeight
   
   For I = 1 To Y - 2
      For j = 1 To X - 2
         red = Abs(ImagePixels(0, I, j) - ImagePixels(0, I + Dx, j + Dy) + 128)
         green = Abs(ImagePixels(1, I, j) - ImagePixels(1, I + Dx, j + Dy) + 128)
         blue = Abs(ImagePixels(2, I, j) - ImagePixels(2, I + Dx, j + Dy) + 128)
         picPictureBox.PSet (j, I), RGB(red, green, blue)
      Next
   Next
End Sub

'Bilder verstreuen
'PictureBox
Public Sub DiffusePicture(picPictureBox As PictureBox)
   Dim I As Integer, j As Integer
   Dim Rx As Integer, Ry As Integer
   Dim red As Integer, green As Integer, blue As Integer
   Dim X As Integer, Y As Integer
   
   ReadPixels picPictureBox
   
   picPictureBox.ScaleMode = 3
   X = picPictureBox.ScaleWidth
   Y = picPictureBox.ScaleHeight
   
   For I = 2 To Y - 3
      For j = 2 To X - 3
         Rx = Rnd() * 4 - 2
         Ry = Rnd() * 4 - 2
         red = ImagePixels(0, I + Rx, j + Ry)
         green = ImagePixels(1, I + Rx, j + Ry)
         blue = ImagePixels(2, I + Rx, j + Ry)
         picPictureBox.PSet (j, I), RGB(red, green, blue)
      Next
   Next
End Sub

'Bilder horizontal spiegeln
'Quell-PictureBox, Ziel-PictureBox
Public Sub FlipHorizontal(picSource As PictureBox, picDestinaton As PictureBox)
   picSource.ScaleMode = 3
   picDestinaton.ScaleMode = 3
   
   picDestinaton.PaintPicture picSource.Picture, 0, 0, _
   picSource.ScaleWidth, picSource.ScaleHeight, picSource.ScaleWidth, _
   0, -picSource.ScaleWidth, picSource.ScaleHeight, &HCC0020
End Sub

'Bilder vertikal spiegeln
'Quell-PictureBox, Ziel-PictureBox
Public Sub FlipVertical(picSource As PictureBox, picDestinaton As PictureBox)
   picSource.ScaleMode = 3
   picDestinaton.ScaleMode = 3
   
   picDestinaton.PaintPicture picSource.Picture, 0, 0, _
   picSource.ScaleWidth, picSource.ScaleHeight, 0, _
   picSource.ScaleHeight, picSource.ScaleWidth, -picSource.ScaleHeight, &HCC0020
End Sub



'Interne Routinen_________________________________________________________________________
Private Function pPoint(ByVal X As Double, ByVal Y As Double, ByVal obj As Long) As Long
   z = Int(X)
   z2 = Int(X + 0.999)
   d2 = X - z
   If (z - z2) = 0 Then
      pPoint = pPoint2(z, Y, obj)
   Else
      pPoint = RGBDiv(pPoint2(z, Y, obj), d2, pPoint2(z2, Y, obj), (1 - d2))
   End If
End Function

Private Function pPoint2(ByVal X As Double, ByVal Y As Double, ByVal obj As Long) As Long
   z = Int(Y)
   z2 = Int(Y + 0.999)
   d2 = Y - z
   If (z - z2) = 0 Then
      pPoint2 = GetPixel(obj, X, z)
   Else
      pPoint2 = RGBDiv(GetPixel(obj, X, z), d2, GetPixel(obj, X, z2), (1 - d2))
   End If
End Function

Private Function RGBDiv(ByVal c1 As Long, ByVal p2 As Double, ByVal c2 As Long, ByVal p1 As Double)
   r1 = c1 And 255
   g1 = (c1 And (256 ^ 2 - 256)) / 256
   b1 = (c1 And (256 ^ 3 - 65536)) / (256 ^ 2)
   r2 = c2 And 255
   g2 = (c2 And (256 ^ 2 - 256)) / 256
   b2 = (c2 And (256 ^ 3 - 65536)) / (256 ^ 2)
   R3 = r1 * p1 + r2 * p2
   G3 = g1 * p1 + g2 * p2
   B3 = b1 * p1 + b2 * p2
   RGBDiv = RGB(R3, G3, B3)
End Function

Private Sub ReadPixels(picPictureBox As PictureBox)
   Dim pixel As Long
   Dim X As Integer, Y As Integer
   
   picPictureBox.ScaleMode = 3
   X = picPictureBox.ScaleWidth
   Y = picPictureBox.ScaleHeight
   
   For I = 0 To Y - 1
      For j = 0 To X - 1
         pixel = picPictureBox.Point(j, I)
         ImagePixels(0, I, j) = pixel& Mod 256
         ImagePixels(1, I, j) = ((pixel And &HFF00) / 256&) Mod 256&
         ImagePixels(2, I, j) = (pixel And &HFF0000) / 65536
      Next
   Next
   
   PixelsRead = True
End Sub




