Convertir la taille d'un objet StdPicture


Commenter

Contenu du snippet 

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)
'  ===============================================================

Compatibilité : VB6, VBA

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (PCPT)