Attribute VB_Name = "SFX"
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

'--- Wilkommen in dem "Special Effects" -Modul ---

'    Hier werden die einzelnen Effekte die man
'    in der Listbox auswählen kann ausgeführt.

'1. Überbelichten
'2. Schärfen
'3. Verstreuen
'4. Graustufen
'5. Border
'6. Colorieren

'    Die Texturen werden im "MyEffects" Modul
'    behandelt.

'### Überbelichten ##############################################
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
On Error Resume Next

  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

'### Schärfen ##################################################
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
On Error Resume Next

  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

'### Verstreuen ###################################################
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
   On Error Resume Next
    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

'### Graustufen ##############################################
Public Sub DoGrayScale(picSource As PictureBox, _
Optional ByVal nTransColor As Long = -1)
On Error Resume Next

  Dim nHeight As Long
  Dim nWidth As Long
  Dim X As Long
  Dim Y As Long
  Dim nColor As Long
  Dim nRed As Long
  Dim nGreen As Long
  Dim nBlue As Long
  Dim nGray As Long
  Dim nScaleMode As Long
  
  With picSource
    nScaleMode = .ScaleMode
    .ScaleMode = vbPixels
 
    nWidth = .ScaleWidth
    nHeight = .ScaleHeight

    For X = 0 To nWidth - 1
      For Y = 0 To nHeight - 1

        nColor = .Point(X, Y)

        If nColor <> nTransColor Then

          nRed = nColor Mod 256
          nGreen = ((nColor And &HFF00) / 256&) Mod 256&
          nBlue = (nColor And &HFF0000) / 65536
          nGray = ((nRed * 30) + (nGreen * 60) + (nBlue * 10)) / 100
          If nGray > 255 Then nGray = 255
           picSource.PSet (X, Y), RGB(nGray, nGray, nGray)
        End If
      Next Y
    Next X

    .ScaleMode = nScaleMode
  End With
End Sub

'### Border ####################################################
Public Function Border(Topic As PictureBox, BG As Long)
Dim RColor As Long
RColor = Fcol

For ax = 0 To Topic.ScaleWidth
For ay = 0 To Topic.ScaleHeight

If GetPixel(Topic.hDC, ax, ay) = vbWhite Then


If GetPixel(Topic.hDC, ax + 1, ay) = BG Then _
   SetPixel Topic.hDC, ax + 1, ay, RColor
If GetPixel(Topic.hDC, ax, ay + 1) = BG Then _
   SetPixel Topic.hDC, ax, ay + 1, RColor
If GetPixel(Topic.hDC, ax + 1, ay + 1) = BG Then _
   SetPixel Topic.hDC, ax + 1, ay + 1, RColor

If GetPixel(Topic.hDC, ax - 1, ay) = BG Then _
   SetPixel Topic.hDC, ax - 1, ay, RColor
If GetPixel(Topic.hDC, ax, ay - 1) = BG Then _
   SetPixel Topic.hDC, ax, ay - 1, RColor
If GetPixel(Topic.hDC, ax - 1, ay - 1) = BG Then _
   SetPixel Topic.hDC, ax - 1, ay - 1, RColor
   
SetPixel Topic.hDC, ax, ay, Main.Shape1.FillColor
End If

Next ay
Next ax

End Function

'### Colorieren #################################################
Public Sub Colit(Typ As PictureBox)
Dim oBild As StdPicture
With Typ

  Set oBild = .Image
  Set .Picture = LoadPicture()
  .BackColor = Colft
  .PaintPicture oBild, 0, 0, , , , , , , vbSrcPaint
  
End With
End Sub

'### Unterfunktionen #############################################
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)
On Error Resume Next

   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

