Discussion :

[Souleyre]

Bonjour,
J'ai une image de dimension 10000x10000 que je dois partager en 25 images de dimension 2000x2000.
J'ai essayé plusieurs méthodes notemment celle du BitBlt mais aucune ne fonctionne vraiment.
J'aimerais tenter de travailler directement sur le fichier source jpg (ou tif ou bmp) mais je suis un peu léger quant au traitement numérique des images.
Si quelqu'un pouvait me fournir une piste...
Souleyre

[l_autodidacte]

Bonsoir;

Tu peux charger l'image dans un PictureBox, créer autant de contrôles PictureBox que nécessaire(Pic1,Pic2 .... ou utilise des contôles indexés qui est meilleur dans ce cas)et utiliser la méthode PaintPicture sur chacun des contrôles PictureBox ajoutés en prenant soin de découper à la position voulue(nouvel endroit de découpage = fin du découpage précédent).

[Souleyre]

Mreci pour ta réponse Moncef.
Ta solution est effectivement intéressante mais je cherche toujours une réponse purement numérique à ce problème.

[l_autodidacte]

Salut;

Au cas où tu serais tenté par ma proposition, le fichier zip contient un exemple

[Souleyre]

Ta méthode est vraiment excellente.
Je pense que je vais m'y rallier.
Encore merci pour ton aide, Moncef.

[ProgElecT]

Salut

Bien que résolu, et que l_autodidacte ai donnée une solution fonctionnel, je me permet de fournir un code qui traite tout sans passer par un PictureBox et donc sans l‘emploi de PainPicture.

L’utilisation de la DLL GDIplus.
Une récupération dans 3 programmes différents (puzzle, capture d’écran, sauvegarde/conversion type d’image).
Mes essais on portés sur une image de 3000x2000 pixels en 300dpi, la rapidité du résultat est quasi instantanée.
Dés lundi je vais faire de nouveaux essais depuis le travail, ou nous traitons des images de plusieurs Giga octets.

Sur un Form, un CommandButton et ce

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
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
Option Explicit
 
'*********************** Déclarations GDIplus.DLL  ****************************************
'-- partie utile pour la sauvegarde des images utilisées par GDI+ et ole32 --
'utilisé par GDI+ et ole32
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type
'-------------- utilisé par GDI+ ------------------
Private Type EncoderParameter
    GUID As GUID
    NumberOfValues As Long
    Type As Long
    Value As Long
End Type
Private Type EncoderParameters
    Count As Long
    Parameter(15) As EncoderParameter
End Type
Private Declare Function GdipSaveImageToFile Lib "gdiplus" ( _
    ByVal image As Long, ByVal filename As Long, clsidEncoder As GUID, _
    encoderParams As Any) As Long
'utile pour GDI+
Private Declare Function CLSIDFromString Lib "ole32" (ByVal str As Long, id As GUID) As Long
Private Declare Function GdipCloneBitmapAreaI Lib "gdiplus" _
    (ByVal x As Long, ByVal y As Long, ByVal Width As Long, ByVal Height As Long, _
    ByVal PixelFormat As Long, ByVal srcBitmap As Long, dstBitmap As Long) As GpStatus
Private Declare Function GdipGetImagePixelFormat Lib "gdiplus" _
    (ByVal image As Long, PixelFormat As Long) As GpStatus
 
Private Type GdiplusStartupInput
    GdiplusVersion As Long
    DebugEventCallback As Long
    SuppressBackgroundThread As Long
    SuppressExternalCodecs  As Long
End Type
Private Enum GpStatus
    Gp_Ok = 0
    Gp_GenericError = 1
    Gp_InvalidParameter = 2
    Gp_OutOfMemory = 3
    Gp_ObjectBusy = 4
    Gp_InsufficientBuffer = 5
    Gp_NotImplemented = 6
    Gp_Win32Error = 7
    Gp_WrongState = 8
    Gp_Aborted = 9
    Gp_FileNotFound = 10
    Gp_ValueOverflow = 11
    Gp_AccessDenied = 12
    Gp_UnknownImageFormat = 13
    Gp_FontFamilyNotFound = 14
    Gp_FontStyleNotFound = 15
    Gp_NotTrueTypeFont = 16
    Gp_UnsupportedGdiplusVersion = 17
    Gp_GdiplusNotInitialized = 18
    Gp_PropertyNotFound = 19
    Gp_PropertyNotSupported = 20
End Enum
 
