Récupérer la largeur et la hauteur d'une image BitMap chargée dans un contrôle i

Résolu
SERIEUXETCOOL Messages postés 336 Date d'inscription dimanche 3 avril 2011 Statut Membre Dernière intervention 12 juin 2012 - 30 mars 2012 à 10:28
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 - 4 avril 2012 à 10:02
Bonjour à tous,

Une nouvelle question me taquine l'esprit et j'aimerais en savoir plus...

Dans une feuille Excel j'ai un contrôle image (Contrôle ActiveX). C'est un objet de type OLEObject. Je charge une image BitMap dans ce contrôle et j'aimerais savoir quels en sont la largeur et la hauteur de l'image qui est chargée.

J'ai fait des recherches sur le net et malgré plusieurs questions sur le sujet, je n'ai pas trouvé beaucoup de réponses.

Je suis tout de même parvenu à trouver une solution qui fonctionne bien. Mais le code employé ne me parais pas le plus adapté à mon cas de figure. C'est pourquoi je préfère demander ici, s'il existe une autre méthode plus en adéquation.

Je précise que je ne charge par une image dans un contrôle image pour en obtenir la largeur et la hauteur. Je charge l'image dans le contrôle pour la suite de mon projet. Et je me dis que si l'image doit être chargée, alors autant en profiter pour en extraire les données que je veux. Or actuellement le code que j'emploie ne passe pas du tout par le contrôle image mais directement par la ré-ouverture du fichier via Open For Binary Access.

Voici le code qui génère le contrôle image :

'=  =========================================================================================================================
Dim Contrôle_Image1 As OLEObject
'=================================================================
'Création, insertion, placement et dimensionnement d'un object sur la feuille (Contrôle image dans cet exemple)
'Set Contrôle_Image1 ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, _
DisplayAsIcon:=False, Left:=210, Top:=124.5, Width:=123, Height:=49.5)

'=============================================================
'On contrôle ensuite ici l'ensemble des propriétés de l'objet sur lequelles ont souhaite agir
'Contrôle_Image1.Name "Image1"
Contrôle_Image1.Left = Range("R7").Left
Contrôle_Image1.Top = Range("R7").Top
Contrôle_Image1.Width = Range("R7:T5").Width
Contrôle_Image1.Height = Range("R7:T15").Height
Contrôle_Image1.Placement = xlMoveAndSize
Contrôle_Image1.PrintObject = True
Contrôle_Image1.Object.Picture = LoadPicture(Fichier_Image)
Contrôle_Image1.Object.PictureAlignment = 2
Contrôle_Image1.Object.PictureSizeMode = 3
Contrôle_Image1.Object.BackStyle = 0
Contrôle_Image1.Object.SpecialEffect = 6
'========================================================================================================================== 



Voici le code que j'ai trouvé et qui permet d'obtenir la largeur et la hauteur :

Private Type BITMAPFILEHEADER
    bfType As Integer
    bfSize As Long
    bfReserved1 As Integer
    bfReserved2 As Integer
    bfOffBits As Long
End Type

Private Type BITMAPINFOHEADER
    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
    biClrUsed As Long
    biClrImportant As Long
End Type

Public Sub test()
Open Fichier_Image For Binary Access Read Write Lock Write As #1
Dim BMPFileHeader As BITMAPFILEHEADER
Dim BMPInfoHeader As BITMAPINFOHEADER
 
    Get #1, 1, BMPFileHeader
    Get #1, , BMPInfoHeader
Largeur    = BMPInfoHeader.biWidth
Hauteur = BMPInfoHeader.biHeight
End Sub



Comment puis-je améliorer ce code pour le rendre le plus simple simple possible ?

Il me semble qu'il est possible d'utiliser le type suivant :

Type BITMAP
   bmType As Long
   bmWidth As Long
   bmHeight As Long
   bmWidthBytes As Long
   bmPlanes As Integer
   bmBitsPixel As Integer
   bmBits As Long
   End Type



Puis d'obtenir la largeur et la hauteur avec :

