[AC-2000] Classe Gdi+ - zoom/déplacement sur image [Résolu]

[fbtsra]

Bonjour,

J'ai repris l'exemple "FScrollBars" de la "base exemples_gdiplus.mdb" et l'ai adapté pour ne travailler que sur une seule photo qui est recherchée directement sur le disque cf code ci-après.

Le traitement est cependant lent (photos de 3 à 4 Mo) si on ne redimensionne pas l'image en mémoire en amont, ce qui dégrade la qualité du zoom.

Je vous remercie par avance de toute idée permettant d'accélérer le traitement sans dégrader la qualité du zoom.

Bcdt
Florian

Code :

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
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
Option Compare Database
Option Explicit
 
Private ogdi As ClGdiPlus
' Barres de défilement
Private WithEvents oBars1 As ClGdiPlus
Private WithEvents oBars2 As ClGdiPlus
' Facteur de zoom
Private gZoom As Single
 
Private Sub btnZoomDown_Click()
If gZoom > 0.5 Then
Me.txtZoom2.Value = gZoom - 0.5
txtZoom2_AfterUpdate
End If
End Sub
 
Private Sub btnZoomUp_Click()
Me.txtZoom2.Value = gZoom + 0.5
txtZoom2_AfterUpdate
End Sub
 
Private Sub Form_Load()
Dim lData() As Byte
 
Me.txtZoom2.Value = 1
gZoom = 1
 
Set ogdi = New ClGdiPlus
Set oBars1 = New ClGdiPlus
Set oBars2 = New ClGdiPlus
 
'Chemin sur le disque
ogdi.OpenFile "...chemin disque de la photo ..."
 
'Redimensionnement très impactant sur la qualité du zoom
ogdi.Resize ogdi.PointsToPixelsX(30000), , True
 
'Compression de l'image mais semble avoir peu d'impact sur la rapidité
ogdi.GetImageArray lData, "JPG", 40
ogdi.SetImageArray lData
 
 
ogdi.ImageListAddFromArray "fond2", lData
 
oBars2.BarInitialize Me.Image0, ogdi
 
oBars2.BarScaleX ogdi.ImageWidth("fond2") / 1, 1, 1, 1018
oBars2.BarScaleY ogdi.ImageHeight("fond2") / 1, 1, 1, 716
 
DrawImage
 
ogdi.RepaintControl Me.Image0
 
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
' Libère les objets
oBars1.BarRelease
Set oBars1 = Nothing
oBars2.BarRelease
Set oBars2 = Nothing
End Sub
 
 
' Dessine les images lorsqu'une barre de progression le demande
Private Sub oBars1_BarOnRefreshNeeded()
DrawImage
ogdi.RepaintControlNoFormRepaint Me.Image0
End Sub
Private Sub oBars2_BarOnRefreshNeeded()
DrawImage
ogdi.RepaintControlNoFormRepaint Me.Image0
End Sub
 
Private Sub DrawImage()
' Remplit l'image de blanc
ogdi.FillColor vbWhite
 
ogdi.WorldPush
ogdi.WorldScale gZoom, gZoom
ogdi.WorldTranslate oBars2.BarLeft + oBars2.BarStartX, oBars2.BarTop + oBars2.BarStartY, True
ogdi.DrawImage "fond2", 0, 0, , , , GdipSizeModeClip, GdipAlignTopLeft
ogdi.WorldPop
ogdi.DrawClipRegion = ""
 
oBars2.BarDraw
 
End Sub
 
Private Sub txtZoom2_AfterUpdate()
Dim lOldZoom As Single
lOldZoom = gZoom
gZoom = Nz(txtZoom2.Value, 1)
If gZoom = 0 Then gZoom = 1
' Initialise chaque barre
oBars2.BarScaleX ogdi.ImageWidth * gZoom / 1, 1, 1, 1018
oBars2.BarScaleY ogdi.ImageHeight * gZoom / 1, 1, 1, 716
oBars2.BarStartX = -((-oBars2.BarStartX + oBars2.BarInsideWidth / 2) / lOldZoom * gZoom - oBars2.BarInsideWidth / 2)
oBars2.BarStartY = -((-oBars2.BarStartY + oBars2.BarInsideHeight / 2) / lOldZoom * gZoom - oBars2.BarInsideHeight / 2)
DrawImage
ogdi.RepaintControlNoFormRepaint Me.Image0
End Sub
 
 
Private Sub Commande0_Click()
On Error GoTo Err_Commande0_Click
 
 
DoCmd.Close
 
Exit_Commande0_Click:
Exit Sub
 
Err_Commande0_Click:
MsgBox Err.Description
Resume Exit_Commande0_Click
 
End Sub

[fbtsra]

Bonjour,

Je relance le sujet joint à destination de tous, et en particulier d'Arkham46 ...

Merci d'avance de votre aide,

Bcdt

[Arkham46]

bjr,

Il est vrai que c'est un peu compliqué ces barres de défilement...

