Dessiner une courbe dans une image vierge d'un userform

seb.seb

XLDnaute Nouveau
Bonjour à tous,

Je souhaite dessiner une courbe par l'intermédiaire d'une image vierge intégrée à un userform.
Les données sont stockées dans des tableaux (les valeurs sont basiques mais sont seulement là pour faire fonctionner la macro).

J'ai vu qu'il existait "Pset(x,y), Color" pour dessiner des points et "line(x1,y1)-(x2,y2), Color" pour relier ces points par des lignes, mais je n'arrive pas à les faire fonctionner.


Faut-il ajouter une référence particulière pour faire fonctionner ces commandes ?
Est-ce une erreur de code ?
Une autre alternative est-elle possible pour dessiner une courbe dans un userform ?

Je vous joint le bout de code ainsi que le fichier.


Merci à tous


Code:
''-------------''
''Partie Module''
''-------------''
Public Nb_Donnee As Long
Public Tbl_Donnee_x() As Variant
Public Tbl_Donnee_y() As Variant


Sub Donnee_Graphique()
    
    Nb_Donnee = 20
    
    ReDim Tbl_Donnee_x(Nb_Donnee - 1)
    ReDim Tbl_Donnee_y(Nb_Donnee - 1)
    
    
    For i = 0 To Nb_Donnee - 1
        
        Tbl_Donnee_x(i) = i
        Tbl_Donnee_y(i) = i
        
    Next i
    
End Sub


''---------------''
''Partie UserForm''
''---------------''
Private Sub Image1_Click()
    
    ''Charger les données''
    Call Donnee_Graphique
    
    ''Insérer les points''
    For i = 0 To Nb_Donnee - 1
        
        Me.Image1.PSet (Tbl_Donnee_x(i), Tbl_Donnee_y(i)), vbRed
        
    Next i
    
    ''Tracer les lignes''
    For i = 1 To Nb_Donnee - 1
        
        Me.Image1.Line (Tbl_Donnee_x(i - 1), Tbl_Donnee_y(i - 1))-(Tbl_Donnee_x(i), Tbl_Donnee_y(i)), vbRed
        
    Next i
    
    
End Sub
 

Pièces jointes

  • Dessiner courbe userform.xlsm
    14.9 KB · Affichages: 161

seb.seb

XLDnaute Nouveau
Re : Dessiner une courbe dans une image vierge d'un userform

Bonjour Staple1600,

Merci pour ta réponse.

Je ne l'ai pas expliqué dans mon précédent post, mais à la base le graphique était placé dans une feuille excel et crée dynamiquement par macro.
Le but étant d'avoir plusieurs courbes avec des ordonnées différentes dans un même graphique avec un pointeur qui suit la courbe choisie (et qui simultanément donne les valeurs de chaque courbe dans une partie de la feuille excel).
Cette méthode fonctionne mais est un peu lourde(l'actualiser du graphique n'est pas très fluide, surement du aux aller-retours entre vba et excel) et présente beaucoup de limitation (quantité de point limitée pour chaque série si on passe pas un tableau vba, nombre de série limité (256), on ne peut pas mettre de couleur différente pour chaque tronçon de courbe entre chaque point).

C'est pourquoi je me suis tourné vers un userform qui m'aurait permis de contourner ces problèmes.

Donc mon but n'est pas d'importer un graphique d'excel vers un userform mais de pouvoir dessiner des points et des lignes dans une image vierge (ou ailleurs) afin de pouvoir créer un graphique (image).
 

Herdet

Nous a quitté
Repose en paix
Re : Dessiner une courbe dans une image vierge d'un userform

Bonjour sen.sen ( et Staple )
Ci-jointe une solution qui peut t'aider ou t'inspirer pour afficher l'image d'une cellule Excel dans une image UserForm en passant par un métafichier wmf.

L'image source se trouve dans la cellule nommée Z_image1 (dans l'exemple Z_image1 est affectée à une seule cellule mais on peut l'affecter à une plage de cellule si on doit utiliser directement des résultats de cellules.
Dans cette zone dynamique nommée, on peut mettre tous les objets que l'on veut ( objets de dessins, graphique, textes, nombres, images ) et les lier à des cellules de données ou des calculs.
L'image WMF est détruite après chaque affichage.

Cordialement
Robert
 

Pièces jointes

  • RD-Image Excel dans UserForm.xls
    88 KB · Affichages: 205

Staple1600

XLDnaute Barbatruc
Re : Dessiner une courbe dans une image vierge d'un userform

Bonjour à tous

