Sub GetStdScaleSize(ObjScale As Object, ObjStd As StdPicture, ByRef lWidth As Long, ByRef lHeight As Long, Optional iScale As Integer = vbTwips)
' 0 vbUser Définie par l'utilisateur : indique que la largeur ou la hauteur de object prend une valeur personnalisée.
' 1 vbTwips Twip (1440 twips par pouce logique ; 567 twips par centimètre logique).
' 2 vbPoints Point (72 points par pouce logique).
' 3 vbPixels Pixel (plus petite unité de résolution de moniteur ou d'imprimante).
' 4 vbCharacters Caractère (horizontal = 120 twips par unité ; vertical = 240 twips par unité).
' 5 vbInches Pouce
' 6 vbMillimeters Millimètre
' 7 vbCentimeters Centimètre
' 8 vbHimetric HiMetric. Si l'argument fromscale est omis, HiMetric est considéré comme la valeur par défaut.
' 9 vbContainerPosition Détermine l'emplacement du contrôle.
' 10 vbContainerSize Détermine la taille du contrôle.
' entre 1 et 7 !
If iScale < 1 Or iScale > 7 Then
Err.Raise vbInteger, "GetStdScaleSize", "Echelle incorrecte"
Else
lWidth = ObjScale.ScaleX(ObjStd.Width, vbHimetric, iScale)
lHeight = ObjScale.ScaleY(ObjStd.Height, vbHimetric, iScale)
End If
End Sub
' ===============================================================
' EXEMPLE D'UTILISATION "AVEC" UNE PICTUREBOX
Private Sub Form_Load()
' cet exemple sert à comprendre en quoi la procédure "GetStdScaleSize" peut être utile.
Const MON_IMAGE As String = "C:\tmp1.jpg"
Dim STD As StdPicture
Picture1.Appearance = 0
Picture1.BorderStyle = 0
Picture1.ScaleMode = vbPixels
Picture1.AutoSize = True
' charge l'image
Picture1.Picture = LoadPicture(MON_IMAGE)
Set STD = LoadPicture(MON_IMAGE)
' PIC : dimensions réelles
MsgBox "PICTUREBOX :" & vbCrLf & Picture1.ScaleWidth & " x " & Picture1.ScaleHeight
' STD : dimensions fausses
MsgBox "STDPICTURE :" & vbCrLf & STD.Width & " x " & STD.Height
' STD : dimensions réelles
Dim lWidth&, lHeight&
Call GetStdScaleSize(Picture1, STD, lWidth, lHeight, vbPixels)
MsgBox "STDPICTURE :" & vbCrLf & lWidth & " x " & lHeight
Set STD = Nothing
Unload Me
End Sub
' ===============================================================
' ===============================================================
' INFO : la procédure "GetStdScaleSize" peut fonctionner sans objet,
' par exemple dans/par un UserControl...
' EXEMPLE D'UTILISATION "PAR" UN USERCONTROL
Call GetStdScaleSize(UserControl, mPicture, lW, lH)
' ===============================================================