API GetBitmapDimensionEx retourne des zéros

Version imprimable

Salut

Voici le tout ptit programme

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
Private Declare Function GetBitmapDimensionEx Lib "gdi32" ( _
                         ByVal hBitmap As Long, _
                         lpDimension As Size) As Long
 
Private Type Size
        cx As Long
        cy As Long
End Type
 
Private Sub cmdParcourir_Click()
'    Dim liResultat As Long
    Dim laSize As Size, laPic As Picture
    With dlgOuvrir
        .DialogTitle = "Ouvrir un bitmap"
        .Filter = "Bitmap (.bmp)|*.bmp;*.BMP"
        .InitDir = "D:\DEC_Info\2006 Hi\420-407 POO"
        .ShowOpen
        txtFichier.Text = .FileName
        Set laPic = LoadPicture(.FileName)
        If .FileName <> "" Then
            picImage.Picture = LoadPicture(.FileName)
'            liResultat = GetBitmapDimensionEx(laPic.Handle, laSize)
            GetBitmapDimensionEx(laPic.Handle, laSize)
            txtLarg.Text = laSize.cx
            txtHaut.Text = CStr(laSize.cy)
        End If
    End With
End Sub

Et mes textBox txtLarg et txtHaut affichent des zéros.

J'ai cherché chez DocVB et MSDN et sur Développez, bien sur, mais je n'ai rien trouvé pour faire mon bonheur.

J'ai même essayé avec ou sans valeur de retour. Que dale!

Avez-vous une idée de l'origine du problème? Ce doit être un code d'erreur numéro 18 (18 pouces devant l'écran! ), mais comme mes recherches sont infructueuses...

Ne te vexes pas zazaraignée ;) , je me doute que tu connais cette possibilité, mais cela peut servir aux personnes qui passeront par là.

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
Option Explicit
Dim Largeur As Integer
Dim Hauteur As Integer
Dim Dimensions As String
 
Private Sub Form_Load()
'InformationsFichier "C:\PersoFrancis", "FondEcran.bmp"
InformationsFichier "C:\PersoFrancis", "MoiBoiteMenuShell.JPG"
MsgBox Dimensions & vbCrLf & "Hauteur " & Hauteur & "    Largeur" & Largeur
End Sub
 
Public Sub InformationsFichier(Chemin As String, Fichier As String)
'necessite d'activer reference Microsoft Shell Controls and Automation
Dim objShell As Shell
Dim objFolder As Folder
Dim strFileName As FolderItem
 
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.NameSpace(Chemin) 'adapter le chemin
Set strFileName = objFolder.Items.Item(Fichier) 'adapter le fichier
If objFolder.GetDetailsOf(strFileName, 26) <> "" Then
 Dimensions = Trim$(objFolder.GetDetailsOf(strFileName, 26))
End If
If objFolder.GetDetailsOf(strFileName, 27) <> "" Then
 Largeur = Val(Trim(objFolder.GetDetailsOf(strFileName, 27)))
End If
If objFolder.GetDetailsOf(strFileName, 28) <> "" Then
 Hauteur = Val(Trim(objFolder.GetDetailsOf(strFileName, 28)))
End If
 
Set objShell = Nothing: Set objFolder = Nothing: Set strFileName = Nothing
 
End Sub

01/05/2007, 20h20
zazaraignée

Non, je ne connaissais pas...

Je teste et je dis si ça correspond à ce que je cherches.
01/05/2007, 20h27
zazaraignée

J'ai essayé ton code. :) Ça marche! Merci!

À ceci près, ne pas oublier d'ajouter en référence Microsoft Shell Controls and Automation.

Sinon on peut passer par l'objet StdPicture

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Private Sub cmdParcourir_Click()
    Dim  laPic As Picture ' Similaire à Dim  laPic As StdPicture
    With dlgOuvrir
        .DialogTitle = "Ouvrir un bitmap"
        .Filter = "Bitmap (.bmp)|*.bmp;*.BMP"
        .InitDir = "D:\DEC_Info\2006 Hi\420-407 POO"
        .ShowOpen
        txtFichier.Text = .FileName
        Set laPic = LoadPicture(.FileName)
        If .FileName <> "" Then
            picImage.Picture = LoadPicture(.FileName)
            txtLarg.Text = ScaleX(laPic.Width,VbHimetrics,VbPixels)
            txtHaut.Text = ScaleY(laPic.Height,VbHimetrics,VbPixels)
        End If
    End With
End Sub

02/05/2007, 14h15
zazaraignée

Oui, je connaissais. Mais le but de l'exercice étant de passer par un autre chemin qu'un objet Picture. J'avais trouvé l'API sus mentionné. Mais apparemment, elle ne marche pas aussi intuitivement que je l'aurais cru.

Merci à vous deux.