En farfouillant un peu partout sur le web, c'est des API qu'est venu la la lumière.
Pour tester, dans un classeur, crées un userform
Colles-y ce code, affiche l'userform et cliques dessus
Restes maintenant à chercher plus d'infos sur Function SetPixel pour aller plus loin.
Je te laisse mener ces recherches là ;)
Code:
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Sub UserForm_Initialize()
Me.Width = 615
Me.Height = 235
End Sub

Private Sub UserForm_Click()
Dim Ret As Long, vX, vY
Ret = GetForegroundWindow()
Ret = GetDC(Ret)
'code courbe adapté d'un exemple de jacxl
For vX = 1 To 800 Step 0.05
vY = 127 + 127 * Sin(vX / 50)
Call SetPixel(Ret, vX, vY, vbGreen)
Next
End Sub
 

Herdet

Nous a quitté
Repose en paix
Re : Dessiner une courbe dans une image vierge d'un userform

Bonjour à tous

En farfouillant un peu partout sur le web, c'est des API qu'est venu la la lumière.
Bonjour Staple,
Super le code
Coincidence, si c'est du même Jacxl dont nous parlons (Formation Excel), un ami de longue date que j'ai croisé hier au pied de mon immeuble.
Nouveau retraité heureux et en pleine forme !
A+
Robert
 

Staple1600

XLDnaute Barbatruc
Re : Dessiner une courbe dans une image vierge d'un userform

Re

Herdet
Oui celui-là même ;)
Je ne connais pas le garcon mais G..gle si, ainsi que les API ;)

Charge maintenant à seb.seb de se colleter la compréhension de l'usage de SetPixel ;)

A moins que l'aventure te tente, Herdet ;) ?


seb.seb
Pour info: .PSet s'utilise avec un contrôle PictureBox qui n'est pas utilisable en VBA.
Ce qui explique que ton code dans ta PJ ne fonctionnait pas
 
Dernière édition:

Herdet

Nous a quitté
Repose en paix
Re : Dessiner une courbe dans une image vierge d'un userform

Re

Herdet
...compréhension de l'usage de SetPixel ;)
A moins que l'aventure te tente, Herdet ;) ?
Pour une satisfaction intellectuelle et faire travailler les neurones en sommeil, c'est tentant mais comprendre et pratiquer les API Windows est un gros challenge même avec l'ami Go...le et un bon traducteur d'anglais.

J'ai retrouvé une vieille application de dessin technique automatique sur feuilles Excel que j'avais faite en 1999 en macros Excel4.
Elle manipulaient des objets de dessin (lignes, rectangles, cercles, cotations, axes et j'en passe) ce qui pourrait servir de modèle mais bon, le codage en VBA, serait déjà un gros travail mais en API c'est une autre affaire.
 

seb.seb

XLDnaute Nouveau
Re : Dessiner une courbe dans une image vierge d'un userform

Re

Herdet
Oui celui-là même ;)
Je ne connais pas le garcon mais G..gle si, ainsi que les API ;)

Charge maintenant à seb.seb de se colleter la compréhension de l'usage de SetPixel ;)

A moins que l'aventure te tente, Herdet ;) ?


seb.seb
Pour info: .PSet s'utilise avec un contrôle PictureBox qui n'est pas utilisable en VBA.
Ce qui explique que ton code dans ta PJ ne fonctionnait pas

Effectivement "Pset" fonctionne avec vb6 par exemple donc ça ne fonctionnera pas en vba.
Je vais essayer d'adapter "SetPixel" à un cas plus général.

Merci pour l'info.
Je vous tiens au courant dès que j'ai quelque chose d'intéressant.
 

Staple1600

XLDnaute Barbatruc
Re : Dessiner une courbe dans une image vierge d'un userform

Bonjour à tous

seb.seb
Tu as essayé mon code VBA du message #5 ?
Cela fonctionne chez toi ?

Merci en tout cas de nous faire ton feedback quand tu auras peaufiner ton code avec SetPixel;)
 

seb.seb

XLDnaute Nouveau
Re : Dessiner une courbe dans une image vierge d'un userform

Bonjour à tous

seb.seb
Tu as essayé mon code VBA du message #5 ?
Cela fonctionne chez toi ?

Merci en tout cas de nous faire ton feedback quand tu auras peaufiner ton code avec SetPixel;)


Oui Staple1600, ton code fonctionne très bien,

