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
92
93
94
95
96
97
98
99
100
101
102
103
| 'Déclaration des variables
Private CtrlImg As image 'Image 1
Private CtrlImg2 As image 'Image 2
Private O As ClGdiPlus 'Image Origine
Private P As ClGdiPlus 'Image Provisoire
'Nom du fichier image à charger
Const strFichier = "C:\Users\Tote\Bureau\pClone2.jpg"
'Pour liste image
Const oCarteSource = "CarteSource" 'Image source
Const oCarteRogne = "CarteRogne" 'Image rognée
Const oDecalage = 2 * 567 'Décalage de coordonnées par rapport aux coordonnées souris(Valeur en twips)
'Si 2 est remplacé par 1, alors le zoom sera en fait : X 4
Const oEmprise = 4 * 567 'Taille de l'emprise(Valeur en twips)
Private Sub Form_Load()
'Création de nouvelles images
Set O = New ClGdiPlus
Set P = New ClGdiPlus
'Déclaration des contrôles images
Set CtrlImg = Me.Image1
Set CtrlImg2 = Me.Image2
'Redimensionnement de l'image 2 (pour zoom X 2)
Me.Image2.Width = oEmprise * 2
Me.Image2.Height = oEmprise * 2
'Image 1
'Chargement de l'image source
O.OpenFile strFichier
'Actualisation du contrôle
O.RepaintControl CtrlImg, , , True
'On mémorise l'image source
O.KeepImage
'Image 2
'Création Bitmap de la seconde image (support pour recevoir l'image réalisée)
P.CreateBitmap O.PointsToPixelsX(CtrlImg2.Width), O.PointsToPixelsY(CtrlImg2.Height)
'Couleur de fond de l'image
P.FillColor vbWhite
'Ajout de l'image à la liste d'image
P.ImageListAdd oCarteSource, strFichier
'Mémorise l'image
P.KeepImage
'Actualise le contrôle
P.RepaintControl CtrlImg2
End Sub
'Sur souris déplacée
Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'On teste si la classe est initialisée, sinon on arrête le code
If O Is Nothing Then Exit Sub
Dim xRight As Long
Dim yBottom As Long
Dim xLeft As Long
Dim yTop As Long
'Coordonnées de l'emprise à prendre en compte
'Convertion des coordonnees controle vers les coordonnees image de points(twips) vers Pixels
'Coordonnées supérieures gauche
xLeft = O.CtrlToImgX(X - oDecalage, CtrlImg) 'X gauche
yTop = O.CtrlToImgY(Y - oDecalage, CtrlImg) 'Y supérieur
'Coordonnées inférieures droite
xRight = O.CtrlToImgX(X + oDecalage, CtrlImg) 'X droit
yBottom = O.CtrlToImgY(Y + oDecalage, CtrlImg) 'Y inférieur
'Correction pour que l'emprise souhaitée ne sorte pas du cadre de l'image 1
If xLeft <= 0 Then xLeft = 0: xRight = O.CtrlToImgX(oEmprise, CtrlImg)
If xRight >= O.CtrlToImgX(CtrlImg.Width, CtrlImg) Then xRight = O.CtrlToImgX(CtrlImg.Width, CtrlImg): xLeft = xRight - O.CtrlToImgX(oEmprise, CtrlImg)
If yTop <= 0 Then yTop = 0: yBottom = O.CtrlToImgY(oEmprise, CtrlImg)
If yBottom >= O.CtrlToImgY(CtrlImg.Height, CtrlImg) Then yBottom = O.CtrlToImgY(CtrlImg.Height, CtrlImg): yTop = yBottom - O.CtrlToImgY(oEmprise, CtrlImg)
'Rétabli l'image d'origine (fond bitmap)
P.ResetImage
'Clone l'image source
P.ImageListClone oCarteSource, oCarteRogne
'Rogne la nouvelle image avec l'emprise souhaitée
P.ImageListCrop oCarteRogne, xLeft, yTop, xRight - xLeft, yBottom - yTop
'Dessine la nouvelle image
P.DrawImage oCarteRogne, 0, 0, O.PointsToPixelsX(CtrlImg2.Width), O.PointsToPixelsY(CtrlImg2.Height), , GdipSizeModeStretch
'Supprime l'image rognée de la liste d'image
P.ImageListDel oCarteRogne
'Actualise temporairement le contrôle image 2
P.RepaintControlNoFormRepaint CtrlImg2, , , True
'Rétabli l'image source dans le contrôle image 1 afin de ne pas avoir de trainée du carré rouge
O.ResetImage
'Dessine l'emprise à prendre en compte
O.DrawRectangle xLeft, yTop, xRight, yBottom, , vbRed, 2
'Actualise temporairement le contrôle image 1
O.RepaintControlNoFormRepaint CtrlImg, True
End Sub
Private Sub Form_Close()
' Libération de la classe à la fermeture du formulaire
If Not O Is Nothing Then Set O = Nothing
If Not P Is Nothing Then Set P = Nothing
End Sub |