Dim bmAPI As BITMAP
With bmAPI
   Largeur = .bmWidth:
   Hauteur = .bmHeight:
End With


Ce code est simple, mais je ne parviens pas à l'utiliser dans mon cas de figure.


Vos idées sont les bienvenues.

Bien cordialement,

André

50 réponses

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
30 mars 2012 à 21:01
Bon (bien dîné) ===>>
Alors voilà et voilà pourquoi il faut passer par une stdPicture
D'une pierre trois coups (et SERIEUXETCOOL va comprendre, lui, ce "cadeau-là)) :
Option Explicit
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function TranslateColor Lib "olepro32.dll" Alias "OleTranslateColor" (ByVal clr As OLE_COLOR, ByVal palet As Long, col As Long) As Long
Private Sub CommandButton1_Click()
    Dim toto As New StdPicture, i As Long, j As Long, couleur As Long
    Dim hdc As Long, pixels_width As Long, pixels_height As Long, R As Byte, G As Byte, B As Byte
    Set toto = LoadPicture("d:\bateau.bmp")
    pixels_width = Int(Application.CentimetersToPoints(toto.Width / 1000) * 20 / TwPerPix("X"))
    pixels_height = Int(Application.CentimetersToPoints(toto.Height / 1000) * 20 / TwPerPix("Y"))
    hdc = CreateCompatibleDC(0)
    SelectObject hdc, toto.Handle
    For i = 0 To pixels_width
      For j = 0 To pixels_height
        couleur = GetPixel(hdc, i, j)
        Dim RealColor As Long
        TranslateColor couleur, 0, RealColor
        R = RealColor And &HFF&
        G = (RealColor And &HFF00&) / 2 ^ 8
        B = (RealColor And &HFF0000) / 2 ^ 16
        MsgBox "R " & R & "   G " & G & "   B = " & B ' sors de cette boucle par CTRL + PAUSE
      Next j
    Next i
End Sub

Function TwPerPix(sens As String) As Single
  Dim axe As Long, lngDC As Long
  axe IIf(sens "X", 88, 90)
  lngDC = GetDC(0)
  TwPerPix = 1440& / GetDeviceCaps(lngDC, axe)
  ReleaseDC 0, lngDC
End Function


Voilà voilà ...
Ce qui ne veut certes pas dire, André, que je vois d'un bon oeil ce que tu es en tran de faire là, hein...
Mais voilà : tu es servi. A toi de continuer (mais sans moi, maintenant).

____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient
3
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
31 mars 2012 à 06:56
Ta demande est étonnante, André, car elle consisterait à vouloir modifier toute la philosophie d'une matrice.
Mais pourquoi tout cela, au bout du compte ? Juste pour faire coincider avec la philosophie de ta représentation en axes orientés ?
Il y a alors l'arithmétique, pour y parvenir. Soit à appliquer après, soit à appliquer pendant.

Je choisis ici de l'appliquer "pendant"

For i = 0 To pixels_width
      For j = pixels_height to 0 step -1 '<<<<==== j'inverse la lecture
        couleur = GetPixel(hdc, i, pixels_height- j) '<<<=== je corrige pour m'y retrouver
        Dim RealColor As Long
        TranslateColor couleur, 0, RealColor
        R = RealColor And &HFF&
        G = (RealColor And &HFF00&) / 2 ^ 8
        B = (RealColor And &HFF0000) / 2 ^ 16
        MsgBox "R " & R & "   G " & G & "   B = " & B ' sors de cette boucle par CTRL + PAUSE
      Next j
    Next i



____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient
3
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
31 mars 2012 à 07:27
Ah oui. Tu veux en fait que ce soit plus "parlant" pour toi.

Alors ===>>
Ici, je balaye depuis la dernière ligne jusqu'à la première, chaque ligne étant balayée de gauche à droite.
Tout en calculant (pour me "parler" mieux) les coordonnées dans l'ordre de celles de tes axes : (0,0) pour le coin inférieur gauche, (large,0) pour l'angle inférieur droit, (0,haut) pour le coin supérieur gauche et (large,haut) pour le coin supérieur droit
      
      For j = 0 To -pixels_height Step -1
        For i = 0 To pixels_width
          couleur = GetPixel(hdc, i, j + pixels_height)
          Dim RealColor As Long
          TranslateColor couleur, 0, RealColor
          R = RealColor And &HFF&
          G = (RealColor And &HFF00&) / 2 ^ 8
          B = (RealColor And &HFF0000) / 2 ^ 16
        Next i
     Next j