En fait le gros problème c'est que ton image principale (celle qui est injectée dans le contrôle) est trop grande vu que c'est l'image du disque de plusieurs Mo (on n'en voit qu'une partie si le contrôle est en mode découpage mais elle est bien plus grande).
L'image principale est celle qui sera visible dans le contrôle, il est inutile ici qu'elle soit plus grande que le contrôle.
Le traitement en mémoire d'une image de taille importante est relativement rapide.
Par contre l'image qui est injectée dans le contrôle doit être de taille raisonnable sinon Access est très lent (il y a des conversions de format).

Il faut :
- créer une image principale de la taille du contrôle (CreateBitmapForImage)
- charger l'image du disque en mémoire (ImageListAdd, image secondaire "fond2")
- dessiner l'image secondaire "fond2" sur l'image principale (DrawImage en appliquant les transformations de défilement et de zoom)
- dessiner les barres de défilement (DrawBars)
- injecter l'image principale dans le contrôle (Repaint...)

Une idée de code :

Code :

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
 
Option Explicit
 
Private ogdi As ClGdiPlus
' Barres de défilement
Private WithEvents oBars As ClGdiPlus
' Facteur de zoom
Private gZoom As Single
 
Private Sub btnZoomDown_Click()
If gZoom > 0.5 Then
Me.txtZoom2.Value = gZoom - 0.5
txtZoom2_AfterUpdate
End If
End Sub
 
Private Sub btnZoomUp_Click()
Me.txtZoom2.Value = gZoom + 0.5
txtZoom2_AfterUpdate
End Sub
 
Private Sub Form_Load()
 
Me.txtZoom2.Value = 1
gZoom = 1
 
Set ogdi = New ClGdiPlus
Set oBars = New ClGdiPlus
' Image de la taille du contrôle
ogdi.CreateBitmapForImage Me.Image0
' Image à dessiner
ogdi.ImageListAdd "fond2", ThisWorkbook.Path & "\img.jpg"
' Initialisation des barres de défilement
oBars.BarInitialize Me.Image0, ogdi
oBars.BarScaleX ogdi.ImageWidth("fond2") / 1, 1, 1, ogdi.ImageWidth
oBars.BarScaleY ogdi.ImageHeight("fond2") / 1, 1, 1, ogdi.ImageHeight
' Dessin de l'image
DrawImage
ogdi.RepaintControl Me.Image0
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
' Libère les objets
oBars.BarRelease
Set oBars = Nothing
End Sub
 
' Dessine les images lorsqu'une barre de progression le demande
Private Sub oBars_BarOnRefreshNeeded()
DrawImage
ogdi.RepaintControlNoFormRepaint Me.Image0
End Sub
 
Private Sub DrawImage()
' Remplit l'image de blanc
ogdi.FillColor vbWhite
' Applique une transformation pour décaler l'image en fonction des barres de défilement
ogdi.WorldPush
ogdi.WorldScale gZoom, gZoom
ogdi.WorldTranslate oBars.BarLeft + oBars.BarStartX, oBars.BarTop + oBars.BarStartY, True
' Dessine l'image
ogdi.DrawImage "fond2", 0, 0, , , , GdipSizeModeClip, GdipAlignTopLeft
' Réinitialise les transformations
ogdi.WorldPop
' Dessine les barres
oBars.BarDraw
End Sub
 
' Sur modif du Zoom
Private Sub txtZoom2_AfterUpdate()
Dim lOldZoom As Single
lOldZoom = gZoom
gZoom = txtZoom2.Value
If gZoom = 0 Then gZoom = 1
' Réinitialise les barres de défilement en fonction du zoom
' Plus l'image est zoomée, plus la taille à faire défiler est grande
oBars.BarScaleX ogdi.ImageWidth("fond2") * gZoom, 1, 1, ogdi.ImageWidth
oBars.BarScaleY ogdi.ImageHeight("fond2") * gZoom, 1, 1, ogdi.ImageHeight
' Repositionne les barres pour garder la position après zoom
oBars.BarStartX = -((-oBars.BarStartX + oBars.BarInsideWidth / 2) / lOldZoom * gZoom - oBars.BarInsideWidth / 2)
oBars.BarStartY = -((-oBars.BarStartY + oBars.BarInsideHeight / 2) / lOldZoom * gZoom - oBars.BarInsideHeight / 2)
' Dessine l'image
DrawImage
ogdi.RepaintControlNoFormRepaint Me.Image0
End Sub
 
Private Sub Commande0_Click()
On Error GoTo Err_Commande0_Click
 
 
DoCmd.Close
 
Exit_Commande0_Click:
Exit Sub
 
Err_Commande0_Click:
MsgBox Err.description
Resume Exit_Commande0_Click
 
End Sub

[fbtsra]

Bonjour Arkham46,

Je te remercie de ta réponse rapide.

Je te tiendrai informé des suites (au mieux début septembre).

Merci encore de ton aide.

Bien amicalement,
Florian

[fbtsra]

Bonjour Arkham46,

Chose promise, chose due ...

J'ai pu tester ta proposition de code qui fonctionne parfaitement et surtout accélère de façon effective le traitement de l'image, le rendant suffisamment rapide pour être fonctionnel.

Je te remercie une nouvelle fois de ton aide.

Bien amicalement,
Florian