SIMPLE ROTATION D'UNE IMAGE

Commentaire de djinncube le 10/12/2009 01:33:19

c'est assez honteux de demander a mettre son nom en conclusion d'un code pris sur le site de microsoft :
http://support.microsoft.com/kb/80406
"'(je pensais pas avoir autant de mal pour si peux) " Mouais

Original :


  ' Example of how to call bmp_rotate.
     Sub Command1_Click ()
         Const Pi = 3.14159265359

         For angle = Pi / 6 To 2 * Pi Step Pi / 6
            picture2.Cls
            Call bmp_rotate(picture1, picture2, angle)
         Next
     End Sub



' 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
     '

     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