Voilà donc. Avec ces deux exemples, tu devrais t'amuser comme tu veux.


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient
3
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
31 mars 2012 à 21:08
Bon...
Je crains que tu ne te perdes un peu dans ce brouillard ajouté, André ===>>
vois mon message de 17:00:46
J'ai fini par trouver une image dans le cas de figure qui t'embêtais ===>>
Cette correction corrige.


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient
3

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Profil bloqué
30 mars 2012 à 11:01
Essaie ceci ( sans certitude )

Contrôle_Image1.Name = "Image1"
Contrôle_Image1.Left = Range("R7").Left
Contrôle_Image1.Top = Range("R7").Top
Contrôle_Image1.Width = Range("R7:T5").Width
Contrôle_Image1.Height = Range("R7:T15").Height
Contrôle_Image1.Placement = xlMoveAndSize
Contrôle_Image1.PrintObject = True
Contrôle_Image1.Object.Picture = LoadPicture(Fichier_Image)
Contrôle_Image1.Object.PictureAlignment = 2
Contrôle_Image1.Object.PictureSizeMode = 3
Contrôle_Image1.Object.BackStyle = 0
Contrôle_Image1.Object.SpecialEffect = 6

ensuite c'est le nouveau code à mettre à la suite du tien
Contrôle_Image1.Object.Autosize=True
xPixel=Contrôle_Image1.Object.ScaleX(PicSource.Picture.Width,8,3)
yPixel=Contrôle_Image1.Object.ScaleY(PicSource.Picture.Height,8,3)

tu devrais obtenir la taille de ton image en pixels

La théorie, c'est quand on sait tout et que rien ne fonctionne. La pratique, c'est quand tout fonctionne et que personne ne sait pourquoi.

GRENIER Alain
0
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
30 mars 2012 à 11:21
Bonjour, Galain,
Scalex sous VBA/Excel ?
Tu es sûr ?


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient
0
MarcPL Messages postés 172 Date d'inscription jeudi 8 décembre 2011 Statut Membre Dernière intervention 21 juillet 2013 2
30 mars 2012 à 11:22
Personnellement pour les images chargées (BMP, JPG, ...) dans une feuille de calcul,
certes ces images ne sont pas des OLEObject
(encore une fois à éviter comme la peste ! Là pour compatibilité avec des anciennes versions),
avec la version 2003 je n'utilise pas d'API, leurs propriétés & le VBA suffisent amplement,
surtout au moment de leur insertion ...

SERIEUXETCOOL, j'attends que tu testes la proposition de Galain et si c'est négatif,
quel est le souci rencontré en VBA, à quelles fins as-tu besoin de ces infos, ... ?

___________________________________________________________________________________________________________________
Comme la vitesse de la lumière est supérieure à celle du son, certains ont l'air brillant avant d'avoir l'air con !
0
Profil bloqué
30 mars 2012 à 11:25
Correction

Contrôle_Image1.Object.Autosize=True
xPixel=Contrôle_Image1.Object.ScaleX(Contrôle_Image1.Picture.Width,8,3)
yPixel=Contrôle_Image1.Object.ScaleY(Contrôle_Image1.Picture.Height,8,3)

8,3 pour pixels et 8,6 pour les mm


La théorie, c'est quand on sait tout et que rien ne fonctionne. La pratique, c'est quand tout fonctionne et que personne ne sait pourquoi.

GRENIER Alain
0
Profil bloqué
30 mars 2012 à 11:34
salut ucfoutu

ScaleX ou Y sous VBA : alors là j'ai peur ! Je ne pratique nullement Excel et le VBA !
Ma solution à mettre sous réserve !

