Dessin vectoriel

Question

Bonjour à toutes et tous,

Tout d'abord : Bonne Année 2013 à tous !

Je voudrais savoir s'il est possible de 'dessiner' du vectoriel en VB.Net ?
Je cherche à mettre en place un modèle avec la possibilité de lui affecter une homothétie, une rotation et de le dupliquer N fois.

Est-ce possible ?

Je n'ai rien trouvé sur ce sujet, merci de m'indiquer une piste de travail !

Olivier

Zermelo · Answer

Bonjour guilleto.

Ce que vous voulez faire s'appelle du traitement d'image. C'est sûrement possible en vb.net. Vous pouvez consulter le code source relatif à l'étirement d'image que j'ai déposé sur ce site. Voilà pour l'homothétie. La duplication n'est pas un problème : il est possible de cloner un image. Quant aux rotations, on devrait pouvoir les réaliser grâce au calcul matriciel, présent sur Vb 2010 Express.

Si vous mettez tout cela au point, ce sera un fameux code source. Bon courage.


Étant illettré, je signe d'une croix : ×

guilleto · Answer

Bonjour Zermelo,

Merci de m'avoir répondu

En fait ce que je souhaite réaliser c'est :
1°) Dessiner un schéma (n'importe lequel) au format vectoriel
2°) Pouvoir l'agrandir ou le rétrécir sans perdre d'info (trait) d'où le vectoriel.
3°) Pouvoir réaliser des rotations, pour ce qui est du matriciel de vb ... Heu joker ;)

Par avance merci

Olivier

Zermelo · Answer

J'ai bien précisé que ce que peut faire vb.net est du traitement d'image. Il faudra donc apprendre à dessiner vos schémas sur une "image" au sens de vb.net, c'est-à-dire en pratique un bitmap. Le coté vectoriel n'apparaîtra que par les traitements que vous ferez sur ce bitmap.
Je vous recommande donc tout d'abord d'apprendre à fabriquer des bitmaps, et pour cela de consulter sur le net le tutoriel de Philippe Lasserre. Parallèlement à cela, il vous faudra apprendre un peu de mathématique : comment effectuer une transformation linéaire sur une figure géométrique. Ce n'est qu'après que vous pourrez voir comment appliquer cette théorie avec le traitement matriciel de vb.net.

Je suis tout à fait disposé à vous aider pas à pas, à condition que vous ne me parliez plus de joker, mais seulement de boulot.

Donc, au travail !


Étant illettré, je signe d'une croix : ×

guilleto · Answer

Bonsoir,

J'ai bien lu le tutoriel de Philippe Lasserre (très bien d'ailleurs) mais il y a un exemple sur la création d'un bitmap avec le e.graphics et une indication sur un 2ème mode vectoriel qui (sauf erreur) n'est pas traité !

J'ai trouvé (sur Internet) une méthode qui me permet de réaliser des figures 'simples' et de pouvoir les sélectionner, déplacer ou supprimer mais si je veux faire une forme plus complexe cela ne fonctionne pas !