'---------------- pour vérification disponibilité de GDI+ -----------
Private Declare Function GdiplusStartup Lib "gdiplus" _
    (ByRef token As Long, inputbuf As GdiplusStartupInput, _
    Optional ByVal outputbuf As Long = 0) As GpStatus
Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal token As Long)
Dim ParamS As GdiplusStartupInput
Dim GDISessP As Long 'conteneur du lien en mémoire pour la session d'utilisation GDI+
 
'---------------- gestion/manipulation de l'image GDI+ -----------
'création d'un Bitmap Gdi+ en mémoire, à partir d'un fichier
Private Declare Function GdipCreateBitmapFromFile Lib "gdiplus" _
    (ByVal filename As Long, ByRef Bitmap As Long) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" _
    (ByVal image As Long) As Long
 
Private Declare Function GdipGetImageDimension Lib "gdiplus" _
    (ByVal image As Long, ByRef Width As Single, ByRef Height As Single) As Long
 
Dim ImgSource As Long 'conteneur du Bitmap Gdi+ qui vat être fractionné
Dim ImgDest As Long 'conteneur d'une fraction du Bitmap source
 
Private Sub Form_Initialize()
'********* Indispensable IMPERATIF ***************
ParamS.GdiplusVersion = 1
If GdiplusStartup(GDISessP, ParamS) <> 0 Then
 MsgBox "Impossible d'initialiser GDIplus.DLL", vbInformation
 End
End If
'*************************************************
ImgSource = 0: ImgDest = 0
End Sub
Private Sub Form_Terminate()
'************* Indispensable IMPERATIF *******************************
'précaution nettoyage, surtout durant le debug
If ImgSource <> 0 Then GdipDisposeImage ImgSource
If ImgDest <> 0 Then GdipDisposeImage ImgDest
GdiplusShutdown GDISessP ' Ferme/supprime le lien d'utilisation de Gdi+
'**********************************************************************
End Sub
 
 
'---------------------------------------------------------------------------------------
' Ouverture du fichier image
'---------------------------------------------------------------------------------------
Public Function OpenFile(ChemFich As String, ConteneurImg As Long) As Boolean
'ConteneurImg étant conservé (en mémoire) après chaque ouverture d'un fichier
'il ne sera pas égal à 0 au passage suivant, donc il faudra libérer le lien en mémoire, car
'à chaque appel, le pointeur mémoire change, si on ne le libère pas
'un pointeur fantôme engendrera une erreur irrécupérable et plantera le programme
If ConteneurImg <> 0 Then GdipDisposeImage ConteneurImg 'libère la mémoire
' Création d'un Bitmap Gdi+ à partir du fichier, si l'opération a réussi,
'renvoie 0, donc OpenFile = True, sinon renvoie un N° d'erreur donc False
OpenFile = (GdipCreateBitmapFromFile(StrPtr(ChemFich), ConteneurImg) = 0)
End Function
Private Sub Command1_Click()
Dim FormatPixel As Long 'récupération du format
 
Dim ChemNomImgSource As String 'Chemin et nom du fichier image devant être fractionné
Dim WSrcP As Single, HSrcP As Single, LSrcP As Single, TSrcP As Single ' largeur, hauteur, left et top du source
 
Dim NameImgSauve As String 'conteneur nom du fichier image fractionné (sans son extention)
Dim Nimg As Integer 'pour ajouté au nom du fichier image fractionné
Dim WDstP As Single, HDstP As Single, LDstP As Single, TDstP As Single  ' largeur, hauteur, left et top pour la destination
 
Dim Lgn As Integer, Cln As Integer 'pour choisir le nombre de lignes et de colonnes de fractionnement
Lgn = 5: Cln = 5 'minimum 1x1
 
Dim T As Integer, U As Integer 'pour les boucles For ..... Next
 