La théorie, c'est quand on sait tout et que rien ne fonctionne. La pratique, c'est quand tout fonctionne et que personne ne sait pourquoi.

GRENIER Alain
0
MarcPL Messages postés 172 Date d'inscription jeudi 8 décembre 2011 Statut Membre Dernière intervention 21 juillet 2013 2
30 mars 2012 à 11:35
ScaleX / Y n'existent pas dans la version 2003, sont-ce des nouvelles fonctions d'une version ultérieure ?

Ici c'est pour du VBA, pas du VB6 ou VBnet …

___________________________________________________________________________________________________________________
Comme la vitesse de la lumière est supérieure à celle du son, certains ont l'air brillant avant d'avoir l'air con !
0
MarcPL Messages postés 172 Date d'inscription jeudi 8 décembre 2011 Statut Membre Dernière intervention 21 juillet 2013 2
30 mars 2012 à 11:36
Désolé Galain, t'as répondu pendant la frappe de mon précédent message ...

___________________________________________________________________________________________________________________
Comme la vitesse de la lumière est supérieure à celle du son, certains ont l'air brillant avant d'avoir l'air con !
0
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
30 mars 2012 à 11:42
Bon, Alain
Non, cette méthode n'existe pas sous VBA (c'est du VB6 !)
Je vais donc tenter petit truc
A +



____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient
0
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
30 mars 2012 à 11:49
Voilà donc ===>>
Marche sur ma machine :

 Dim toto As New StdPicture
    Set toto = LoadPicture("d:\bateau.bmp")
    lwidth = toto.Width
    lheight =  toto.Height
    MsgBox "en unités himetric (millièmes de centimètre) : " & vbCrLf & _
    "lageur : " & lwidth & vbCrLf & _
    "hauteur : " & lheight & vbCrLf & vbCrLf & _
    "soit, en points : " & vbCrLf & _
    "largeur : " & Application.CentimetersToPoints(lwidth / 1000) & " points" & vbCrLf & _
    "hauteur : " & Application.CentimetersToPoints(lheight / 1000) & " points"


J'ai toutefois un doute en ce qui concerne le première ligne, à savoir :
Dim toto As New StdPicture

Car, sur ma machine, est également présent VB6. Et je ne sais donc pas si cette ligne aurait été également acceptée sans cette présence ! A tester (et me dire).

@André (seul) : j'ai répondu, mais cela ne veut pas dire que j'approuve ce que tu comptes en faire (mon MP).


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient
0
MarcPL Messages postés 172 Date d'inscription jeudi 8 décembre 2011 Statut Membre Dernière intervention 21 juillet 2013 2
30 mars 2012 à 11:51
Comme écrit plus haut, je le fais directement en VBA sans appel externe (vraiment simple),
j'attends juste de connaître les besoins réels, l'utilité, les difficultés rencontrées, ...

___________________________________________________________________________________________________________________
Comme la vitesse de la lumière est supérieure à celle du son, certains ont l'air brillant avant d'avoir l'air con !
0
SERIEUXETCOOL Messages postés 336 Date d'inscription dimanche 3 avril 2011 Statut Membre Dernière intervention 12 juin 2012 1
30 mars 2012 à 18:00
Bonjour à tous,

Je vais essayer de répondre un peu à tout le monde.

Galain :

ensuite c'est le nouveau code à mettre à la suite du tien
Contrôle_Image1.Object.Autosize=True
xPixel=Contrôle_Image1.Object.ScaleX(PicSource.Picture.Width,8,3)
yPixel=Contrôle_Image1.Object.ScaleY(PicSource.Picture.Height,8,3)

tu devrais obtenir la taille de ton image en pixels


J’obtiens une erreur. La variable PicSource n’est pas définie. Si j’enlève option explicit, alors le message d’erreur indique qu’il faut un objet.

Ucfoutu :

Bonjour, Galain,
Scalex sous VBA/Excel ?
Tu es sûr ?


Il me semblait aussi que ScaleX n’est pas définit sur VBA. D’ailleurs dans l’aide, SacaleX ne donne pas de retour. Sous VB6 oui.


MarcPL :

SERIEUXETCOOL, j'attends que tu testes la proposition de Galain et si c'est négatif,
quel est le souci rencontré en VBA, à quelles fins as-tu besoin de ces infos, ... ?


La solution initiale de Galain ne fonctionne pas on dirait. J’ai besoin de savoir quelle est la largeur et la hauteur de la photo qui est insérée dans le contrôle image pour définir les axes X et Y d’un graphique à ces valeurs. Les deux sont liés et c’est pour ça principalement. Ça me permet aussi de contrôler certains détails mineurs.

Galain :

Correction

Contrôle_Image1.Object.Autosize=True
xPixel=Contrôle_Image1.Object.ScaleX(Contrôle_Image1.Picture.Width,8,3)
yPixel=Contrôle_Image1.Object.ScaleY(Contrôle_Image1.Picture.Height,8,3)

8,3 pour pixels et 8,6 pour les mm


Malheureusement j’obtiens le message d’erreur suivant : Propriété ou méthode non générée par cet objet


MarcPL :

ScaleX / Y n'existent pas dans la version 2003, sont-ce des nouvelles fonctions d'une version ultérieure ?


Dans mon Excel 2007, l’aide n’indique pas de trace de ce scaleX. C’est valable sous VB6 mais pas VBA.


Ucfoutu :

Bon, Alain
Non, cette méthode n'existe pas sous VBA (c'est du VB6 !)
Je vais donc tenter petit truc
A +


Un point de plus en effet pour Ucfoutu.

Ucfoutu de nouveau :

Dim toto As New StdPicture     Set toto LoadPicture("d:\bateau.bmp")     lwidth toto.Width     lheight = toto.Height     MsgBox "en unités himetric (millièmes de centimètre) : " & vbCrLf & _     "lageur : " & lwidth & vbCrLf & _     "hauteur : " & lheight & vbCrLf & vbCrLf & _     "soit, en points : " & vbCrLf & _     "largeur : " & Application.CentimetersToPoints(lwidth / 1000) & " points" & vbCrLf & _     "hauteur : " & Application.CentimetersToPoints(lheight / 1000) & " points"



Pas d’erreur d’exécution. Tout fonctionne. C’est bizarre car j’ai vu sur le net des choses avec Dim toto As New StdPicture mais je ne suis pas parvenu à en tirer quoi que ce soit. La ça semble fonctionner. Quand aux valeurs retournées par les MsgBox, je dois vérifier l’exactitude. Je fait ça ce soir. Je dois filer pour le moment.


En tout cas on dirait que ça marche à première vue.

Je reviens confirmer taleur.

Merci pour vos réponses les gars. Et dsl de devoir répondre de cette manière. J'ai répondu à tous^^

A plus.


André
0
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
30 mars 2012 à 18:14
T'en fais pas pour les valeurs ==)=>> elles sont juste (j'ai vérifié).


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient
0
MarcPL Messages postés 172 Date d'inscription jeudi 8 décembre 2011 Statut Membre Dernière intervention 21 juillet 2013 2
30 mars 2012 à 18:34
Là ucfoutu me colle un doute : André tu veux bien en retour des pixels et non pas des points ?

___________________________________________________________________________________________________________________
Comme la vitesse de la lumière est supérieure à celle du son, certains ont l'air brillant avant d'avoir l'air con !
0
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
30 mars 2012 à 19:15
à MarcPl :
Je n'ai pas vu jusqu'à présent de demande de dimensions en pixels.
L'exemple que j'ai montré retourne des dimensions en unités Himetric puis en points.
Si André veut des dimensions en pixels, aucun problème réel, sauf qu'il va falloir aller en plus chercher les caractéristiques de l'écran pour déterminer le nombre de twips par pixel, tant en largeur qu'en hauteur. Je sais : ... on viendra me dire que c'est aujourd'hui 15 partout ... (hé bien non !).
Je reviens donc mettre ce calcul en pixels après le dîner (j'ai faim).


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient
0
SERIEUXETCOOL Messages postés 336 Date d'inscription dimanche 3 avril 2011 Statut Membre Dernière intervention 12 juin 2012 1
31 mars 2012 à 00:35
Re-bonsoir à tous,

Comme promis je viens faire mon petit retour sur les tests que j'ai pu faire.

Tout d'abord la remarque de MarcPL :

Là ucfoutu me colle un doute : André tu veux bien en retour des pixels et non pas des points ?


En effet je ne l'avais mentionné nulle part encore, mais il s'agit bien de dimensions en pixels. Petit oubli de ma part qui à quand même sont importance.


Ucfoutu :

Alors voilà et voilà pourquoi il faut passer par une stdPicture
D'une pierre trois coups (et SERIEUXETCOOL va comprendre, lui, ce "cadeau-là)) :


Merci d'avoir proposé dans la foulé le code en pixels. Tout de suite les résultats me parlaient plus
Merci aussi d'avoir vu un peu plus loin en proposant une méthode pour récupérer la couleur RGB de certains pixels (c'est partie du code ne concerne pas ce post, mais me sera utile pour la suite). Les bases sont posées pour que je puisse plancher dessus maintenant


Maintenant les remarques sur le code :

Il y a un truc qui ne me rassure pas. Sur certains fichiers bmp chargés, les dimensions largeur et hauteur sont bonnes. Sur d'autres, les dimensions sont "presque" bonnes.
La valeur retournée est juste à 1 pixel prêt. Donc soit la largeur et la hauteur sont justes toutes les deux, soit la largeur comporte 1 pixel de moins ou la hauteur qui comporte 1 pixel de moins soit la largeur et la hauteur ont 1 pixel de moins.
Pour déterminer quelle est la valeur référence de la largeur et de la hauteur de mon image, il existe un test simple. Le dossier qui comporte les photos bmp est affiché en mosaïque (dans l'affichage de l’explorateur Windows). Ainsi on peut voir la taille réelle de l'image. Et c'est ainsi que j'ai constaté que le code proposé par Ucfoutu ne donne pas tout le temps le bon nombre. Du moins j'ai l'impression. C'est peut être normal, mais je me demande quand même...

Je suis un peu embêté vis à vis de cette variation pour le moment. Je préfère attendre une explication pour mieux interpréter.


Merci à vous tous pour ces premières réponses en tout cas.

Bonne soirée,

André
0
SERIEUXETCOOL Messages postés 336 Date d'inscription dimanche 3 avril 2011 Statut Membre Dernière intervention 12 juin 2012 1
31 mars 2012 à 01:22
Bien entre temps j'ai eu le temps d'analyser un peu plus finement le code d'Ucfoutu.

J'ai trouvé 2 méthodes pour corriger la largeur et la hauteur dans tous les cas de figure (à priori bien sur).


Méthode 1 :

Plutôt que d'utiliser une troncature, l'arrondi semble être plus adapté ici. Donc au lieu d'utiliser "Int" on met "CInt"

...
Set toto =   LoadPicture("d:\bateau.bmp")
    pixels_width = CInt(Application.CentimetersToPoints(toto.Width / 1000) * 20 / TwPerPix("X"))
    pixels_height = CInt(Application.CentimetersToPoints(toto.Height / 1000) * 20 / TwPerPix("Y"))
    hdc =  CreateCompatibleDC(0)
...



Méthode 2 :

Ben on peut aussi se dire que finalement c'est la troncature qui pose problème. Si on enlève la troncature, ça fonctionne bien pour toutes mes images (à priori la encore).

...
Set toto    = LoadPicture("d:\bateau.bmp")
    pixels_width = Application.CentimetersToPoints(toto.Width / 1000) * 20 / TwPerPix("X")
    pixels_height = Application.CentimetersToPoints(toto.Height / 1000) * 20 / TwPerPix("Y")
    hdc = CreateCompatibleDC(0)
...



Probablement que la méthode 1 est la plus pertinente ici. Toute fois j'attends une confirmation avant de valider tout changement (évidement la solution peut être toute autre^^)


Ayé je peux aller me coucher l'esprit tranquille maintenant

André
0
Rejoignez-nous