En effet, un rectangle, une ellipse, un polygône : cela fonctionne car seuls les traits extérieurs sont tracés, si je souhaite (et c'est mon cas) ajouter des traits à l'intérieur d'un rectangle ... cela me donne n'importe quoi !
Je me suis inspiré de ce code : http://www.developpez.net/forums/d1132494/dotnet/langages/vb-net/dessiner-rectangles-pouvoir-deplacer/

En revanche, je suis toujours partant pour une petite explication sur les matrices pour une rotation car j'avoue ne pas voir comment réaliser cela !

Merci d'avance

Olivier

Zermelo · Answer

Bonsoir.

Traitons un problème à la fois. Vous me dites avoir dessiné des figures simples. Bien. Et vous ajoutez ne pas savoir dessiner un trait à l'intérieur d'un rectangle. Or cela est incompréhensible. Je vous demande en conséquence de m'envoyer votre code, en n'oubliant pas la coloration syntaxique.

À bientôt.


Étant illettré, je signe d'une croix : ×

Utilisateur anonyme · Answer

Bonsoir, Voici un code célèbre pour faire tourner un cube en 3d. Tu peux te baser dessus pour réaliser ton projet. ' ' Simulation of a Rotating Cube using GDI+ ' Developed by leonelmachava ' http://codentronix.com ' Imports System.Drawing.Graphics Imports System.Drawing.Color Imports System.Drawing.Brush Imports System.Drawing.Point Public Class Main Protected m_timer As Timer Protected m_vertices(8) As Point3D Protected m_faces(6, 4) As Integer Protected m_colors(6) As Color Protected m_brushes(6) As Brush Protected m_angle As Integer Private Sub Main_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load ' Enable double-buffering to eliminate flickering. Me.SetStyle(ControlStyles.AllPaintingInWmPaint, True) Me.SetStyle(ControlStyles.OptimizedDoubleBuffer, True) InitCube() ' Create the timer. m_timer = New Timer() ' Set the timer interval to 25 milliseconds. This will give us 1000/25 ~ 40 frames per second. m_timer.Interval = 25 ' Set the callback for the timer. AddHandler m_timer.Tick, AddressOf AnimationLoop ' Start the timer. m_timer.Start() End Sub Private Sub InitCube() ' Create the cube vertices. m_vertices = New Point3D() { New Point3D(-1, 1, -1), New Point3D(1, 1, -1), New Point3D(1, -1, -1), New Point3D(-1, -1, -1), New Point3D(-1, 1, 1), New Point3D(1, 1, 1), New Point3D(1, -1, 1), New Point3D(-1, -1, 1)} ' Create an array representing the 6 faces of a cube. Each face is composed by indices to the vertex array ' above. m_faces = New Integer(,) {{0, 1, 2, 3}, {1, 5, 6, 2}, {5, 4, 7, 6}, {4, 0, 3, 7}, {0, 4, 5, 1}, {3, 2, 6, 7}} ' Define the colors of each face. m_colors = New Color() {Color.BlueViolet, Color.Cyan, Color.Green, Color.Yellow, Color.Violet, Color.LightSkyBlue} ' Create the brushes to draw each face. Brushes are used to draw filled polygons. For i = 0 To 5 m_brushes(i) = New SolidBrush(m_colors(i)) Next End Sub Private Sub AnimationLoop() ' Forces the Paint event to be called. Me.Invalidate() ' Update the variable after each frame. m_angle += 1 End Sub Private Sub Main_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint Dim t(8) As Point3D Dim f(4) As Integer Dim v As Point3D Dim avgZ(6) As Double Dim order(6) As Integer Dim tmp As Double Dim iMax As Integer ' Clear the window e.Graphics.Clear(Color.LightBlue) ' Transform all the points and store them on the "t" array. For i = 0 To 7 Dim b As Brush = New SolidBrush(Color.White) v = m_vertices(i) t(i) = v.RotateX(m_angle).RotateY(m_angle).RotateZ(Me.m_angle) t(i) = t(i).Project(Me.ClientSize.Width, Me.ClientSize.Height, 256, 4) Next ' Compute the average Z value of each face. For i = 0 To 5 avgZ(i) = (t(m_faces(i, 0)).Z + t(m_faces(i, 1)).Z + t(m_faces(i, 2)).Z + t(m_faces(i, 3)).Z) / 4.0 order(i) = i Next ' Next we sort the faces in descending order based on the Z value. ' The objective is to draw distant faces first. This is called ' the PAINTERS ALGORITHM. So, the visible faces will hide the invisible ones. ' The sorting algorithm used is the SELECTION SORT. For i = 0 To 4 iMax = i For j = i + 1 To 5 If avgZ(j) > avgZ(iMax) Then iMax = j End If Next If iMax <> i Then tmp = avgZ(i) avgZ(i) = avgZ(iMax) avgZ(iMax) = tmp tmp = order(i) order(i) = order(iMax) order(iMax) = tmp End If Next ' Draw the faces using the PAINTERS ALGORITHM (distant faces first, closer faces last). For i = 0 To 5 Dim points() As Point Dim index As Integer = order(i) points = New Point() { New Point(CInt(t(m_faces(index, 0)).X), CInt(t(m_faces(index, 0)).Y)), New Point(CInt(t(m_faces(index, 1)).X), CInt(t(m_faces(index, 1)).Y)), New Point(CInt(t(m_faces(index, 2)).X), CInt(t(m_faces(index, 2)).Y)), New Point(CInt(t(m_faces(index, 3)).X), CInt(t(m_faces(index, 3)).Y)) } e.Graphics.FillPolygon(m_brushes(index), points) Next End Sub End Class ' ' Defines the Point3D class that represents points in 3D space. ' Developed by leonelmachava ' http://codentronix.com ' Public Class Point3D Protected m_x As Double, m_y As Double, m_z As Double Public Sub New(ByVal x As Double, ByVal y As Double, ByVal z As Double) Me.X = x Me.Y = y Me.Z = z End Sub Public Property X() As Double Get Return m_x End Get Set(ByVal value As Double) m_x = value End Set End Property Public Property Y() As Double Get Return m_y End Get Set(ByVal value As Double) m_y = value End Set End Property Public Property Z() As Double Get Return m_z End Get Set(ByVal value As Double) m_z = value End Set End Property Public Function RotateX(ByVal angle As Integer) As Point3D Dim rad As Double, cosa As Double, sina As Double, yn As Double, zn As Double rad = angle * Math.PI / 180 cosa = Math.Cos(rad) sina = Math.Sin(rad) yn = Me.Y * cosa - Me.Z * sina zn = Me.Y * sina + Me.Z * cosa Return New Point3D(Me.X, yn, zn) End Function Public Function RotateY(ByVal angle As Integer) As Point3D Dim rad As Double, cosa As Double, sina As Double, Xn As Double, Zn As Double rad = angle * Math.PI / 180 cosa = Math.Cos(rad) sina = Math.Sin(rad) Zn = Me.Z * cosa - Me.X * sina Xn = Me.Z * sina + Me.X * cosa Return New Point3D(Xn, Me.Y, Zn) End Function Public Function RotateZ(ByVal angle As Integer) As Point3D Dim rad As Double, cosa As Double, sina As Double, Xn As Double, Yn As Double rad = angle * Math.PI / 180 cosa = Math.Cos(rad) sina = Math.Sin(rad) Xn = Me.X * cosa - Me.Y * sina Yn = Me.X * sina + Me.Y * cosa Return New Point3D(Xn, Yn, Me.Z) End Function Public Function Project(ByVal viewWidth, ByVal viewHeight, ByVal fov, ByVal viewDistance) Dim factor As Double, Xn As Double, Yn As Double factor = fov / (viewDistance + Me.Z) Xn = Me.X * factor + viewWidth / 2 Yn = Me.Y * factor + viewHeight / 2 Return New Point3D(Xn, Yn, Me.Z) End Function End Class

guilleto · Answer

Bonjour banana32,

Merci pour ce code ! Il fonctionne bien !

Pour mon projet, j'ai une image 2D que je dois placer dans une picturebox et cette image doit pouvoir être dupliquer, modifier (rotation), supprimer ou déplacer !
Le code que j'utilise me permet d'ors et déjà de faire toutes les actions ci-dessus sauf que cela fonctionne uniquement avec des formes simples (un rectangle par exemple).
Je place un cercle avec que les contours : ça fonctionne !
Mais le même cercle avec des lignes dedans ... ça m'affiche n'importe quoi !
Le code étant trop long, voici l'URL : 
http://www.developpez.net/forums/d1132494/dotnet/langages/vb-net/dessiner-rectangles-pouvoir-deplacer/

En espérant que vous pourrez me sortir de cette impasse.

Par avance merci

Olivier

ucfoutu · Answer

Bonjour,
- lire, relire au besoin, attentivement ceci, de chez wikimachin mais assez bien exprimé :
Tapez le texte de l'url ici.
- comprendre dès lors la nécessité de l'utilisation d'une base de données pour chaque trait et ses "points marquants", chaque surface, etc ...
- le reste sera toujours le résultat de l'utilisation de cette base, qu'il s'agisse d'agir sur l'ensemble, sur un seul élément ou encore sur une sélection d'éléments.
Tu as beaucoup de boulot à prévoir et je n'ose même pas de parler d'autres aspects (mémorisation, dans certains cas de figure, de ce qui était présent là où un élément (un trait) est dessiné).
Bonne chance.
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

ucfoutu · Answer

Ah oui : ne pas oublier de mettre dans la base également de quoi mémoriser les Zorders relatifs.


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

Utilisateur anonyme · Answer

Voici un petit exemple pour faire tourner un cercle selon un angle voulu :
Option Strict On
Public Class Form1
    Dim pctBox As New PictureBox With {.Parent Me, .BorderStyle BorderStyle.FixedSingle, .Bounds = New Rectangle(0, 0, 202, 202)}
    Dim MonImage As Image
    Dim b As Bitmap
    Dim g As Graphics
    Dim tmr As New Timers.Timer(10)
    Dim angle As Integer

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        MonImage = CreeImage()
        pctBox.Image = MonImage
        b = New Bitmap(MonImage)
        g = Graphics.FromImage(b)
        AddHandler tmr.Elapsed, AddressOf tmr_Elapsed
        tmr.Start()
    End Sub

    Private Function CreeImage() As Image
        Dim bi As Bitmap = New Bitmap(200, 200)
        Dim gi As Graphics = Graphics.FromImage(bi)
        gi.FillEllipse(Brushes.GreenYellow, New Rectangle(0, 0, 200, 200))
        gi.DrawLine(Pens.Yellow, 0, 100, 200, 100)
        gi.DrawLine(Pens.Blue, 100, 0, 100, 200)
        gi.DrawEllipse(Pens.Red, New Rectangle(0, 0, 199, 199))
        Return CType(bi.Clone, Image)
    End Function

    Private Sub tmr_Elapsed(ByVal sender As Object, ByVal e As Timers.ElapsedEventArgs)
        angle += 1
        If angle > 360 Then angle = 0
        Dim m As New Drawing2D.Matrix
        Dim bi As New Bitmap(b)
        Dim g As Graphics = Graphics.FromImage(bi)
        m.RotateAt(angle, New Point(100, 100))
        g.Transform = m
        g.DrawImage(bi, New Point(0, 0))
        'tu peux sauvegarder tes images ici
        'bi.Save("pic" & angle.ToString & ".jpg")
        pctBox.Image = CType(bi.Clone, Image)
    End Sub

End Class

Zermelo · Answer

Bonjour Guilleto.

Revenons à nos moutons. Vous voulez en premier lieu dessiner sur un PictureBox diverses figures, mais vous ne parvenez pas à dessiner quoi que ce soit à l'intérieur d'un rectangle, ce qui me sidère. Vous ne m'avez pas d'ailleurs montré le bout de code de votre essai, sous le prétexte incompréhensible qu'il était trop long.
Pour vous prouvez qu'il est possible de réaliser cette sorte de dessin, je vous propose d'exécuter le code suivant, que j'ai détaillé le plus possible pour la compréhension, mais qui gagnerait à être compacté. Noter que pBox est un PicturePox déposé sur un formulaire nommé Accueil.

Public Class Acceuil
    Private Clr As Color
    Private Crn As New Pen(Clr)
    Private Pnc As New SolidBrush(Clr)
    Private NomFnt As String, TailleFnt As Single, StyleFnt As FontStyle, Fnt As Font

    Private Sub pBox_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles pBox.Paint
        Dim Grp As Graphics
        Grp = e.Graphics

        'Dessin d'un texte
        NomFnt "Times New Roman" : TailleFnt 10 : StyleFnt = FontStyle.Bold
        Fnt = New Font(NomFnt, TailleFnt, StyleFnt)
        Clr = Color.FromArgb(255, 0, 127, 0)
        Pnc.Color = Clr
        Grp.DrawString("Et voici un segment de droite dans un rectangle", Fnt, Pnc, 0, 0)

        'Dessin d'un rectangle
        Clr = Color.FromArgb(255, 255, 0, 0)
        With Crn
            .Color = Clr
            .Width = 3
        End With
        Grp.DrawRectangle(Crn, 16, 16, 160, 80)

        'Dessin d'un segment de droite
        Clr = Color.FromArgb(255, 0, 0, 255)
        With Crn
            .Color = Clr
            .Width = 2
        End With
        Grp.DrawLine(Crn, 32, 32, 160, 80)

        'Dessin d'un texte
        NomFnt "Courier New" : TailleFnt 8 : StyleFnt = FontStyle.Italic Or FontStyle.Underline
        Fnt = New Font(NomFnt, TailleFnt, StyleFnt)
        Clr = Color.FromArgb(255, 255, 0, 255)
        Pnc.Color = Clr
        Grp.DrawString("CQFD", Fnt, Pnc, 150, 100)
    End Sub

End Class

Voila. C'est un tout petit pas. Il en faudra bien d'autres pour atteindre votre objectif. Je vous prie de me faire savoir si vous voulez continuer dans cette voie.

Cordialement.





Étant illettré, je signe d'une croix : ×

guilleto · Answer

Bonjour Banana32, Zermelo,

Merci pour ces codes, je vous mets celui que j'utilise afin que vous puissiez comprendre ce que je souhaite réaliser !

Pour le Formulaire :

' http://www.developpez.net/forums/d1132494/dotnet/langages/vb-net/dessiner-rectangles-pouvoir-deplacer/

'Ajouter :
'-un Control Panel scrollable 
'-un ContextMenuStrip nomme "ctxMenuStripShapes" avec
'sa collection de 3 sous-menus 
'-ctxMnuAddRectangle
'-ctxMnuAddEllipse
'-ctxAddTriangle
'NB:cet exemple un contexte menu propre au controle CustomShape et
'un autre context menu propre au Form(qui aurait pus etre un menu)

Public Class Form1
  Private shp As CustomShape.CustomShape
  Public Sub New()

    ' Cet appel est requis par le Concepteur Windows Form.
    InitializeComponent()

    ' Ajoutez une initialisation quelconque après l'appel InitializeComponent().
    'Affecte le ContextMenuStrip au Form
    Me.ContextMenuStrip = Me.ctxMenuStripShapes
    Me.Panel1.Dock = DockStyle.Fill
    Me.Panel1.BackColor = Color.Transparent ' Color.WhiteSmoke
    'Active le srolling
    Me.Panel1.AutoScroll = True
  End Sub


  Private Sub AddTerrain_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ctxMnuAddTerrain.Click
    shp = New CustomShape.CustomShape
    shp.Type = CustomShape.CustomShape.ShapeType.Terrain
    shp.Width = 134 * 2
    shp.Height = 61 * 2
    shp.ForeColor = Color.Black
    'ajoute à liste Panel1
    Me.Panel1.Controls.Add(shp)

  End Sub


  Private Sub AddRectangle_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ctxMnuAddRectangle.Click
    shp = New CustomShape.CustomShape
    shp.Type = CustomShape.CustomShape.ShapeType.Rectangle
    shp.Width = 100
    shp.Height = 100
    shp.ForeColor = Color.Black
    'ajoute à liste Panel1
    Me.Panel1.Controls.Add(shp)

  End Sub

  Private Sub AddEllipse_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ctxMnuAddEllipse.Click
    shp = New CustomShape.CustomShape
    shp.Type = CustomShape.CustomShape.ShapeType.Ellipse
    shp.Width = 100
    shp.Height = 60
    shp.ForeColor = Color.Black
    'ajoute à liste Panel1
    Me.CustomPanelGrid1.Controls.Add(shp)

  End Sub

  Private Sub addTriangle_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ctxAddTriangle.Click
    shp = New CustomShape.CustomShape
    shp.Type = CustomShape.CustomShape.ShapeType.Triangle
    shp.Width = 100
    shp.Height = 100
    shp.ForeColor = Color.Black
    'ajoute à liste Panel1
    Me.Panel1.Controls.Add(shp)

  End Sub

  Private Sub ctxMnuShowGrid_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ctxMnuShowGrid.Click
    Me.Panel1.ShowGrid = Not Me.Panel1.ShowGrid
    Me.ctxMnuShowGrid.Checked = Not Me.ctxMnuShowGrid.Checked
  End Sub

End Class


Pour le control CustomShape :

'NB: Les props BackColor, ForeColor, Location, ou
'Size, sont construites ad-hoc dans le controle de base CustomShape.
'ASTUCE:pour eviter de recreer brushes et pens chaque fois qu'une shape est dessinee, on peut creer brush
'& pen une seule fois et les memoriser comme variables membres. 
'Mais alors=>il faut 
'soit : s'assurer chaque fois que Brush et Pen n'ont pas ete change  
'avant de commencer à dessiner 
'soit: implementer les evenements ForeColorChanged & BackColorChanged events.
'
'
'Ajouter dans le Designer 
'01 ContextMenuStrip nomme "mnuShape" 
'et sa collection de 4 sous-menu:
'-mnuFillColorChange
'-mnuRemoveShape
'-mnuBringToFront
'-mnuBringToFront
Imports System.Drawing.Drawing2D
Public Class CustomShape
  'Inherits System.Windows.Forms.Control
  'Met en surbrillance selection
  Private selectionForeColor As Color = Color.Yellow
  'BackStore du ForeColor pour retablir apres deselection
  Private oldForeColor As Color

  ' Shape courant.
  Private shape As ShapeType = ShapeType.Rectangle
  Private path As GraphicsPath
  ' le type de shapes supporte par ce controle.
  Public Enum ShapeType
    Rectangle
    Ellipse
    Triangle
    Terrain
  End Enum

  Public Sub New()
    ' Cet appel est requis par le Concepteur Windows Form.
    InitializeComponent()
    ' Ajoutez une initialisation quelconque après l'appel InitializeComponent().
    'Affecte le ContextMenuStrip au controle
    Me.ContextMenuStrip = Me.mnuShape
    oldForeColor = Me.ForeColor
  End Sub

  Public Property Type() As ShapeType
    Get
      Return shape
    End Get
    Set(ByVal value As ShapeType)
      shape = value
      RefreshPath()
      Me.Invalidate()
    End Set
  End Property
  ' Cree le GraphicsPath correspondant pour shape, 
  ' et l'affecte à la prop Region du controle .
  ' Rappel: le Region d'un controle est sa zone interactive
  Private Sub RefreshPath()
    If path IsNot Nothing Then path.Dispose()
    path = New GraphicsPath()
    Select Case shape
      Case ShapeType.Terrain
        Dim X1, X2, X3, X4, X5, X6 As Integer
        Dim Y1, Y2, Y3, Y4, Y5 As Integer
        X1 0 : X2 Me.Width * 0.0582 : X3 = Me.Width * 0.3507 : X4 = Me.Width * 0.6493 : X5 = Me.Width * 0.9418 : X6 = Me.Width * 1
        Y1 0 : Y2 Me.Height * 0.0787 : Y3 = Me.Height * 0.5 : Y4 = Me.Height * 0.9213 : Y5 = Me.Height * 1
        path.AddLine(X1, Y1, X1, Y5)
        path.AddLine(X2, Y1, X2, Y5)
        path.AddLine(X3, Y1, X3, Y5)
        path.AddLine(X4, Y1, X4, Y5)
        path.AddLine(X5, Y1, X5, Y5)
        path.AddLine(X6, Y1, X6, Y5)

        path.AddLine(X1, Y1, X6, Y1)
        path.AddLine(X1, Y2, X6, Y2)
        path.AddLine(X1, Y4, X6, Y4)
        path.AddLine(X1, Y5, X6, Y5)

        path.AddLine(X1, Y3, X3, Y3)
        path.AddLine(X4, Y3, X6, Y3)

        'Dim Rects(17) As Rectangle
        'Rects(0) = New Rectangle(X1, Y1, X2, Y2)
        'Rects(1) = New Rectangle(X2, Y1, X3, Y2)
        'Rects(2) = New Rectangle(X3, Y1, X4, Y2)
        'Rects(3) = New Rectangle(X4, Y1, X5, Y2)
        'Rects(4) = New Rectangle(X5, Y1, X6, Y2)

        'Rects(5) = New Rectangle(X1, Y2, X2, Y3)
        'Rects(6) = New Rectangle(X2, Y2, X3, Y3)
        'Rects(7) = New Rectangle(X4, Y2, X5, Y3)
        'Rects(8) = New Rectangle(X5, Y2, X6, Y3)

        'Rects(9) = New Rectangle(X1, Y3, X2, Y4)
        'Rects(10) = New Rectangle(X2, Y3, X3, Y4)
        'Rects(11) = New Rectangle(X4, Y3, X5, Y4)
        'Rects(12) = New Rectangle(X5, Y3, X6, Y4)

        'Rects(13) = New Rectangle(X1, Y4, X2, Y5)
        'Rects(14) = New Rectangle(X2, Y4, X3, Y5)
        'Rects(15) = New Rectangle(X3, Y4, X4, Y5)
        'Rects(16) = New Rectangle(X4, Y4, X5, Y5)
        'Rects(17) = New Rectangle(X5, Y4, X6, Y5)

        'Dim Rects(5) As Rectangle
        'Rects(0) = New Rectangle(0, 0, Me.Width, Me.Height)
        ''Rects(1) = New Rectangle(0, Me.Height * 0.0787, Me.Width, Me.Height * 0.9213)
        ''Rects(2) = New Rectangle(Me.Width * 0.0582, 0, Me.Width * 0.9418, Me.Height )
        ''Rects(3) = New Rectangle(Me.Width * 0.3507, 0, Me.Width * 0.6492, Me.Height )
        ''Rects(4) = New Rectangle(0, 0, Me.Width , Me.Height * 0.5)
        ''Rects(5) = New Rectangle(Me.Width * 0.6492, 0, Me.Width , Me.Height * 0.5)
        'path.AddRectangles(Rects)

        'Dim pt1 As Point = New Point(0, 0)
        'Dim pt2 As Point = New Point(Me.Width, 0)
        'Dim pt3 As Point = New Point(Me.Width, Me.Height)
        'Dim pt4 As Point = New Point(0, Me.Height)

        'Dim pt5 As Point = New Point(0, Me.Height * 0.0787)
        'Dim pt6 As Point = New Point(Me.Width, Me.Height * 0.0787)
        'path.AddPolygon(New Point() {pt1, pt2, pt3, pt4, pt1, pt5, pt6, pt5})

      Case ShapeType.Rectangle
        path.AddRectangle(Me.ClientRectangle)
      Case ShapeType.Ellipse
        path.AddEllipse(Me.ClientRectangle)
      Case ShapeType.Triangle
        Dim pt1 As Point = New Point(Me.Width / 2, 0)
        Dim pt2 As Point = New Point(0, Me.Height)
        Dim pt3 As Point = New Point(Me.Width, Me.Height)
        path.AddPolygon(New Point() {pt1, pt2, pt3})
    End Select
    Me.Region = New Region(path)
  End Sub
  ' Redefinition  OnPaint
  Protected Overrides Sub OnPaint(ByVal e As System.Windows.Forms.PaintEventArgs)
    MyBase.OnPaint(e)
    If path IsNot Nothing Then
      Dim shapeBrush As New SolidBrush(Me.BackColor)
      Dim shapePen As New Pen(Me.ForeColor, 5)
      e.Graphics.SmoothingMode = SmoothingMode.AntiAlias
      e.Graphics.FillPath(shapeBrush, path)
      e.Graphics.DrawPath(shapePen, path)
      shapePen.Dispose()
      shapeBrush.Dispose()
    End If
  End Sub
  ' Redefinition  OnResize
  Protected Overrides Sub OnResize(ByVal e As System.EventArgs)
    MyBase.OnResize(e)
    RefreshPath()
    Me.Invalidate()
  End Sub

  'Enfin le  ConTextMenuStrip "mnuShape" propose 4 options. 
  '1ere , sur click autorise l'user à changer couleur 
  'de remplissage avec boite color dialog.
  'Le code retrouve le control shape actif avec la prop 
  'SourceControl du ContextMenuStrip
  Private Sub mnuColorChange_Click(ByVal sender As Object, ByVal e As EventArgs) Handles mnuFillColorChange.Click
    Dim colorDlg As New ColorDialog
    If colorDlg.ShowDialog() = DialogResult.OK Then
      Me.mnuShape.SourceControl.BackColor = colorDlg.Color
    End If
  End Sub
  '2eme  option autorise l'user à supprimer le shape courant selectionne.
  Private Sub mnuRemoveShape_Click(ByVal sender As Object, ByVal e As EventArgs) Handles mnuRemoveShape.Click
    Dim ctrl As Control
    ctrl = Me
    ctrl.Parent.Controls.Remove(Me)
  End Sub
  '2eme  option et 4eme option pour Z-Order.
  Private Sub mnuBringToFront_Click(ByVal sender As Object, ByVal e As EventArgs) Handles mnuBringToFront.Click
    Me.BringToFront()
  End Sub
  Private Sub mnuSendToBack_Click(ByVal sender As Object, ByVal e As EventArgs) Handles mnuSendToBack.Click
    Me.SendToBack()
  End Sub
  '- Click : selection du control position.
  '- Right-Click : affiche context menu, qui prevoit les option 
  ' -Delete Objet 
  ' -Change FillColor
  ' -BringToFront
  ' -SendToBack
  '- Click Coin Bas-Droit :redimensionnenement

  ' Garder une trace quand Dragging ou Redimensionnement sont actives.
  Private isDragging As Boolean = False
  Private isResizing As Boolean = False
  ' Memorise position ou l'user a clicke sur le controle.
  Private clickOffsetX, clickOffsetY As Integer
  Private Sub ctrl_MouseDown(ByVal sender As Object, _
  ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown
    ' Retrouve une reference du shape actif.
    Dim currentCtrl As Control
    currentCtrl = CType(sender, Control)
    If e.Button = MouseButtons.Right Then
      ' Affiche context menu.
      mnuShape.Show(currentCtrl, New Point(e.X, e.Y))

    ElseIf e.Button = MouseButtons.Left Then
      '  Redimensionnement
      clickOffsetX = e.X
      clickOffsetY = e.Y
      If currentCtrl.Cursor = Cursors.SizeNWSE Or _
      currentCtrl.Cursor = Cursors.SizeNS Or _
      currentCtrl.Cursor = Cursors.SizeWE Then
        ' pointeur souris est sur l'un des cotes 
        ' aussi le redimensionnement est approprie.
        isResizing = True
      Else
        ' Sinon  Mode Dragging est approprie.
        isDragging = True
      End If
    End If
  End Sub

  'MouseMove change position ou taille suivant mode "drag" ou "resize"
  'MouseMove change aussi le curseur (feedback user) à un "icon resize" 
  'pour alerter l'user quand pointeur souris est aligne sur l'un des cotes .
  Private Sub ctrl_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) Handles Me.MouseMove
    ' Retrouve une reference du shape Actif.
    Dim currentCtrl As Control
    currentCtrl = CType(sender, Control)
    If isDragging Then
      ' deplace controle shape.
      currentCtrl.Left = e.X + currentCtrl.Left - clickOffsetX
      currentCtrl.Top = e.Y + currentCtrl.Top - clickOffsetY
      currentCtrl.ForeColor = Me.selectionForeColor
    ElseIf isResizing Then
      ' Redimensionne control shape , suivant "resize mode".
      currentCtrl.ForeColor = Me.selectionForeColor
      If currentCtrl.Cursor = Cursors.SizeNWSE Then
        currentCtrl.Width = e.X
        currentCtrl.Height = e.Y
      ElseIf currentCtrl.Cursor = Cursors.SizeNS Then
        currentCtrl.Height = e.Y
      ElseIf currentCtrl.Cursor = Cursors.SizeWE Then
        currentCtrl.Width = e.X
      End If
    Else
      ' Change cursor si pointeur souris est sur  le cote droit et bas
      ' du controle shape.
      If (e.X + 5) > currentCtrl.Width And _
      (e.Y + 5) > currentCtrl.Height Then
        currentCtrl.Cursor = Cursors.SizeNWSE
      ElseIf (e.X + 5) > currentCtrl.Width Then
        currentCtrl.Cursor = Cursors.SizeWE
      ElseIf (e.Y + 5) > currentCtrl.Height Then
        currentCtrl.Cursor = Cursors.SizeNS
      Else
        ' ce curseur souris est le 4eme type de curseur pour le pointeur souris
        ' utilise souvent pour deplacer les objets.
        currentCtrl.Cursor = Cursors.SizeAll
      End If
    End If
  End Sub
  'MouseUp termine dragging et redimensionnement.
  Private Sub ctrl_MouseUp(ByVal sender As Object, ByVal e As MouseEventArgs) Handles Me.MouseUp
    Me.ForeColor = Me.oldForeColor
    isDragging = False
    isResizing = False
  End Sub
  'RAJOUT CETTE PROCEDURE QUI POSITION LE CONTROLE
  'CUSTOMSHAPE SUR LA GRILLE
  Public Sub SnapToGrid(ByVal ctrl As Control)

    'This blue bit of code will do that
    Dim parentCtrl As CustomPanelGrid.CustomPanelGrid = CType(ctrl.Parent, CustomPanelGrid.CustomPanelGrid)
    If parentCtrl IsNot Nothing Then
      Dim sizeGrid As Size = parentCtrl.GridSpacing
      Dim x1, y1 As Double
      x1 = ctrl.Location.X
      y1 = ctrl.Location.Y

      x1 = Math.Round(x1 / sizeGrid.Width) * sizeGrid.Width
      y1 = Math.Round(y1 / sizeGrid.Width) * sizeGrid.Width
      ctrl.Location = New Point(CInt(x1), CInt(y1))
    End If
  End Sub

End Class


Le problème se trouve dans la procédure 'RefreshPath' du control CustomShape !

Si vous trouvez d'où vient l'erreur cela m'aiderai grandement.

Merci d'avance

Olivier

Zermelo · Answer

Alors j'abandonne, en vous souhaitant bonne chance.

Cordialement.


Étant illettré, je signe d'une croix : ×

Utilisateur anonyme · Answer

Il y a un exemple sur msdn ici qui montre comment transformer ton graphicpath. Sur leur exemple il s'agit de déplacer la 'scène' mais tu peux très bien la faire tourner en utilisant les methodes adéquates. (comme sheila)

Bonne prog.

Utilisateur anonyme · Answer

J'avais pas vu la question désolé car elle est à la fin de ton post.
Tu as commenté la ligne qui fait hériter ta classe de Control. Pourquoi ?

guilleto · Answer

Bonsoir banana32,

Merci pour ta réponse.

Pour la ligne en commentaire cela me faisait une erreur. Logiquement tu devrais avoir la même si tu enlèves le commentaire. Non ?

Olivier

Dessin vectoriel

16 réponses

Votre réponse

Discussions similaires