Bonjour,
J'aimerais savoir si il est possible d'extraire une zone particulière d'une image pour ensuite enregistrer cette nouvelle image ?
D'avance merci
Bonjour,
J'aimerais savoir si il est possible d'extraire une zone particulière d'une image pour ensuite enregistrer cette nouvelle image ?
D'avance merci
j'ai peut-etre une solution mais je ne suis pas chez moi.Donne moi ton adresse mail en mp et je t'enverrais ce que j'ai (pas avant ce week-end par contre) à moins que quelqu'un d'autre en ait une.
Si tu as quelque chose, je pense qu'il serait bon que tu le mettes sur le forum pour que tout le monde en profite.Envoyé par avigeilpro
N'oubliez pas de cliquer sur quand vous avez obtenu ou trouvé vous-même la réponse à votre question.
Si vous trouvez seul, pensez à poster votre solution. Elle peut servir à d'autres!
Pensez aussi à voter pour les réponses qui vous ont aidés.
------------
Je dois beaucoup de mes connaissances à mes erreurs!
bien sur que ça m'intéresse
désolé mais je ne peut pas avancer sur le projet car j'ai un disque dur qui a sauter.je ne pourais reprendre que d'ici une semaine.pour faire bref, il ne me mank plus que le moyen de créer une image dont les dimension serait celles de la partie que tu souhaite garder.après il suffit de lire pixel par pixel l'image d'origine et d'inscrire la valeur de ces pixels dans l'image d'arrivée avec un controle de ma conception.si tu as moyen de creer ce fichier BMP a la bonne taille, tu pourra trouver mon control sur mon site :
http://www.geocities.com/avigeilpro
dans la zone de telechargement, le control s'appel OpenBmp.sinon attend une semaine et ce meme control sera capable de créer un fichier bitmap.
Merci beaucoup pour ton aide
pour créer un bitmap il y a une solution sur le site :
http://access.developpez.com/sources...dows#Imprecran
ça fait une capture d'écran donc ça crée une bitmap
Ok, voici ce que j'ai :
a mettre dans un module :
ensuite tu telecharge le control dont je t'ai parlé précédement, tu l'ajout a ton projet (ctrl + t , controlbitmap) tu le pose sur ta feuille et tu rajoute le code suivant pour faire une copie d'une partie de l'image :
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 Private Declare Function CreateCompatibleDC Lib "gdi32" _ (ByVal hdc As Long) As Long Private Declare Function CreateDIBSection Lib "gdi32" _ (ByVal hdc As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, _ ByVal lplpVoid As Long, ByVal Handle As Long, ByVal dw As Long) As Long Private Declare Function DeleteDC Lib "gdi32" _ (ByVal hdc As Long) As Long Private Declare Function DeleteObject Lib "gdi32" _ (ByVal hObject As Long) As Long Private Declare Function SelectObject Lib "gdi32" _ (ByVal hdc As Long, ByVal hObject As Long) As Long Private Type BITMAPINFO biSize As Long biWidth As Long biHeight As Long biPlanes As Integer biBitCount As Integer biCompression As Long biSizeImage As Long biXPelsPerMeter As Long biYPelsPerMeter As Long biRUsed As Long biRImportant As Long End Type Private Type BITMAPFILEHEADER bfType As Integer bfSize As Long bfReserved1 As Integer bfReserved2 As Integer bfOffBits As Long End Type Private Const GHND = &H42 Private Const MAXSIZE = 4096 Private Const SRCCOPY = &HCC0020 Private Const DIB_RGB_COLORS = 0& Private Const BI_RGB = 0& Public Function BmpCreate(strNomDuFichier As String, lngLargeur As Long, lngHauteur As Long) On Error GoTo Finally Dim lngHdc As Long Dim lngHBmp As Long Dim bmiBitmapInfo As BITMAPINFO Dim bmfBitmapFileHeader As BITMAPFILEHEADER Dim lngFnum As Integer Dim pixels() As Byte Dim bolOuvert As Boolean lngHdc = CreateCompatibleDC(0) If lngHdc = 0 Then GoTo Finally End If 'Crée un bitmap vierge With bmiBitmapInfo .biBitCount = 24 .biCompression = BI_RGB .biPlanes = 1 .biSize = Len(bmiBitmapInfo) .biHeight = lngHauteur .biWidth = lngLargeur .biSizeImage = ((((.biWidth * .biBitCount) + 31) \ 32) * 4 - _ (((.biWidth * .biBitCount) + 7) \ 8)) * .biHeight End With lngHBmp = CreateDIBSection(lngHdc, bmiBitmapInfo, DIB_RGB_COLORS, _ ByVal 0&, ByVal 0&, ByVal 0&) If lngHBmp = 0 Then GoTo Finally End If If SelectObject(lngHdc, lngHBmp) = 0 Then GoTo Finally End If 'Crée l'entête du fichier bmp With bmfBitmapFileHeader .bfType = &H4D42& .bfOffBits = Len(bmfBitmapFileHeader) + Len(bmiBitmapInfo) .bfSize = (lngLargeur * 3 + (lngLargeur Mod 4)) * lngHauteur + 54 End With 'Lit les bits du bitmap et les places dans le tableau pixels Dim test test = ((lngLargeur + (lngLargeur Mod 4)) * lngHauteur) ReDim pixels(1 To ((lngLargeur + (lngLargeur Mod 4)) * lngHauteur)) lngFnum = FreeFile 'Crée le fichier Open strNomDuFichier For Binary As lngFnum bolOuvert = True 'Ecrit l'entête Put #lngFnum, , bmfBitmapFileHeader 'Ecrit les informations du bitmap Put #lngFnum, , bmiBitmapInfo 'Ecrit les bits de l'image Put #lngFnum, , pixels Finally: 'Ferme le fichier si ouvert If bolOuvert Then Close lngFnum 'Supprime les objets If lngHBmp <> 0 Then DeleteObject lngHBmp If lngHdc <> 0 Then DeleteDC lngHdc End Function
a +
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 Dim Largeur As Single Dim Hauteur As Single Dim ImgPix() As Long Dim DepX As Single Dim DepY As Single Dim Original As String Dim Copie As String Dim BoucleX As Single Dim BoucleY As Single 'taille de la partie a copier Largeur = 30 Hauteur = 30 'emplacement du coin superieur gauche de la partie a copier 'coordonnée minimum (0,0) DepX = 264 DepY = 159 ReDim ImgPix(Largeur, Hauteur) 'emplacement du fichier a créer Copie = "C:\test.bmp" 'emplacemtn du fichier contenant toute l'image Original = "C:\monimage.bmp" On Error Resume Next Kill Copie On Error GoTo 0 BmpCreate Copie, CLng(Largeur), CLng(Hauteur) BmpCtrl1.OpenBmp Original For BoucleX = 0 To Largeur - 1 For BoucleY = 0 To Hauteur - 1 ImgPix(BoucleX, BoucleY) = BmpCtrl1.GetPixColor(BoucleX + DepX, BoucleY + DepY) Next Next BmpCtrl1.CloseBmp BmpCtrl1.OpenBmp Copie For BoucleX = 0 To Largeur - 1 For BoucleY = 0 To Hauteur - 1 BmpCtrl1.SetPixLng BoucleX, BoucleY, ImgPix(BoucleX, BoucleY) Next Next BmpCtrl1.CloseBmp
merci pour tout
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager