Discussion :

[ProgElecT]

Bien sur j'ai essayé de trouver des infos sur le site, mais je n'ai pas trouvé d'éléments convaincants.

Voila, j'ai ecrit un bout de programme, mais le resultat n'est pas des plus jolie, surtout sur des images géometriques,
les droites particuliairement et les bords d'origines sont achurés.
Sur les images de portraits ou de paysages, on pourrait s'en contanter.

Charger le composant CommonDialog, le placer sur une Form ainsi que 3 PictureBox et 2 Command Button
et y placer le code suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
Option Explicit

'equivalance plus rapide pour dessiner un pixel de couleur
Private Declare Function SetPixel Lib "gdi32" ( _
    ByVal hdc As Long, _
    ByVal X As Long, _
    ByVal Y As Long, _
    ByVal crColor As Long) As Long
'equivalance plus rapide pour lire la couleur d'un pixel
Private Declare Function GetPixel Lib "gdi32" ( _
    ByVal hdc As Long, _
    ByVal X As Long, _
    ByVal Y As Long) As Long

Dim SrcL, SrcH As Long
Dim DesL, DesH As Long
Dim CmptL, CmptH As Long
Dim DecalL As Long
Dim PdestH, PdestL As Long
Dim CouleuR As Long

Private Sub Form_Load()
Me.ScaleMode = 3
Me.Height = 795: Me.Width = 3000
Me.Caption = "Rotation 45°"
PictScr.ScaleMode = 3: PictDesT1.ScaleMode = 3: PictFini.ScaleMode = 3
PictScr.AutoRedraw = True: PictDesT1.AutoRedraw = True: PictFini.AutoRedraw = True
PictScr.BorderStyle = 0: PictDesT1.BorderStyle = 0: PictFini.BorderStyle = 0
PictScr.AutoSize = True
PictFini.Left = 2: PictFini.Top = 28
PictDesT1.Left = PictFini.Left: PictDesT1.Top = PictFini.Top
Command1.Top = 4: Command1.Left = 84
Command1.Height = 21: Command1.Width = 101
Command1.Enabled = False: Command1.Caption = "Bascule Image"
Command2.Top = 4: Command2.Left = 2
Command2.Height = 21: Command2.Width = 79
Command2.Caption = "ouvrir"
End Sub

Private Sub Command1_Click()
'bascule entre l'image intermediaire et l'image fini
PictDesT1.Visible = Not PictDesT1.Visible
PictFini.Visible = Not PictDesT1.Visible
End Sub
Private Sub Command2_Click()
CommonDialog1.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly
CommonDialog1.Flags = CommonDialog1.Flags + cdlOFNPathMustExist + cdlOFNExplorer
CommonDialog1.CancelError = True
On Error Resume Next
CommonDialog1.ShowOpen
If Err.Number <> 0 Then On Error GoTo 0: Exit Sub
Command1.Enabled = False
PictScr.Cls: PictScr.Picture = LoadPicture(CommonDialog1.FileName)
Rota45
DoEvents
Me.Height = ScaleY(PictDesT1.Top + PictDesT1.Height + 28, 3, 1)
Me.Width = ScaleX(PictDesT1.Left + PictDesT1.Width + 9, 3, 1)
PictFini.Visible = True: Command1.Enabled = True
End Sub

Public Sub Rota45()
PictDesT1.Visible = False: PictFini.Visible = False

SrcH = PictScr.Height: SrcL = PictScr.Width
DesL = (SrcH + SrcL) - 1: DesH = DesL: DecalL = SrcH - 1
PictDesT1.Width = DesL: PictDesT1.Height = DesH: PictDesT1.Cls

CmptH = -1
Do While CmptH < (SrcH - 1) ' boucle de decalage sur la hauteur source
 CmptH = CmptH + 1: CmptL = -1
 Do While CmptL < (SrcL - 1) ' boucle de decalage sur la largeur source
  CmptL = CmptL + 1
  CouleuR = GetPixel(PictScr.hdc, CmptL, CmptH) 'couleur recuperée dans la source
  PdestL = (DecalL + CmptL) - CmptH
  PdestH = CmptH + CmptL
  SetPixel PictDesT1.hdc, PdestL, PdestH, CouleuR
  'astuce non convaincante mais !!!..
  SetPixel PictDesT1.hdc, PdestL, PdestH + 1, CouleuR '?
  'ou astuce pas plus convaincante mais !!!..
  'SetPixel PictDesT1.hdc, PdestL - 1, PdestH, CouleuR '?
  DoEvents
 Loop
 DoEvents
Loop
'mise a l'echelle
SrcH = DesH: SrcL = DesL
DesH = CInt(Sqr((PictScr.Height * PictScr.Height) + (PictScr.Width * PictScr.Width)))
DesH = DesH: DesL = DesH
PictFini.Height = DesH: PictFini.Width = DesL
PictFini.PaintPicture PictDesT1.Image, 0, 0, DesL, DesH, 0, 0, SrcL, SrcH
End Sub

Je suis preneur de toutes sujestions pour améliorer le resultat.

Salut
ProgElecT

[jmfmarques]

Bonjour, progelect,

Voilà comment je fais, si celà peut t'aider :

[ProgElecT]

salut jmfmarques

Le probleme est que je ne parvient pas à utiliser certaint liens, depuis plusieurs semaines maintenant, j'ai du changer un parametres de mon antivirus, mais je n'ai pas encor réussi a resoudre le probleme

[jmfmarques]

Que veux-tu dire ?
Que tu n'arrives pas à télécharger mon zip ?

[ProgElecT]

j'ai reussi en copiant le racourci, je regarde et te tient au courant, peut être pas ce soir (matin !!), je fesai un dernier tour sur le forum

[ProgElecT]

j'ai vue ta solution, beaucoup plus complette que mon bidule,
le probleme semble donc insurmontable pour les lignes droites

Salut, je reste une petite minute, puis je vai quitter pour ce soir

[jmfmarques]

Il est vrai que la rotation d'une ligne droite ne sera pas toujours parfaite ...
Même CorelPaint n'y parvient pas. Il est d'ailleurs impossible, carrément, de dessiner directement une ligne parfaitement droite (dents de scie). Celà est principalement lié à la résolution de l'image...
Mais même une résolution très haute ne mettrait pas à l'abri de ces "dents de scie", décelables avec une loupe... Seul l'aspect visuel est amélioré, avec de grandes résolutions.

Bonne nuit