ChemNomImgSource = "C:\PersoFrancis\DernierFond.bmp" '******** ATTENTION ****** vous devez indiquer ici votre propre fichier *********************
NameImgSauve = "Fraction"
Nimg = 0
Me.Caption = "Fractionnement en cours ........."
If OpenFile(ChemNomImgSource, ImgSource) = True Then 'ouverture du fichier source
    GdipGetImageDimension ImgSource, WSrcP, HSrcP 'récupération des dimensions de l'image du fichier source
    If GdipGetImagePixelFormat(ImgSource, FormatPixel) = Gp_Ok Then
        WDstP = Int(WSrcP / Cln) 'dimension du fractionnement en largeur
        HDstP = Int(HSrcP / Lgn) 'dimension du fractionnement en hauteur
        For T = 0 To Lgn - 1
            For U = 0 To Cln - 1
                If GdipCloneBitmapAreaI((WDstP * U), (HDstP * T), WDstP, HDstP, FormatPixel, ImgSource, ImgDest) = Gp_Ok Then
                    If SaveFileImage(App.Path & "\" & NameImgSauve & CStr(Nimg) & ".JPG", ImgDest, "JPG", 100) = True Then
                        GdipDisposeImage ImgDest 'libération explicite de l'espace mémoire
                        DoEvents
                        Nimg = Nimg + 1
                        Else
                        Me.Caption = "PAS  OK"
                        Exit For
                    End If
                End If
            Next U
            If Me.Caption <> "Fractionnement en cours ........." Then Exit For
        Next T
    End If
    GdipDisposeImage ImgSource 'libération explicite de l'espace mémoire
End If
If Nimg = Lgn * Cln Then
 MsgBox "Fractionnement Ok"
 Else
 MsgBox "Pas Ok"
End If
End Sub
 
Public Function SaveFileImage(pFile As String, HandlImag As Long, Optional pFormat As String = "JPG", Optional ByVal pQuality As Integer = -1) As Boolean
Dim lEncoder As GUID
Dim lParams As EncoderParameters
Dim lEncoderStr As String
Const lBmpEncoderStr As String = "{557cf400-1a04-11d3-9a73-0000f81ef32e}" 'Sauvegarde BMP
Const lJpgEncoderStr As String = "{557cf401-1a04-11d3-9a73-0000f81ef32e}" 'Sauvegarde JPG
Const lGifEncoderStr As String = "{557cf402-1a04-11d3-9a73-0000f81ef32e}" 'Sauvegarde GIF
Const lTifEncoderStr As String = "{557cf405-1a04-11d3-9a73-0000f81ef32e}" 'Sauvegarde TIF
Const lPngEncoderStr As String = "{557cf406-1a04-11d3-9a73-0000f81ef32e}" 'Sauvegarde PNG
 
Const lQualityParamStr As String = "{1d5be4b5-fa4a-452d-9cdd-5db35105e7eb}"
 
On Error GoTo Gestion_Erreur
' Format de l'encodeur
Select Case pFormat
 Case "BMP": lEncoderStr = lBmpEncoderStr
 Case "JPG": lEncoderStr = lJpgEncoderStr
 Case "GIF": lEncoderStr = lGifEncoderStr 'image, pas animation
 Case "TIF": lEncoderStr = lTifEncoderStr
 Case "PNG": lEncoderStr = lPngEncoderStr
End Select
 
SaveFileImage = True 'Retour de la fonction, si tous se passe bien !!!!
' Recherche de l'encodeur Jpeg
CLSIDFromString StrPtr(lEncoderStr), lEncoder
 
If pQuality <> -1 And pFormat = "JPG" Then ' Paramètre de l'encodeur Jpeg
 lParams.Count = 1
 With lParams.Parameter(0)
 ' Paramètrage de la qualité (0-100)
 '100 pas de compression qualité maxi, 0 compression maxi qualité mediocre
   CLSIDFromString StrPtr(lQualityParamStr), .GUID
   .NumberOfValues = 1
   .Type = 4    ' Type Long
   .Value = VarPtr(pQuality)
 End With
End If
' Sauvegarde l'image
If lParams.Count > 0 Then
 SaveFileImage = GdipSaveImageToFile(HandlImag, StrPtr(pFile), lEncoder, lParams) = 0
 Else
 SaveFileImage = GdipSaveImageToFile(HandlImag, StrPtr(pFile), lEncoder, Null) = 0
End If
Gestion_Erreur:
If Err.Number <> 0 Then SaveFileImage = False
End Function

Comme on peut le voire, il est possible de choisir différent type de sauvegarde et de compression.
Ceci n’est pas un code finit, il faudra adapter aux besoins de chacun, mais en l'état, il fonctionne tout de suite, pourvue que le chemin/nom du fichier source soit renseigné correctement.

Je suis intéressé par un retour sur les performances, je suis sous Windows 7 Premium Familiale.

[Souleyre]

Salut ProgElecT,
Ton code est absolument parfait et, en plus, correspond exactement à ce que je cherchais à obtenir!
Je te suis vraiment reconnaissant.
Souleyre.