Discussion :

[marsouin_89]

Bonjour à tous,

Cette question est plus destiné à Thierry, qui est le grand spécialiste de la GdiPlus. Cela dit, toute réponse à mon problème sera la bienvenu.

J'aimerais, à partir d'une image injectée dans un contrôle, en extraire une partie pour la mettre dans un autre contrôle image.
J'ai fouiné dans toutes les bases exemples distribuées par Thierry mais je n'ai rien trouvé qui puisse me guider.
J'imagine qu'il doit y avoir quelque chose comme "ImageListAddRect" mais je n'arrive pas à le mettre en application.
Un petit exemple serait vraiment super.

Cordialement

Christophe

[User]

Salut,

Thierry à l'air pas mal occupé, alors en attendant qu'il réponde à ton problème, je me permet de le faire en espérant ne pas te mettre sur une fausse piste. (J'ai eu l'occasion d'utiliser la classe de gestion d'image clGdiPlus pour des plannings et agendas).

Suppose que tu as une 1ère instance de classe goGdi1 pour gérer l'image du contrôle Me.Image1 et une deuxième instance goGdi2 pour gérer l'image du contrôle Me.Image2 (qui doit recevoir 1 portion de l'image1). Tu peux peut-être utiliser la méthode ImageListAddFromControl de l'objet goGdi2 qui va ajouter une image secondaire à partir de l'image intégrée au contrôle Me.Image1.

Puis afficher une portion de cette image dans le contrôle Me.Image2 avec la méthode DrawImage de l'objet goGdi2.

Code :

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

1
2
3
4
5
lReturn = goGdi2.ImageListAddFromControl("Image1", Me.Image1)
 
goGdi2.DrawImage "Image1", 0, 0, 300, 300 ' Affiche 1 portion de l'image 1 dans le contrôle Me.image2. 
                                                                     '  
goGdi2.RepaintControlNoFormRepaint Me.Image2

A+

[Arkham46]

Thierry à l'air pas mal occupé, alors en attendant qu'il réponde à ton problème, je me permet de le faire en espérant ne pas te mettre sur une fausse piste.

merci Denis de venir à mon secours (et à celui de Christophe...)

en fait il y a plein de possibilités ...

- ImageListAddFromControl est effectivement la solution pour une image "normale" déjà intégrée au contrôle
Mais si cette image a été générée par clGdiplus, il vaut mieux partir de l'image source de l'instance de clGdiplus qui l'a générée

- on peut mettre l'image de côté (KeepImage), la découper (Crop), l'injecter dans le 2è contrôle (RepaintControl), et enfin restaurer l'image d'origine (ResetImage)

- on peut aussi utiliser GetBimap et SetBitmap pour passer l'image d'une instance à une autre : ImageListAddRect pour extraire une portion de l'image, puis ImageListGetBitmap et SetBitmap pour la faire passer dans une autre instance

- on peut aussi trouver d'autres fonctions il y en a plein

il faudrait connaître la source de l'image, et la finalité de l'opération
souhaites-tu juste injecter une portion de l'image dans un contrôle et c'est tout
ou souhaites-tu travailler ensuite sur cette image?

[marsouin_89]

Bonjour,

Un grand merci à vous deux pour tous ces conseils. Vous m'avez surtout enlever le doute sur le fait qu'il me fallait bien 2 instances GdiPlus.
Mon idée était donc la suivante : avoir une loupe au survol de ma souris sur mon image.
J'ai donc fait des recherches sur le Net et rien en VBA. J'ai donc pensé que la GdiPlus serait le meilleur compromis pour réaliser cette idée.

Pour utiliser cet exemple, créer un formulaire avec 2 contrôles images (image1[10 x 15 cm par exemple] et image2 [8 x 8 cm]).

Coller le code suivant dans le formulaire :

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

Il y a, sans aucuns doutes, mieux à faire, mais c'est tout ce que j'ai pu faire avec mes maigres compétences en GdiPlus.
Il m'a fallu quelques jours pour arriver à cela, alors s'il y a mieux, je prends avec grand plaisirs.

Encore merci

Cordialement

Christophe

[Arkham46]

bjr,

ça bug un peu chez moi pour les bornes droites et basses du cadre
- il faut vérifier la limite max en comparant avec la taille de l'image, pas du contrôle (en fonction du rapport largeur/hauteur de l'image ça ne marche pas toujours sinon)
- pour une dimension, mettre le 3è paramètres de CtrlToImgX à False (pour ne pas tenir compte du décalage de l'image dans le contrôle du au mode zoom)

Code :

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

1
2
3
4
5
6
 
'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, False)
If xRight >= O.ImageWidth - 1 Then xRight = O.ImageWidth - 1: xLeft = xRight - O.CtrlToImgX(oEmprise, CtrlImg, False)
If yTop <= 0 Then yTop = 0: yBottom = O.CtrlToImgY(oEmprise, CtrlImg, False)
If yBottom >= O.ImageHeight - 1 Then yBottom = O.ImageHeight - 1: yTop = yBottom - O.CtrlToImgY(oEmprise, CtrlImg, False)

[marsouin_89]

Bonjour Thierry,

Merci beaucoup pour ces précisions.
Vu, le peu de critiques que tu as fais sur ce code, je me dis que je ne m'en suis pas trop mal tiré.

Il est content Rosco

Cordialement

Christophe