Grafica - ruota Un'immagine Dando Effetto Di Diaframma Fotografico

picture # ' Ruota  un'immagine dandogli un effetto di apertura diaframma.
'ci vogliono 2 picture1, picture2 e in picture1 un'immagine
' It's slow, yes.  There's probably a better way, using
' GetDIBits and creating a matrix of bits and rotating them.
' Easier to purchase a control that does it for you, though ;-)
' bmp_rotate(pic1, pic2, theta)
' Rotate the image in a picture box.
'   pic1 is the picture box with the bitmap to rotate
'   pic2 is the picture box to receive the rotated bitmap
'   theta is the angle of rotation
'
Private Sub bmp_rotate(pic1 As Control, pic2 As Control, ByVal theta!)
    Const Pi = 3.14159265359
    Dim c1x As Integer  ' Center of pic1.
    Dim c1y As Integer  '   "
    Dim c2x As Integer  ' Center of pic2.
    Dim c2y As Integer  '   "
    Dim a As Single     ' Angle of c2 to p2.
    Dim r As Integer    ' Radius from c2 to p2.
    Dim p1x As Integer  ' Position on pic1.
    Dim p1y As Integer  '   "
    Dim p2x As Integer  ' Position on pic2.
    Dim p2y As Integer  '   "
    Dim n As Integer    ' Max width or height of pic2.
    ' Compute the centers.
    c1x = pic1.ScaleWidth / 2
    c1y = pic1.ScaleHeight / 2
    c2x = pic2.ScaleWidth / 2
    c2y = pic2.ScaleHeight / 2
    ' Compute the image size.
    n = pic2.ScaleWidth
    If n < pic2.ScaleHeight Then n = pic2.ScaleHeight
    n = n / 2 - 1
    ' For each pixel position on pic2.
    For p2x = 0 To n
        For p2y = 0 To n
            ' Compute polar coordinate of p2.
            If p2x = 0 Then
                a = Pi / 2
            Else
                a = Atn(p2y / p2x)
            End If
            r = Sqr(1& * p2x * p2x + 1& * p2y * p2y)
            ' Compute rotated position of p1.
            p1x = r * Cos(a + theta)
            p1y = r * Sin(a + theta)
            ' Copy pixels, 4 quadrants at once.
            c0& = pic1.Point(c1x + p1x, c1y + p1y)
            c1& = pic1.Point(c1x - p1x, c1y - p1y)
            c2& = pic1.Point(c1x + p1y, c1y - p1x)
            c3& = pic1.Point(c1x - p1y, c1y + p1x)
            If c0& <> -1 Then pic2.PSet (c2x + p2x, c2y + p2y), c0&
            If c1& <> -1 Then pic2.PSet (c2x - p2x, c2y - p2y), c1&
            If c2& <> -1 Then pic2.PSet (c2x + p2y, c2y - p2x), c2&
            If c3& <> -1 Then pic2.PSet (c2x - p2y, c2y + p2x), c3&
        Next
        ' Allow pending Windows messages to be processed.
        t% = DoEvents()
    Next
End Sub

Private Sub Command1_Click()
    Const Pi = 3.14159265359
    
    angle = Pi / 6
    Picture2.Cls
    Call bmp_rotate(Picture1, Picture2, angle)
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    End
End Sub

picture # ' Ruota un'immagine dandogli un effetto di apertura diaframma.
'ci vogliono 2 picture1, picture2 e in picture1 un'immagine

' It's slow, yes. There's probably a better way, using

' GetDIBits and creating a matrix of bits and rotating them.

' Easier to purchase a control that does it for you, though ;-)

' bmp_rotate(pic1, pic2, theta)

' Rotate the image in a picture box.

' pic1 is the picture box with the bitmap to rotate

' pic2 is the picture box to receive the rotated bitmap

' theta is the angle of rotation

'

Private Sub bmp_rotate(pic1 As Control, pic2 As Control, ByVal theta!)
Const Pi = 3.14159265359
Dim c1x As Integer ' Center of pic1.
Dim c1y As Integer ' "
Dim c2x As Integer ' Center of pic2.
Dim c2y As Integer ' "
Dim a As Single ' Angle of c2 to p2.
Dim r As Integer ' Radius from c2 to p2.
Dim p1x As Integer ' Position on pic1.
Dim p1y As Integer ' "
Dim p2x As Integer ' Position on pic2.
Dim p2y As Integer ' "
Dim n As Integer ' Max width or height of pic2.
' Compute the centers.

c1x = pic1.ScaleWidth / 2
c1y = pic1.ScaleHeight / 2
c2x = pic2.ScaleWidth / 2
c2y = pic2.ScaleHeight / 2
' Compute the image size.

n = pic2.ScaleWidth
If n < pic2.ScaleHeight Then n = pic2.ScaleHeight
n = n / 2 - 1
' For each pixel position on pic2.

For p2x = 0 To n
For p2y = 0 To n
' Compute polar coordinate of p2.

If p2x = 0 Then
a = Pi / 2
Else
a = Atn(p2y / p2x)
End If
r = Sqr(1& * p2x * p2x + 1& * p2y * p2y)
' Compute rotated position of p1.

p1x = r * Cos(a + theta)
p1y = r * Sin(a + theta)
' Copy pixels, 4 quadrants at once.

c0& = pic1.Point(c1x + p1x, c1y + p1y)
c1& = pic1.Point(c1x - p1x, c1y - p1y)
c2& = pic1.Point(c1x + p1y, c1y - p1x)
c3& = pic1.Point(c1x - p1y, c1y + p1x)
If c0& <> -1 Then pic2.PSet (c2x + p2x, c2y + p2y), c0&
If c1& <> -1 Then pic2.PSet (c2x - p2x, c2y - p2y), c1&
If c2& <> -1 Then pic2.PSet (c2x + p2y, c2y - p2x), c2&
If c3& <> -1 Then pic2.PSet (c2x - p2y, c2y + p2x), c3&
Next
' Allow pending Windows messages to be processed.

t% = DoEvents()
Next
End Sub

Private Sub Command1_Click()
Const Pi = 3.14159265359

angle = Pi / 6
Picture2.Cls
Call bmp_rotate(Picture1, Picture2, angle)
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
End
End Sub