Je l'ai adapté à mon cas sans soucis je t'en remercie (mon but était de créer un graphique représentant l'altimétrie d'un parcours en fonction de la distance parcourue, chaque point étant d'une couleur différente suivant la pente en (%)).

J'ai utilisé l'API "setpixel" pour les coordonnées et "lineto" pour tracer des lignes.
L'API "movetoex" me servant à définir un point de départ différent de l'abscisse zéro.

Pour info, on ne peut pas récupérer le handle d'une image dans un userform car c'est le même que celui du userform (ceci est valable pour la plupart des contrôles d'un userform sauf pour le frame et la listebox d'après ce que j'ai testé). Celà signifie que dans mon cas, insérer une image pour dessiner dedans n'a pas d'intérêt, je le fais directement dans le userform ou alors je me sers du frame comme image.

J'ai joint mon code espérant que ça puisse servir à d'autres personnes ultérieurement.


Merci à toi Staple1600.


Lien supprimé


Code:
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare PtrSafe Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare PtrSafe Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare PtrSafe Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Const PS_SOLID = 0
Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare PtrSafe Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As Long) As Long


Private Sub UserForm_Click()
    
    Dim i As Long
    Dim Ret As Long, vX, vY
    Dim Handle As Long
    Dim Clr_RGB_Rouge, Clr_RGB_Vert, Clr_RGB_Bleue As Long
    Dim hPen As Long
    Dim x_debut, y_debut As Double
    Dim Taille_Ligne As Long
    
    Taille_Ligne = 3
    
    Handle = FindWindow(vbNullString, Me.Caption)
    Ret = GetDC(Handle)
    
    i = 1
    
    x_debut = Fonction_Mise_Echelle_Graphique(Tbl_Donnee_Distance_Cumulee_Sans_Pause(i), 0, Position_UserForm1_Width_Pixel, 0, 1, _
                                                Debut_Zoom_Graphique_Axe_X, Fin_Zoom_Graphique_Axe_X)
    
    y_debut = Position_UserForm1_Height_Pixel - Fonction_Mise_Echelle_Graphique(Tbl_Donnee_Altitude(i), 0, Position_UserForm1_Height_Pixel, 0.05, 0.95, _
                                                Tbl_Donnee_Altitude_Extremum(1), Tbl_Donnee_Altitude_Extremum(2))
    
    
    For i = 2 To Nb_TrackPoint Step 1
        
        
        vX = Fonction_Mise_Echelle_Graphique(Tbl_Donnee_Distance_Cumulee_Sans_Pause(i), 0, Position_UserForm1_Width_Pixel, 0, 1, _
                                                Debut_Zoom_Graphique_Axe_X, Fin_Zoom_Graphique_Axe_X)
        
        vY = Position_UserForm1_Height_Pixel - Fonction_Mise_Echelle_Graphique(Tbl_Donnee_Altitude(i), 0, Position_UserForm1_Height_Pixel, 0.05, 0.95, _
                                                Tbl_Donnee_Altitude_Extremum(1), Tbl_Donnee_Altitude_Extremum(2))
        
        For k = 1 To Nb_Groupe_Pente_Altimetrie
            
            If Abs(Tbl_Donnee_Pente_Intervalle(i)) >= Tbl_Debut_Groupe_Pente_Altimetrie(k) _
                        And Abs(Tbl_Donnee_Pente_Intervalle(i)) < Tbl_Fin_Groupe_Pente_Altimetrie(k) Then
                    
                Clr_RGB_Rouge = Tbl_Couleur_Groupe_Pente_Altimetrie(k, 1)
                Clr_RGB_Vert = Tbl_Couleur_Groupe_Pente_Altimetrie(k, 2)
                Clr_RGB_Bleue = Tbl_Couleur_Groupe_Pente_Altimetrie(k, 3)
                
            End If
            
        Next k
        
        Call SetPixel(Ret, vX, vY, RGB(Clr_RGB_Rouge, Clr_RGB_Vert, Clr_RGB_Bleue))
        
        hPen = CreatePen(PS_SOLID, Taille_Ligne, RGB(Clr_RGB_Rouge, Clr_RGB_Vert, Clr_RGB_Bleue)) 'create a new pen
        DeleteObject SelectObject(Ret, hPen) 'Select our pen into the form's device context and delete the old pen
        
        If i = 2 Then
            
            MoveToEx Ret, x_debut, y_debut, 0&
            
        End If
        
        LineTo Ret, vX, vY
        DeleteObject hPen
        
    Next
    
    
End Sub



    
End Sub
 

Herdet

Nous a quitté
Repose en paix
Re : Dessiner une courbe dans une image vierge d'un userform

Bonjour,

Staple1600
"A moins que l'aventure te tente, Herdet ?"
Bon, je t'ai pris au mot et commencé à explorer les fonctions API ( que j'ai toujours négligées, dommage ! )
Dans un Userform, on peut faire à peu près tout ce que l'on veut avec les centaines de fonctions API qui existent
Ci-joint un petit fichier d'exploration "brut de décoffrage"

