[RESOLVED]Rotating image

[Andrew G]

This is not mine, i found it somewhere but i can't remember

Option Explicit
Const SRCCOPY = &HCC0020
Const Pi = 3.14159265359
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 Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
' Add three command buttons and two pictureboxes.
'Load a bitmap into picture1 in design mode.
'Set both box to the same size.
'Routines execute 3 times faster than routines found in Microsoft's Knowledge Base.
Dim x!
Sub Form_Load()
    Picture1.ScaleMode = 3
    Picture2.ScaleMode = 3
    x! = 0.1
End Sub
 
Sub Command1_Click()
    Dim px%
    Dim py%
    Dim retval%
    'flip horizontal
    Picture2.Cls
    px% = Picture1.ScaleWidth
    py% = Picture1.ScaleHeight
    retval% = StretchBlt(Picture2.hdc, px%, 0, -px%, py%, Picture1.hdc, 0, 0, px%, py%, SRCCOPY)
End Sub
 
Sub Command2_Click()
    Dim px%
    Dim py%
    Dim retval%
    'flip vertical
    Picture2.Cls
    px% = Picture1.ScaleWidth
    py% = Picture1.ScaleHeight
    retval% = StretchBlt(Picture2.hdc, 0, py%, px%, -py%, Picture1.hdc, 0, 0, px%, py%, SRCCOPY)
End Sub
 
Sub Command3_Click()
    Dim y!
    Dim s$
    
    s$ = Text1.Text
    y! = Val(Replace(s$, ",", ".")) * Pi / 180
    'rotate 45 degrees
    Picture2.Cls
    Call bmp_rotate(Picture1, Picture2, y!)
End Sub
Sub bmp_rotate(pic1 As PictureBox, pic2 As PictureBox, ByVal theta!)
  ' 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
  Dim c1x As Integer, c1y As Integer
  Dim c2x As Integer, c2y As Integer
  Dim a As Single
  Dim p1x As Integer, p1y As Integer
  Dim p2x As Integer, p2y As Integer
  Dim n As Integer, r   As Integer
  Dim pic1hdc&
  Dim pic2hdc&
  Dim c0&
  Dim c1&
  Dim c2&
  Dim c3&
  Dim xret&
  Dim t%
  
  c1x = pic1.ScaleWidth \ 2
  c1y = pic1.ScaleHeight \ 2
  c2x = pic2.ScaleWidth \ 2
  c2y = pic2.ScaleHeight \ 2
  If c2x < c2y Then n = c2y Else n = c2x
  n = n - 1
  pic1hdc& = pic1.hdc
  pic2hdc& = pic2.hdc
  
        For p2x = 0 To n
            For p2y = 0 To n
                If p2x = 0 Then a = Pi / 2 Else a = Atn(p2y / p2x)
                r = Sqr(1& * p2x * p2x + 1& * p2y * p2y)
                p1x = r * Cos(a + theta!)
                p1y = r * Sin(a + theta!)
                c0& = GetPixel(pic1hdc&, c1x + p1x, c1y + p1y)
                c1& = GetPixel(pic1hdc&, c1x - p1x, c1y - p1y)
                c2& = GetPixel(pic1hdc&, c1x + p1y, c1y - p1x)
                c3& = GetPixel(pic1hdc&, c1x - p1y, c1y + p1x)
                If c0& <> -1 Then xret& = SetPixel(pic2hdc&, c2x + p2x, c2y + p2y, c0&)
                If c1& <> -1 Then xret& = SetPixel(pic2hdc&, c2x - p2x, c2y - p2y, c1&)
                If c2& <> -1 Then xret& = SetPixel(pic2hdc&, c2x + p2y, c2y - p2x, c2&)
                If c3& <> -1 Then xret& = SetPixel(pic2hdc&, c2x - p2y, c2y + p2x, c3&)
        Next
        t% = DoEvents()
   Next
End Sub