Public Sub ModFilter(oDIBSrc As PictureBox, oDIBDst As PictureBox, _
                       Optional x1 As Long = -1, Optional y1 As Long = -1, _
                       Optional x2 As Long = -1, Optional y2 As Long = -1, _
                       Optional xtg As Long = 0, Optional ytg As Long = 0, _
                       Optional cRad As Integer = 8)
 
  Dim intDrawMode As Integer
  Dim lngReadColor As Long
  Dim lngWriteColor As Long
  Dim X As Single
  Dim Y As Single, i%, j%
  Dim Zn!, n As Double
 
  On Error GoTo ErrorHandler
 
  If (x1 = -1) And (y1 = -1) And (x2 = -1) And (y2 = -1) Then Exit Sub
 
        Dim xMid As Single, yMid As Single
        If x1 < x2 Then
           xMid = x1 + ((x2 - x1) / 2)
        Else
           xMid = x2 + ((x1 - x2) / 2)
        End If
        If y1 < y2 Then
           yMid = y1 + ((y2 - y1) / 2)
        Else
           yMid = y2 + ((y1 - y2) / 2)
        End If
 
        i = 0
        ' >>>>>>>>>> Mit 0 To 180 funktioniert es einigermaßen auf der Y-Achse und
                   'mit 90 To 270 auf der X-Ache. Wie kann man das verbinden,
                   'damit beides gleichzeitig funktioniert?
        Zn = 180 / (cRad * 2)
        If Zn < 1 Then Zn = 1
        Text1.Text = "Zn: " & Zn
        For n = 0 To 180 Step Zn
           P(i).X = Val(Cos(DegToRad(n)) * xtg)
           P(i).Y = Val(Sin(DegToRad(n)) * ytg)
           i = i + 1
        Next n
 
        i = 0
        j = 0
 
        For X = x1 To x2
          For Y = y1 To y2
            If Radius(xMid, yMid, X, Y) < cRad Then 'Für Rundung
 
                '>>>>> Hier nun mein neuer Ansatz. Funktioniert 
                ' aber leider noch nicht
                       'so, wie ich es mir gedacht habe:
               lngReadColor = GetPixel(oDIBDst.hDC, X - P(i).X, Y - P(j).Y)
 
         '      lngReadColor = GetPixel(oDIBDst.hDC, X - xtg, Y - ytg)
 
               lngWriteColor = RGB(Abs(R(lngReadColor)), _
                                   Abs(G(lngReadColor)), _
                                   Abs(b(lngReadColor)))
               SetPixel oDIBSrc.hDC, X, Y, lngWriteColor
            End If
             i = i + 1
          Next
          i = 0
          j = j + 1
        Next
 
  Exit SubErrorHandler:
  Exit Sub
End Sub

Private Sub ImageFilter(Optional X As Long = -1, Optional Y As Long = -1)
  On Error GoTo ErrorHandler
 
  Dim Pic As PictureBox
  Dim x1 As Long
  Dim y1 As Long
  Dim x2 As Long
  Dim y2 As Long
  Dim X5 As Long
  Dim Y5 As Long
  Dim intDrop As Integer
 
  intDrop = 40
  If ((X <> -1) Or (Y <> -1)) Then
    x1 = X - intDrop
    y1 = Y - intDrop
    x2 = X + intDrop
    y2 = Y + intDrop
    X5 = (X - ModelX) '/ 5
    Y5 = (Y - ModelY) '/ 5
 
    If (x2 >= 0) And (y2 >= 0) Then
          ModFilter Picture1, Picture2, _
                     x1, y1, x2, y2, X5, Y5, intDrop
    End If
  End If
  Exit Sub
 
ErrorHandler:
  Exit Sub
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, _
                                              X As Single, Y As Single)
         ModelX = X
         ModelY = Y
         Call ImageFilter(CLng(X), CLng(Y))
         Picture1.Refresh
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, _
                                                  X As Single, Y As Single)
  If Button = 1 Then
   Call ImageFilter(CLng(X), CLng(Y))
   Picture1.Refresh
  End If
  Shape1.Left = X - 40: Shape1.Top = Y - 40
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, _
                                               X As Single, Y As Single)
    Picture2.Cls
    BitBlt Picture2.hDC, 0, 0, Picture1.Width, Picture1.Height, _
                                            Picture1.hDC, 0, 0, vbSrcCopy
End Sub

Gruß
Fieber
http://computer.net-berlin.de - Visual Basic - Tips & Tricks sowie viel Grafik