Simple rotation d'une image

Soyez le premier à donner votre avis sur cette source.

Vue 6 533 fois - Téléchargée 999 fois

Description

Le but ici est donc de faire pivoter une image dans un angle défini.
j'ai pas vraiment cherché sur le site, mais si il y a une autre solution, indiqué moi le lien.

Source / Exemple :


'
'Image Rotation v1.0 - par Nestor

'le but ici est de faire changer l'angle de position d'une image
'on commance par découper l'image en 4
'd'appliqué les nouvelles position
'puis de les regrouper pour en faire qu'une.
'(je pensais pas avoir autant de mal pour si peux)

Private Sub imagerotation(img1 As Control, img2 As Control, ByVal theta!) 'bé oui
  Const Pi = 3.14159265359 'valeur de Pi
  Dim c1x As Integer  'Centre de l'image1 X
  Dim c1y As Integer  'Centre de l'image1 Y
  Dim c2x As Integer  'Centre de l'image2 X
  Dim c2y As Integer  'Centre de l'image2 Y
  Dim a As Single     'Angle pour centrer l'img2
  Dim r As Integer    'Radiant du centre de l'img2
  Dim i1x As Integer  'Position de l'image1 "i1x" X
  Dim i1y As Integer  'Position de l'image1 "i1y" Y
  Dim i2x As Integer  'Position de l'image2 "i2x" X
  Dim i2y As Integer  'Position de l'image2 "i2y" Y
  Dim m As Integer    'Maximum de la hauteur et de la largeur de l'image 2

  'On commance à diviser par 2 en 4 partie (création donc de 4 img à partir d'une)
  c1x = img1.ScaleWidth / 2
  c1y = img1.ScaleHeight / 2
  c2x = img2.ScaleWidth / 2
  c2y = img2.ScaleHeight / 2

  'Création et recomposition de l'image
  '-------------------------------------------------
  m = img2.ScaleWidth
  If m < img2.ScaleHeight Then m = img2.ScaleHeight
  m = m / 2 - 1
  'déplacement
  For i2x = 0 To m
     For i2y = 0 To m
        'calcule des 4 prochainne nouvelles position
        If i2x = 0 Then
          a = Pi / 2
        Else
          a = Atn(i2y / i2x)
        End If
        r = Sqr(1 * i2x * i2x + 1 * i2y * i2y) 'multiplicateur
        
        'préposition
        i1x = r * Cos(a + theta)
        i1y = r * Sin(a + theta)

        'reconstitution de l'image en 4 parties
        c0 = img1.Point(c1x + i1x, c1y + i1y)
        c1 = img1.Point(c1x - i1x, c1y - i1y)
        c2 = img1.Point(c1x + i1y, c1y - i1x)
        c3 = img1.Point(c1x - i1y, c1y + i1x)
        'application et affichage
        If c0 <> -1 Then img2.PSet (c2x + i2x, c2y + i2y), c0
        If c1 <> -1 Then img2.PSet (c2x - i2x, c2y - i2y), c1
        If c2 <> -1 Then img2.PSet (c2x + i2y, c2y - i2x), c2
        If c3 <> -1 Then img2.PSet (c2x - i2y, c2y + i2x), c3
     Next
     'Ajoutez si dessous, "Afficher = DoEvents()" si vous voulez la voir ce recontruire toute seul
     'Afficher = DoEvents()
  Next
End Sub

Private Sub Command1_Click() 'c'est la que tout se joue
    Const Pi = 3.14159265359 'valeur de Pi
    angle = Pi / 6 'Pi et diviZé
    Image2.Cls 'actualise
    Call imagerotation(Image1, Image2, angle) 'affiche l'image terminé
End Sub

Conclusion :


pensez à mon nom si vous réutilisez ce code ;-)

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
2
Date d'inscription
mercredi 29 novembre 2000
Statut
Membre
Dernière intervention
10 décembre 2009

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
Messages postés
28
Date d'inscription
dimanche 27 mars 2005
Statut
Membre
Dernière intervention
27 juillet 2011

J'ai utilisé cette méthode de rotation pour l'implémenter dans une application mais je rencontre un problème lorsque je veux sauvegarder l'image cible ...

L'instruction :
SavePicture Image2.Picture, "Rotation-Test.jpg"

me renvoie une erreur d'execution comme si l'image n'était finalement pas chargée (Image2.Picture = 0 ???)

Quelqu'un aurait une idée ? merci ...
Messages postés
28
Date d'inscription
dimanche 27 mars 2005
Statut
Membre
Dernière intervention
27 juillet 2011

oups ! désolé ... il faut remplacer tous les "INTEGER" par des "LONG" !
Messages postés
28
Date d'inscription
dimanche 27 mars 2005
Statut
Membre
Dernière intervention
27 juillet 2011

même problème de dépassement de capacité ... le code est pas mal mais mal adpaté pour les grandes images !
Messages postés
27
Date d'inscription
samedi 20 avril 2002
Statut
Membre
Dernière intervention
29 décembre 2008

c quoi ce depassement de capacité a cette ligne la ?
r = Sqr(1 * i2x * i2x + 1 * i2y * i2y) 'multiplicateur
comment resoudre ??
pk la rotation ne se fais pas sur elle meme ?
Afficher les 9 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.