Je suis tenté maintenant d'aller plus loin et de passer mon application de dessin Excel4 en VBA et en API dans une UserForm et si possible avec un transfert de la UserForm dans une image ( GetPixel et SetPixel, je pense )

seb.seb
Bien, ton adaptation.
Dans le fichier joint, il y a un exemple de tracé en API à partir d'un tableau de données (feuille PARAM).
Pour ta courbe, il serait plus facile de créer un tableau de points X,Y dans une feuille de calcul avec des formules puis adapter le code "' polygone dessiné avec tableau de données" de la Sub Dessiner_dans_userform de mon fichier.
L'avantage est la visualisation directe des données en tableau plutôt que du pur VBA illisible.

A+
Robert
 

Pièces jointes

  • HERDET-API -fonctions dessin dans Userform.xlsm
    67 KB · Affichages: 267

seb.seb

XLDnaute Nouveau
Re : Dessiner une courbe dans une image vierge d'un userform

Bonjour,

Staple1600
"A moins que l'aventure te tente, Herdet ?"
Bon, je t'ai pris au mot et commencé à explorer les fonctions API ( que j'ai toujours négligées, dommage ! )
Dans un Userform, on peut faire à peu près tout ce que l'on veut avec les centaines de fonctions API qui existent
Ci-joint un petit fichier d'exploration "brut de décoffrage"

Je suis tenté maintenant d'aller plus loin et de passer mon application de dessin Excel4 en VBA et en API dans une UserForm et si possible avec un transfert de la UserForm dans une image ( GetPixel et SetPixel, je pense )

seb.seb
Bien, ton adaptation.
Dans le fichier joint, il y a un exemple de tracé en API à partir d'un tableau de données (feuille PARAM).
Pour ta courbe, il serait plus facile de créer un tableau de points X,Y dans une feuille de calcul avec des formules puis adapter le code "' polygone dessiné avec tableau de données" de la Sub Dessiner_dans_userform de mon fichier.
L'avantage est la visualisation directe des données en tableau plutôt que du pur VBA illisible.

A+
Robert

Bonjour Herdet,

Effectivement les données dans un tableau excel sont plus visibles, c'est d'ailleurs ce que j'ai fait mais je ne l'ai pas montré ici (je mets à jour le tableau excel au début à partir des données vba car les données d'entrée ne changent pas). Mais après j'y touche plus car le but est que le programme soit très rapide lors de son exécution d'où le souhait de tout faire par vba et de passer par excel que pour vérifier les étapes intermédiaires importantes et le résultat final).
C'est d'ailleurs pour celà qu'à la base je souhaitais que le graphique soit dessiner dans un userform plutôt que dans un graphique excel (toujours dans un but de fluidité de l'application).

Du coup avec cette méthode, j'en retire les avantages des deux partis, celà me convient parfaitement.



Merci pour ta contribution, le listing des API est très intéressant.
Les API ont effectivement beaucoup de fonction intéressante à exploiter pour les userforms.
 

Herdet

Nous a quitté
Repose en paix
Re : Dessiner une courbe dans une image vierge d'un userform

...le but est que le programme soit très rapide lors de son exécution d'où le souhait de tout faire par vba et de passer par excel que pour vérifier les étapes intermédiaires importantes et le résultat final

Du coup avec cette méthode, j'en retire les avantages des deux partis, celà me convient parfaitement.
.
Boujour,
C'est ce que j'appelle optimiser Excel : tableau de calcul dynamique performant, facilement vérifiable et exécution des taches en VBA et en l' occurence en API, on peut difficilement faire plus rapide.

S'il n'y a pas de styles à appliquer, on doit pouvoir traiter les données en bloc plutôt que par For..Next ou Do...Loop en passant tout dans un tableau de XY puis avec la fonction Call PolyPolygon (hdc, pts(0), numpoints(0), 2)

Voir exemple: Lines

Robert
 

Staple1600

XLDnaute Barbatruc
Re : Dessiner une courbe dans une image vierge d'un userform

Bonsoir à tous

seb.seb
Merci pour ton feedback
Mais peux tu joindre un fichier Excel permettant de tester ton code, car en l'état, on ne peut pas le tester
(Il manque par exemple les données pour remplir Tbl_Donnee_Distance_Cumulee_Sans_Pause(i) et autres Arrays
Il n'y pas non plus quelques functions comme Fonction_Mise_Echelle_Graphique etc...)


Herdet
Happy que l'API t'est titillé ;)
Je vais tester ta PJ de ce pas ;)
 

Discussions similaires

Réponses
29
Affichages
1 K

Membres actuellement en ligne

Statistiques des forums

Discussions
314 499
Messages
2 110 249
Membres
110 711
dernier inscrit
chmessi