Adapter une picture box à des coordonnées

Soyez le premier à donner votre avis sur cette source.

Vue 4 204 fois - Téléchargée 431 fois

Télécharger le projet
Commenter

Description

Marre de devoir se prendre la tête avec les coordonnées lorsque vous voulez afficher quelquechose sur une picturebox ?
Ce module de classe est pour vous ^^

ba oui, par défaut (et pour tous les langages de programmation à ma connaissance) le point 0,0 est en haut a gauche et l'axe des y est inversé.

Ce module de classe permet de palier a ce petit embêtement. (permet aussi un effet auto stretch)

Méthode employée : Modification du repère de la picturebox de manière temporraire (par API)

Source / Exemple : 


'Par florentcreate le 26/10/2009

'Module de classe permetant d'avoir un affichage addapté en dimensions & position
'   1) créer et instancier un objet Print_adapteur
'   2) Ouvrir l'adapteur avec en paramètres
'       - une pictureBox instanciée et chargée
'       - le Xmin : absice du point visible le plus à gauche
'       - le Xmax : absice du point visible le plus à droite
'       - le Ymin : ordonnée du point visible le plus en bas
'       - le Ymax : ordonnée du point visible le plus en haut
'   3) Effectuer les oppérations graphiques (direct VB ou par DC)
'   4) Fermer
' [ 5) Détruire l'objet Print_adapteur ]

'/!\ l'instruction PictureBox.Cls n'est pas utilisable entre Ouvrir et Fermer
'    il faut l'utiliser avant l'ouverture

Option Explicit
'######################################################################################
Private Type XForm
    eM11 As Single
    eM12 As Single
    eM21 As Single
    eM22 As Single
    eDx As Single
    eDy As Single
End Type
'######################################################################################
Private Declare Function CombineTransform Lib "GDI32.dll" (ByRef lpXFormResult As XForm, ByRef lpXForm1 As XForm, ByRef lpXForm2 As XForm) As Long
Private Declare Function SetGraphicsMode Lib "GDI32.dll" (ByVal hDC As Long, ByVal iMode As Long) As Long
Private Declare Function GetWorldTransform Lib "GDI32.dll" (ByVal hDC As Long, ByRef lpXform As XForm) As Long
Private Declare Function SetWorldTransform Lib "GDI32.dll" (ByVal hDC As Long, ByRef lpXform As XForm) As Long
'######################################################################################
Private Const GM_ADVANCED As Long = 2
'######################################################################################

Private aff As PictureBox

Private OldMode As Long
Private OldXForm As XForm

Private p_Xmin As Long
Private p_Xmax As Long
Private p_Ymin As Long
Private p_Ymax As Long

Private p_ech_x As Double
Private p_ech_y As Double

Public Property Get Xmin() As Long
    Xmin = p_Xmin
End Property
Public Property Get Xmax() As Long
    Xmax = p_Xmax
End Property
Public Property Get Ymin() As Long
    Ymin = p_Ymin
End Property
Public Property Get Ymax() As Long
    Ymax = p_Ymax
End Property

Public Property Get Echelle_X() As Double
    Echelle_X = p_ech_x
End Property
Public Property Get Echelle_Y() As Double
    Echelle_Y = p_ech_y
End Property

Public Sub Ouvrir(P As PictureBox, newXmin As Long, newXmax As Long, newYmin As Long, newYmax As Long)
    'Init des vairables
    Set aff = P
        aff.ScaleMode = vbPixels
        aff.AutoRedraw = True
    
        p_Xmin = newXmin
        p_Xmax = newXmax
        p_Ymin = newYmin
        p_Ymax = newYmax
    '--------------------------------
    
    p_ech_x = aff.ScaleWidth / (p_Xmax - p_Xmin)
    p_ech_y = aff.ScaleHeight / (p_Ymax - p_Ymin)

    ' Sauvegarde de l'etat normal
    ' Set graphics mode to advanced mode to use world transformation
        OldMode = SetGraphicsMode(aff.hDC, GM_ADVANCED)
    ' Get current transformation matrix
        Call GetWorldTransform(aff.hDC, OldXForm)

    'Matrice de translation (Dx, Dy) + inversion de l'axe des absyces
    Dim MyXform As XForm
    With MyXform
        .eM11 = 1 * p_ech_x
        .eM22 = 0
        .eM21 = 0
        .eM22 = -1 * p_ech_y
            .eDx = -p_Xmin * p_ech_x
            .eDy = -p_Ymin * p_ech_y
    End With

    ' Apply new transformation matrix
    Call SetWorldTransform(aff.hDC, MyXform)
End Sub

Public Sub Fermer()
    ' Re-set world transformation matrix
    Call SetWorldTransform(aff.hDC, OldXForm)
    ' Re-set graphics mode
    Call SetGraphicsMode(aff.hDC, OldMode)
End Sub

Conclusion :


livré avec projet de démo.
normalement sans bug. cependant il n'y a pas de sécurité mise en place autour des recours aux API ...

toute remarque est la bienvenue.
Télécharger le projet

Codes Sources

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 (Flocreate)