Sujet Précédent Sujet Suivant

Division de rectangle

Résolu
cs_antho2005 Messages postés 150 Date d'inscription samedi 8 avril 2006 Statut Membre Dernière intervention 1 mai 2012 - 25 sept. 2010 à 11:08
cs_antho2005 Messages postés 150 Date d'inscription samedi 8 avril 2006 Statut Membre Dernière intervention 1 mai 2012 - 7 nov. 2010 à 12:31
Bonjour,
je ne savais pas vraiment dans quelle catégorie mettre ça, donc je le met dans Algorithme / Divers, je pense que c'est ce qui correspond le plus ...

Voici donc mon problème: j'ai un rectangle principal, que j'aimerais découper en une multitude de sous-rectangles de taille aléatoire mais à peu près décroissante avec la distance par rapport au centre du principal. Vu que j'ai un peu de mal à m'expliquer, j'ai fait un dessin vite fait sous paint:


Pour l'instant ce que je fait c'est une fonction récursive: Je divise le rectangle par un nombre aléatoire en largeur et en hauteur et pour chaque rectangle obtenu je recommence et ce jusqu'à ce qu'ils aient à peu près la taille qu'ils devraient avoir ... Seulement, ça me donne ça

Et je trouve ça trop carré, avec trop de zones similaires (je ne sais pas si vous voyez ce que je veux dire ...)

Donc si vous pouviez m'indiquer une piste à suivre, parce que je ne vois pas comment je pourrais faire, je vous en serais très reconnaissant

Merci d'avance

Antho25
------------------------------------
Rien n'empêche Melba

12 réponses

Réponse 1 / 12
Utilisateur anonyme
24 oct. 2010 à 18:51
Salut,
Je me suis amusé à faire une petite application.
Il y a un bug quelque part que je n'arrive à résoudre qu'en faisant plusieurs tentatives de dessin.
Cependant, elle donne d'assez bons résultats.

Pour la tester, ouvre un nouveau projet à fenêtres, et remplace le code de Form1 par celui-ci : 

Option Explicit On
Option Strict On

Public Class Form1
    'le but est de faire "pousser" 4 rectangles autour d'un point :
    '      pour cela on convient d'une direction   0=vers la gauche et en haut(bleu), 1=vers la droite et en haut (vert)
    '                                              2=vers la droite et en bas (rouge),  3=vers la gauche et en bas (jaune)
    'si le rectangle en train de "pousser" :
    '          - dépasse les bornes de la bitmap : il ne "poussera" plus.
    '          - recoupe un rectangle déjà dans la liste des rectangles : il ne "poussera" plus
    'on se sert de 3 listes (liste de rectangles, liste de points (coins des rectangles), liste des couleurs
    'si la fonction qui fait "pousser" le rectangle renvoie un rectangle de taille zéro en largeur et zéro en hauteur
    '      alors on n'ajoutera rien aux listes.
    'sinon :
    '     - on ajoutera à une liste, le rectangle en question
    '     - on ajoutera à une liste de points les 3 coins du rectangle restants (on n'ajoute pas le coin depuis lequel le rectangle a "poussé")
    '     - et on fera "pousser" 4 nouveaux rectangles sur chaqun des points de la liste des points.
    '     - et ainsi de suite jusqu'a ce qu'il n'y ait plus de points dans la liste de points.

    '#########   Variables modifiables      ################################################################################

    Dim m_LargeurBitmap As Integer = 500            'largeur minimale du bitmap
    Dim m_HauteurBitmap As Integer = 350            'hauteur minimale du bitmap

    Dim m_FourchetteBasse_Largeur As Integer = 50   'fourchette de taille maxi en largeur (on peut changer ici les 2 valeurs du random pour dessiner différement)
    Dim m_FourchetteHaute_Largeur As Integer = 100

    Dim m_FourchetteBasse_Hauteur As Integer = 50   'fourchette de taille maxi en hauteur (on peut changer les 2 valeurs ici aussi)
    Dim m_FourchetteHaute_Hauteur As Integer = 100

    Dim m_TailleMinimum As Integer = 8              'taille minimum des rectangles (doit etre un chiffre pair non nul)

    Dim m_Sleep_Rectangles As Integer = 0           'pause entre les dessins des rectangles
    Dim m_Sleep_Rectangle As Integer = 5            'pause pendant le dessin d'un rectangle

    Dim m_Jonctions As Boolean = False              'dessine les jonctions de "pousse"

    Dim m_Fleche As Boolean = True                  'affiche une flèche positionnée sur la jonction de "pousse"

    Dim m_Tentatives As Boolean = True              'si true : resouds la mosaïque complètement (recommandé).

    Dim m_Couleurs As Boolean = True                'met les couleurs de directions sur les rectangles

    Dim m_Dialogue As Boolean = True                'affiche une boîte de dialogue de résumé


    '################################################################################################################

    Dim b As Bitmap                           'bitmap sur lequel dessiner
    Dim g As Graphics                         'outil de dessin sur le bitmap
    Dim m_rectGlobal As Rectangle             'rectangle contenant le dessin
    Dim m_Liste As New List(Of Rectangle)     'liste qui contiendra les rectangles valides
    Dim m_Points As New List(Of Point)        'liste des points qui s'agrandit et diminue en fonction des points traités
    Dim m_ListeCouleurs As New List(Of Color) 'liste des couleurs que prendront les rectangles selon la direction
    Dim m_rnd As New Random                   'générateur de nombres aléatoires

    '######## Contrôles  ###########################################################################################
    Dim pctBox As New PictureBox              'picturebox dynamique qui affichera le bitmap
    Dim lblPointOrigine As New Label          'label dynamique qui affichera la fleche
    Dim prgB As New ProgressBar With {.ForeColor Color.Blue, .Style ProgressBarStyle.Blocks, .Dock = DockStyle.Bottom, .Parent = Me, .Height = 10}

    Dim pnl As New Panel With {.Dock DockStyle.Fill, .Parent Me}

    Dim lbl1 As New Label With {.Parent pnl, .Location New Point(5, 5), .Text = "Taille minimum des rectangles", .AutoSize = True}
    Dim txtTailleMinimum As New TextBox With {.Parent pnl, .Size New Size(40, 15), .Location = New Point(200, 5), .Text = m_TailleMinimum, .SelectionStart = 0, .SelectionLength = .Text.Length}

    Dim lbl2 As New Label With {.Parent pnl, .Location New Point(5, 30), .Text = "Largeur Bitmap", .AutoSize = True}
    Dim txtLargeurBitmap As New TextBox With {.Parent pnl, .Size New Size(40, 15), .Location = New Point(200, 30), .Text = m_LargeurBitmap, .SelectionStart = 0, .SelectionLength = .Text.Length}

    Dim lbl3 As New Label With {.Parent pnl, .Location New Point(5, 55), .Text = "Hauteur Bitmap", .AutoSize = True}
    Dim txtHauteurBitmap As New TextBox With {.Parent pnl, .Size New Size(40, 15), .Location = New Point(200, 55), .Text = m_HauteurBitmap, .SelectionStart = 0, .SelectionLength = .Text.Length}

    Dim lbl4 As New Label With {.Parent pnl, .Location New Point(5, 80), .Text = "Fourchette Largeur Basse", .AutoSize = True}
    Dim txtFourchetteLB As New TextBox With {.Parent pnl, .Size New Size(40, 15), .Location = New Point(200, 80), .Text = m_FourchetteBasse_Largeur, .SelectionStart = 0, .SelectionLength = .Text.Length}

    Dim lbl5 As New Label With {.Parent pnl, .Location New Point(5, 105), .Text = "Fourchette Largeur Haute", .AutoSize = True}
    Dim txtFourchetteLH As New TextBox With {.Parent pnl, .Size New Size(40, 15), .Location = New Point(200, 105), .Text = m_FourchetteHaute_Largeur, .SelectionStart = 0, .SelectionLength = .Text.Length}

    Dim lbl6 As New Label With {.Parent pnl, .Location New Point(5, 130), .Text = "Fourchette Hauteur Basse", .AutoSize = True}
    Dim txtFourchetteHB As New TextBox With {.Parent pnl, .Size New Size(40, 15), .Location = New Point(200, 130), .Text = m_FourchetteBasse_Hauteur, .SelectionStart = 0, .SelectionLength = .Text.Length}

    Dim lbl7 As New Label With {.Parent pnl, .Location New Point(5, 155), .Text = "Fourchette Hauteur Haute", .AutoSize = True}
    Dim txtFourchetteHH As New TextBox With {.Parent pnl, .Size New Size(40, 15), .Location = New Point(200, 155), .Text = m_FourchetteHaute_Hauteur, .SelectionStart = 0, .SelectionLength = .Text.Length}

    Dim lbl8 As New Label With {.Parent pnl, .Location New Point(5, 180), .Text = "Pause Rectangles", .AutoSize = True}
    Dim txtRectangles As New TextBox With {.Parent pnl, .Size New Size(40, 15), .Location = New Point(200, 180), .Text = m_Sleep_Rectangles, .SelectionStart = 0, .SelectionLength = .Text.Length}

    Dim lbl9 As New Label With {.Parent pnl, .Location New Point(5, 205), .Text = "Pause Rectangle", .AutoSize = True}
    Dim txtRectangle As New TextBox With {.Parent pnl, .Size New Size(40, 15), .Location = New Point(200, 205), .Text = m_Sleep_Rectangle, .SelectionStart = 0, .SelectionLength = .Text.Length}

    Dim chkCouleurs As New CheckBox With {.Parent pnl, .Checked m_Couleurs, .Location = New Point(5, 220), .Text = "Couleurs"}
    Dim chkFleche As New CheckBox With {.Parent pnl, .Checked m_Fleche, .Location = New Point(5, 240), .Text = "Fleche"}
    Dim chkJonctions As New CheckBox With {.Parent pnl, .Checked m_Jonctions, .Location = New Point(5, 260), .Text = "Jonctions"}
    Dim chkDialogue As New CheckBox With {.Parent pnl, .Checked m_Dialogue, .Location = New Point(110, 220), .Text = "Dialogue"}
    Dim chkTentatives As New CheckBox With {.Parent pnl, .Checked m_Tentatives, .Location = New Point(110, 240), .Text = "Tentatives"}

    Dim btnOk As New Button With {.Parent pnl, .Text "OK", .Location = New Point(160, 270)}


    Private Sub btnOk_Click(ByVal sender As Object, ByVal e As EventArgs)
        'vérification de la taille minimale

        m_Couleurs = chkCouleurs.Checked
        m_Dialogue = chkDialogue.Checked
        m_Fleche = chkFleche.Checked
        m_Jonctions = chkJonctions.Checked
        m_Tentatives = chkTentatives.Checked

        m_HauteurBitmap = CType(txtHauteurBitmap.Text, Integer)
        m_LargeurBitmap = CType(txtLargeurBitmap.Text, Integer)
        m_TailleMinimum = CType(txtTailleMinimum.Text, Integer)
        m_FourchetteBasse_Largeur = CType(txtFourchetteLB.Text, Integer)
        m_FourchetteHaute_Largeur = CType(txtFourchetteLH.Text, Integer)
        m_FourchetteBasse_Hauteur = CType(txtFourchetteHB.Text, Integer)
        m_FourchetteHaute_Hauteur = CType(txtFourchetteHH.Text, Integer)
        m_Sleep_Rectangles = CType(txtRectangles.Text, Integer)
        m_Sleep_Rectangle = CType(txtRectangle.Text, Integer)

        If m_TailleMinimum Mod 2 <> 0 Or m_TailleMinimum = 0 Then
            MessageBox.Show("la valeur de la taille minimale doit être paire et non nulle", "erreur!", _
                            MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
            Me.Close()
            Exit Sub
        End If

        'calcul du rectangle qui contiendra le dessin
        Dim y, z As Decimal
        y = Math.Floor(CType(m_LargeurBitmap / m_TailleMinimum, Decimal))
        z = Math.Floor(CType(m_HauteurBitmap / m_TailleMinimum, Decimal))
        m_rectGlobal = New Rectangle(0, 0, CType(y * m_TailleMinimum, Integer), CType(z * m_TailleMinimum, Integer))

        'création d'un nouveau bitmap et de l'outil de dessin
        b = New Bitmap(m_rectGlobal.Width + 1, m_rectGlobal.Height + 1)
        g = Graphics.FromImage(b)

        'parametrage du formulaire
        With Me
            .ClientSize = New Size(b.Width, b.Height + prgB.Height + 10)
        End With
        'paramétrage du picturebox dynamique
        With pctBox
            .Parent = Me
            .Location = New Point(0, 0)
            .Size = New Size(b.Width, b.Height)
        End With

        'paramétrage du label flèche
        With lblPointOrigine
            .Parent = pctBox
            .BackColor = Color.Transparent
            .Font = New Font("Wingdings", 15, FontStyle.Bold, GraphicsUnit.Pixel)
            .ForeColor = Color.Black
            .AutoSize = True
            .Text = "æ"
            .Visible = False
        End With

        'ajout de 4 couleurs (la couleur représente la direction du rectangle)
        With m_ListeCouleurs
            .Add(Color.LightSteelBlue)
            .Add(Color.Crimson)
            .Add(Color.LightPink)
            .Add(Color.Yellow)
        End With

        'paramétrage du progressbar
        With prgB
            .Width = Me.ClientRectangle.Width
            .Top = pctBox.Height + 10
            .Minimum = 0
            .Maximum = 100
            .Value = 0
        End With


        'variables de statistiques
        Dim depart As New DateTime(Date.UtcNow.Year, Date.UtcNow.Month, Date.UtcNow.Day, Date.UtcNow.Hour, _
                                   Date.UtcNow.Minute, Date.UtcNow.Second, Date.UtcNow.Millisecond)
        Dim lnt As Integer = m_rectGlobal.Width * m_rectGlobal.Height
        Dim lnc As Integer
        Dim nbtentatives As Integer

        pnl.Visible = False

        'début de la boucle de tentatives
        Do
            lnc = 0
            nbtentatives += 1
            m_Liste.Clear()

            'fond du bitmap
            g.FillRectangle(Brushes.White, 0, 0, m_rectGlobal.Width, m_rectGlobal.Height)
            g.DrawRectangle(Pens.Black, 0, 0, m_rectGlobal.Width, m_rectGlobal.Height)

            'ajout du premier point (aléatoire) dans la liste de points (il doit etre un multiple de la taille mini)
            Dim ptAlea As Point
            Do
                ptAlea = New Point(m_rnd.Next(0, m_rectGlobal.Width), m_rnd.Next(0, m_rectGlobal.Height))
            Loop Until ptAlea.X Mod m_TailleMinimum 0 And ptAlea.Y Mod m_TailleMinimum 0
            m_Points.Add(ptAlea)

            'début de la boucle jusqu'a ce que la liste des points ne contienne plus rien
            Do
                'ici on prend toujours le premier point tout en haut de la liste
                'sur ce point on fera "pousser" nos 4 rectangles
                Dim pos As Point = m_Points.Item(0)

                'positionnement de la flèche
                If m_Fleche = True Then
                    lblPointOrigine.Visible = False
                    Do
                        lblPointOrigine.Location = New Point(pos.X - lblPointOrigine.Width + 6, pos.Y - lblPointOrigine.Height + 3)
                        If Rectangle.Intersect(lblPointOrigine.Bounds, m_rectGlobal) = lblPointOrigine.Bounds Then
                            lblPointOrigine.ForeColor = Color.Black
                            lblPointOrigine.Text = "æ"
                            Exit Do
                        End If
                        lblPointOrigine.Location = New Point(pos.X, pos.Y)
                        If Rectangle.Intersect(lblPointOrigine.Bounds, m_rectGlobal) = lblPointOrigine.Bounds Then
                            lblPointOrigine.ForeColor = Color.Black
                            lblPointOrigine.Text = "ã"
                            Exit Do
                        End If
                        lblPointOrigine.Location = New Point(pos.X, pos.Y - lblPointOrigine.Height)
                        If Rectangle.Intersect(lblPointOrigine.Bounds, m_rectGlobal) = lblPointOrigine.Bounds Then
                            lblPointOrigine.ForeColor = Color.Black
                            lblPointOrigine.Text = "å"
                            Exit Do
                        End If
                        lblPointOrigine.Location = New Point(pos.X - lblPointOrigine.Width, pos.Y)
                        If Rectangle.Intersect(lblPointOrigine.Bounds, m_rectGlobal) = lblPointOrigine.Bounds Then
                            lblPointOrigine.ForeColor = Color.Black
                            lblPointOrigine.Text = "ä"
                            Exit Do
                        End If
                        lblPointOrigine.Location = New Point(pos.X - lblPointOrigine.Width, pos.Y - lblPointOrigine.Height)
                        If Rectangle.Intersect(lblPointOrigine.Bounds, m_rectGlobal) = lblPointOrigine.Bounds Then
                            lblPointOrigine.ForeColor = Color.Black
                            lblPointOrigine.Text = "æ"
                            Exit Do
                        End If

                    Loop
                    lblPointOrigine.Visible = True
                End If

                'boucle de construction des 4 rectangles
                For x = 0 To 3
                    'on appelle la fonction CreerRectangle avec comme parametres la direction (x) du rectangle et son point d'origine (pos)
                    Dim rect As Rectangle = CreerRectangle(x, pos)
                    'si le rectangle est valable ....
                    If (rect.Size <> Size.Empty) And (rect.Width > 0 And rect.Height > 0) Then
                        '... on l'ajoute a notre liste
                        m_Liste.Add(rect)


                        'on le dessine avec sa couleur ...
                        If m_Couleurs Then g.FillRectangle(New SolidBrush(m_ListeCouleurs.Item(x)), rect)
                        '... et son contour
                        g.DrawRectangle(Pens.Black, rect)

                        'stats
                        lnc += (rect.Width * rect.Height)
                        prgB.Value = CType((lnc / lnt) * 100, Integer)

                        'dessin des jonctions
                        If m_Jonctions = True Then g.FillRectangle(Brushes.Blue, New Rectangle(pos.X - 3, pos.Y - 3, 6, 6))

                        'pause pendant la construction
                        If m_Sleep_Rectangles > 0 Then
                            Threading.Thread.Sleep(m_Sleep_Rectangles)
                            pctBox.Image = CType(b.Clone, Image)
                            Me.Refresh()
                        End If

                        'on ajoute ici les points sur lesquels faire pousser d'autres rectangles (ce sont les 3 coins restants de notre rectangle)
                        'bien sur c'est selon la direction (x)
                        Select Case x
                            Case 0
                                m_Points.Add(New Point(rect.Left + rect.Width, rect.Top))
                                m_Points.Add(New Point(rect.Left, rect.Top))
                                m_Points.Add(New Point(rect.Left, rect.Top + rect.Height))
                            Case 1
                                m_Points.Add(New Point(rect.Left, rect.Top))
                                m_Points.Add(New Point(rect.Left + rect.Width, rect.Top))
                                m_Points.Add(New Point(rect.Left + rect.Width, rect.Top + rect.Height))
                            Case 2
                                m_Points.Add(New Point(rect.Left + rect.Width, rect.Top))
                                m_Points.Add(New Point(rect.Left + rect.Width, rect.Top + rect.Height))
                                m_Points.Add(New Point(rect.Left, rect.Top + rect.Height))
                            Case 3
                                m_Points.Add(New Point(rect.Left, rect.Top))
                                m_Points.Add(New Point(rect.Left, rect.Top + rect.Height))
                                m_Points.Add(New Point(rect.Left + rect.Width, rect.Top + rect.Height))
                        End Select
                    End If
                Next

                'on retire le point d'origine de notre liste de points
                m_Points.RemoveAt(0)

                'dessin de la jonction
                If m_Jonctions = True Then g.FillEllipse(Brushes.Red, New Rectangle(pos.X - 3, pos.Y - 3, 6, 6))

                'si la liste de points est vide : la boucle s'arrete
            Loop Until m_Points.Count = 0

            'si on ne demande pas plus d'une tentative on sors aussi de la boucle des tentatives
            If m_Tentatives False Then lnc lnt
        Loop Until lnc = lnt

        'dessin de l'image
        lblPointOrigine.Visible = False
        pctBox.Image = CType(b.Clone, Image)
        Me.Refresh()

        'stats
        Dim fin As New DateTime(Date.UtcNow.Year, Date.UtcNow.Month, Date.UtcNow.Day, Date.UtcNow.Hour, _
                                Date.UtcNow.Minute, Date.UtcNow.Second, Date.UtcNow.Millisecond)

        If m_Dialogue = True Then
            'affichage d'une boite de dialogue
            If MessageBox.Show(m_Liste.Count.ToString & " rectangles" & Char.ConvertFromUtf32(10) & _
                                "Nombre de tentative(s)= " & nbtentatives.ToString & Char.ConvertFromUtf32(10) & _
                                "Temps de création : " & ((fin.ToFileTime - depart.ToFileTime) / 10000000).ToString & " secondes" & _
                                Char.ConvertFromUtf32(10) & _
                                "____________________________________________________" & _
                                Char.ConvertFromUtf32(10) & Char.ConvertFromUtf32(10) & _
                                "Cliquer sur le bouton de droite pour réafficher le menu" & Char.ConvertFromUtf32(10) & _
                                "Cliquer sur un rectangle pour le sélectionner" & Char.ConvertFromUtf32(10) & _
                                "____________________________________________________" & _
                               Char.ConvertFromUtf32(10) & Char.ConvertFromUtf32(10) & _
                                "Sauvegarder le dessin sur le disque ?", "Stats/Aide/Sauvegarde", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button2) = Windows.Forms.DialogResult.Yes Then

                'sauvegarde de l'image dans le projet et ouverture de l'image
                b.Save(Application.StartupPath & "\Image.png", Imaging.ImageFormat.Png)

                'ouverture de l'image
                Process.Start(Application.StartupPath & "\Image.png")
            End If
        End If

        'change le curseur en forme de main pour indiquer à l'utilisateur que l'image est cliquable
        Cursor = Cursors.Hand

        'ajout d'un événement MouseClick au picturebox dynamique
        AddHandler pctBox.MouseClick, AddressOf pctBox_Click
    End Sub

    Private Function CreerRectangle(ByVal Direction As Integer, ByVal Position As Point) As Rectangle
        'on interdit les rectangle de largeur ou hauteur paires (pour éviter les largeurs et hauteurs vides)
        'initialisation du rectangle sur la location de notre point d'origine et de taille zéro en largeur et hauteur
        Dim rect As New Rectangle(Position, Size.Empty)
        'comme il faut contrôler en permanence ce rectangle afin qu'il reste dans les normes on le sauvegarde en permanence dans arect
        Dim arect As Rectangle = rect

        'détermination des largeur et hauteur maxi
        Dim maxW As Integer = m_rnd.Next(m_FourchetteBasse_Largeur, m_FourchetteHaute_Largeur)
        Dim maxH As Integer = m_rnd.Next(m_FourchetteBasse_Hauteur, m_FourchetteHaute_Hauteur)


        'début de la boucle d'agrandissement du rectangle 
        'on sortira de la boucle dès que le rectangle ne sera plus dans les normes
        'la fonction renverra alors la derniere sauvegarde du rectangle (arect)
        Do

            Dim paramX As Integer
            Dim paramY As Integer


            Dim basc As Boolean = Convert.ToBoolean(m_rnd.Next(0, 2))
            If basc = True Then
                paramX = m_TailleMinimum
                paramY = 0
            Else
                paramX = 0
                paramY = m_TailleMinimum
            End If

            'selon la direction de "pousse" on deplace ou pas notre rectangle de 2 pixels vers cette direction
            Select Case Direction
                Case 0
                    rect.Offset(-paramX, -paramY)
                Case 1
                    rect.Offset(0, -paramY)
                Case 3
                    rect.Offset(-paramX, 0)
            End Select

            rect.Height += paramY
            rect.Width += paramX
            If rect.Width >= maxW And rect.Height >= maxH Then
                Return arect
            End If

            'ici commence la vérification des normes de notre rectangle
            'si le rectangle sors de l'image la fonction retourne la dernière sauvegarde (arect)
            If Rectangle.Intersect(New Rectangle(0, 0, m_rectGlobal.Width, m_rectGlobal.Height), rect) <> rect Then Return arect
            'si le rectangle coupe n'importe quel rectangle de la liste qui contient tous les rectangles déssinés...
            For Each r In m_Liste
                If r.IntersectsWith(rect) = True Then
                    '... la fonction retourne la dernière sauvegarde (arect)
                    Return arect
                End If
            Next
            'sauvegarde de notre rectangle (en cas d'échec de la validité de notre rectangle, c'est cette sauvegarde qui sera renvoyée par la fonction)
            If m_Sleep_Rectangle > 0 Then
                g.FillRectangle(Brushes.White, arect)
                g.DrawRectangle(Pens.White, arect)
                If m_Couleurs = True Then g.FillRectangle(New SolidBrush(m_ListeCouleurs(Direction)), rect)
                g.DrawRectangle(Pens.Black, rect)
                Threading.Thread.Sleep(m_Sleep_Rectangle)
                pctBox.Image = CType(b.Clone, Image)
                pctBox.Refresh()
            End If
            arect = rect
        Loop

    End Function

    Private Sub pctBox_Click(ByVal sender As Object, ByVal e As MouseEventArgs)
        If e.Button = Windows.Forms.MouseButtons.Right Then
            m_Liste.Clear()
            g.Clear(Color.White)
            RemoveHandler pctBox.MouseClick, AddressOf pctBox_Click
            Me.Size = New Size(270, 340)
            pnl.Visible = True
            Exit Sub
        End If
        'couleur de réference à l'endroit de la souris
        Dim CouleurRef As Color = b.GetPixel(e.X, e.Y)
        If CouleurRef = Color.FromArgb(255, 0, 0, 0) Then Exit Sub
        Dim i, j, w, h As Integer
        i = e.X
        j = e.Y
        'on remonte les pixels un par un jusqu'a ce que la couleur change (bordure noire)
        Do
            j -= 1
        Loop Until b.GetPixel(i, j) <> CouleurRef
        'on a donc le haut du rectangle
        j += 1
        Do
            i -= 1
        Loop Until b.GetPixel(i, j) <> CouleurRef
        'on a le coté gauche du rectangle
        i += 1
        'on a donc le point d'origine : on cherche maintenant la largeur puis la hauteur de la même façon
        Dim ptOrigine As New Point(i, j)
        Do
            w += 1
        Loop Until b.GetPixel(i + w, j) <> CouleurRef
        w -= 1
        Do
            h += 1
        Loop Until b.GetPixel(i, j + h) <> CouleurRef
        h -= 1

        'on ajuste les valeurs obtenues
        i -= 1
        j -= 1
        w += 2
        h += 2
        'remplissage du rectangle en noir
        g.FillRectangle(Brushes.Black, New Rectangle(i, j, w, h))
        'affichage
        pctBox.Image = CType(b.Clone, Image)
        'résumé
        MessageBox.Show("x= " & i & Char.ConvertFromUtf32(10) & _
                         "y= " & j & Char.ConvertFromUtf32(10) & _
                         "width= " & w & Char.ConvertFromUtf32(10) & _
                         "height= " & h & Char.ConvertFromUtf32(10) & _
                         "Numéro d'index de construction= " & m_Liste.IndexOf(New Rectangle(i, j, w, h)) & " / " & m_Liste.Count.ToString, _
                         "Rectangle selectionné", MessageBoxButtons.OK, MessageBoxIcon.Information)
        'remise en forme du rectangle comme à l'origine
        g.FillRectangle(New SolidBrush(CouleurRef), New Rectangle(i, j, w, h))
        g.DrawRectangle(Pens.Black, New Rectangle(i, j, w, h))
        'affichage de l'image
        pctBox.Image = CType(b.Clone, Image)
    End Sub

    Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        With Me
            .MinimizeBox = False
            .MaximizeBox = False
            .Size = New Size(270, 340)
            .Text = "Mosaïque"
        End With
        Me.AcceptButton = btnOk
        AddHandler btnOk.Click, AddressOf btnOk_Click
    End Sub
End Class
3
Réponse 2 / 12
Utilisateur anonyme
25 sept. 2010 à 14:36
A mon avis, si on divise un petit chiffre par une valeur aléatoire comprise entre zéro et lui même on n'obtient pas beaucoup de possibilités de divisions.
Je pense que si on multiplie d'abord ce petit chiffre par 100 (par exemple) on devrait obtenir plus de possibilités de divisions aléatoires et ensuite de les ramener par la règle de trois au petit chiffre.
Tu me diras si c'est vrai
0
Réponse 3 / 12
cs_antho2005 Messages postés 150 Date d'inscription samedi 8 avril 2006 Statut Membre Dernière intervention 1 mai 2012 3
26 sept. 2010 à 11:12
Salut, et tout d’abord merci pour ta réponse
J'ai donc testé ta solution mais le problème est que ça améliore les possibilités de découpe, mais en le ramenant à sa taille normale (ou au moins en le dessinant), les valeurs sont arrondies, donc ça ne change pas grand chose malheureusement.

Antho 25
------------------------------------
Rien n'empêche Melba
0
Réponse 4 / 12
Utilisateur anonyme
29 sept. 2010 à 21:47
Salut,
Peut être as-tu déjà trouvé une solution. Bah oui c'est déjà mercredi
Oui tout dépend de la taille de ton dessin (pixels disponibles), de ton algorithme et du type de variables utilisées pendant les calculs :
les valeurs sont arrondies

Ce qui serait bien, c'est d'avoir un bout de code pour se faire une idée.
A bientôt.
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 12
cs_antho2005 Messages postés 150 Date d'inscription samedi 8 avril 2006 Statut Membre Dernière intervention 1 mai 2012 3
30 sept. 2010 à 18:11
Eh bien, voici mon code (alors attention, les noms et tout sont pas très bien, c'est juste un petit programme de test ): 
Private Sub Form1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Click
    'On génère l'image au click
    Dim BmpFinal As New Bitmap(Me.ClientSize.Width, Me.ClientSize.Height)
    Dim GraphBmpFinal As Graphics = Graphics.FromImage(BmpFinal)
    Dim ClientBounds As RectangleF = SizeToRectangle(Me.ClientSize) 'Je récupère les coordonnées de la zone disponible sous forme de RectangleF
    Dim MaDivision As RectangleF() = PerformDivision(ClientBounds, ClientBounds) 'C'est là qu'on génère la division
    GraphBmpFinal.DrawRectangles(Pens.Red, MaDivision) 'On dessine
    Me.BackgroundImage = BmpFinal 'On affiche
    BmpFinal.Save("C:\resultat.png") 'On enregistre
End Sub

Private Function PerformDivision(ByVal OriginalRectangle As RectangleF, ByVal Exterieur As RectangleF) As RectangleF()
    'Fonction récursive permettant la division
    Dim Retour(-1) As RectangleF 'Variable retournée contenant le rectangle divisé
    Dim TailleNecessaire As New Size 'Taille maximum pour ce sous-rectangle
    Dim Dist As Double = DistanceRectangles(OriginalRectangle, Exterieur) 'Distance par rapport au rectangle contenant
    If Dist 0 Then Dist 1 'Évite les divisions par 0
    Dim MoyenneTailleExt As Double = (Exterieur.Width + Exterieur.Height) / 2
    Dim DiviserPar As Double = Math.Max(1, (Dist / (MoyenneTailleExt / 20))) 'Plus c'est loin, plus c'est petit
    TailleNecessaire.Width = (Exterieur.Width / 4) / DiviserPar
    TailleNecessaire.Height = (Exterieur.Height / 4) / DiviserPar
    Dim DivisionsX As Integer = Rnd() + 2 'Nombre de divisions sur X
    Dim DivisionsY As Integer = Rnd() + 2 'Nombre de divisions sur Y
    'Si le rectangle est déjà assez petit dans une des directions, on ne le divise pas selon celle-ci
    If OriginalRectangle.Width <TailleNecessaire.Width Then DivisionsX 1
    If OriginalRectangle.Height <TailleNecessaire.Height Then DivisionsY 1
    'Si déjà assez petit on retourne un tableau contenant un seul élément: lui-même
    If DivisionsX 1 And DivisionsY 1 Then Return DiviserRect(OriginalRectangle, 1, 1)
    'On récupère une liste de rectangles plus petits
    Dim SousRectangles As RectangleF() = DiviserRect(OriginalRectangle, DivisionsX, DivisionsY)
    For Each SingleRectangle As RectangleF In SousRectangles 'Pour chacun
        'On met dans le tableau la sous-division de celui-ci (la fonction s'apelle elle-même)
        push(Retour, PerformDivision(SingleRectangle, Exterieur))
    Next
    Return Retour
End Function

Je ne met pas les petites fonctions utilisées, elles marchent correctement et ça prendrais de la place de les rajouter

Voilà !

Antho 25
------------------------------------
Rien n'empêche Melba
0
Réponse 6 / 12
cs_antho2005 Messages postés 150 Date d'inscription samedi 8 avril 2006 Statut Membre Dernière intervention 1 mai 2012 3
17 oct. 2010 à 12:43
Rebonjour à tous,
Je précise que le code ci-dessus est le code qui ne me donne pas le résultat escompté, donc si il y a des propositions de solutions, je suis encore ouvert

Antho 25
------------------------------------
Rien n'empêche Melba
0
Réponse 7 / 12
Utilisateur anonyme
17 oct. 2010 à 16:56
salut,
une autre petite piste concernant ton problème.

La classe Rectangle possède quelques fonctions intéressantes comme :
- Intersect qui construit un rectangle qui à les dimensions du recoupement des 2 rectangles à comparer qui se coupent. (si ce rectangle est Empty c'est que les 2 rectangles ne se coupent pas)
- Inflate qui permet de faire agrandir ou rétrécir un rectangle.
- Union qui est l'union des 2 rectangles à comparer

Un petit exemple : 
        Dim rectangle1 As New Rectangle(0, 0, 20, 20)
        Dim rectangle2 As New Rectangle(10, 10, 20, 20)
        Dim rectangleResultat As Rectangle = Rectangle.Intersect(rectangle1, rectangle2)
        'le rectangle resultat est ici left10, top 10, width = 10, height = 10
        If rectangleResultat = Rectangle.Empty Then
            MessageBox.Show("pas de recoupement")
        Else
            MessageBox.Show("recoupement constaté")
        End If



Dans ton cas tu pourrais à l'aide de Inflate et Intersect, créer des rectangles de largeur et hauteur de 0 et les faire grossir jusqu'à ce qu'ils coupent un rectangle déjà en place. Ainsi tu fais varier leur hauteur et leur largeur aléatoirement.
Ceci devrait donner de bons résultats.
A bientôt
0
Réponse 8 / 12
cs_antho2005 Messages postés 150 Date d'inscription samedi 8 avril 2006 Statut Membre Dernière intervention 1 mai 2012 3
20 oct. 2010 à 23:06
Ah merci beaucoup, cet idée me parait pas mal du tout ! J'ai testé donc, mais je me retrouve face à de petits problèmes:
Tout d'abord voici, ça sera fait comme ça 
    Private Function PointsOfRectangle(ByVal theRectangle As Rectangle) As Point()
        'Récupère la liste des points d'un rectangle (long -> à améliorer)
        Dim retour(-1) As Point
        Dim i As Integer, j As Integer
        For i = theRectangle.Left To theRectangle.Right
            For j = theRectangle.Top To theRectangle.Bottom
                push(retour, New Point(i, j))
            Next
        Next
        Return retour
    End Function

    Private Function IntersectsWith(ByVal Concerned As Rectangle, ByVal MyList As Rectangle()) As Boolean
        'Regarde si un rectangle croise un quelconque rectangle d'une liste
        If MyList Is Nothing Then Return False
        For Each SousRectangle As Rectangle In MyList
            If Concerned.IntersectsWith(SousRectangle) Then Return True
        Next
        Return False
    End Function

    Private Function PerformDivision(ByVal PointsDispo As Point(), ByVal Exterieur As Rectangle, Optional ByVal CurrentList As Rectangle() = Nothing) As Rectangle()
        If CurrentList Is Nothing Then ReDim CurrentList(-1)
        Dim TailleNecessaire As New Size()
        Dim TailleMini As New Size(1, 1)
        Dim MilieuActu As Point = PointsDispo(Int(Rnd() * PointsDispo.Length))
        Dim SizeActu As Size = New Size(1, 1)
        Dim CurrentRectangle As Rectangle = New Rectangle(MilieuActu, SizeActu)
        Dim Precedent As Rectangle = CurrentRectangle
        Dim Dist As Double = DistanceRectangles(CurrentRectangle, Exterieur) + 1
        Dim MoyenneTailleExt As Double = (Exterieur.Width + Exterieur.Height) / 2
        Dim DiviserPar As Double = Math.Max(1, (Dist / (MoyenneTailleExt / 5)))
        TailleNecessaire.Width = (Exterieur.Width / 2) / DiviserPar
        TailleNecessaire.Height = (Exterieur.Height / 2) / DiviserPar
        Dim OK As Boolean = False
        Do While Not OK
            SizeActu = Drawing.Size.Add(SizeActu, TailleMini)
            CurrentRectangle.X = MilieuActu.X - SizeActu.Width / 2
            CurrentRectangle.Y = MilieuActu.Y - SizeActu.Height / 2
            CurrentRectangle.Size = SizeActu
            If IntersectsWith(CurrentRectangle, CurrentList) Then Exit Do
            If CurrentRectangle.Width >= TailleNecessaire.Width Or CurrentRectangle.Height >= TailleNecessaire.Height Then Exit Do
            If Not MyContains(Exterieur, CurrentRectangle) Then Exit Do
            'MyContains vérifie qu'un rectangle en contient entièrement un autre
            Precedent = CurrentRectangle
        Loop
        push(CurrentList, Precedent)
        'Met le dernier rectangle valide dans la liste des rectangles
        remove(PointsDispo, PointsOfRectangle(Precedent))
        'On supprime de la liste des points disponibles les points du rectangle validé
        If PointsDispo Is Nothing Or PointsDispo.Length = 0 Then
            Return CurrentList 'On a tout rempli
        Else
            'On continue
            Return PerformDivision(PointsDispo, Exterieur, CurrentList)
        End If
    End Function

'Et à l'utilisation:
Dim MaDivision As Rectangle()
MaDivision = PerformDivision(PointsOfRectangle(ClientBounds), ClientBounds)
'ClientBounds étant un rectangle de coin haut gauche 0,0 et de taille Me.ClientSize

Donc voici ce que ça donne (un peu mis en forme): lien (j'ai agrandi 10 fois les côtés des carrés)
* Comme vous le voyez, il reste des trous et ça, ça m'épate, je vois pas pourquoi
* Aussi cette méthode me donne de nombreux rectangle (de plus en plus plus le rectangle extérieur est grand) et il se trouve qu'un tableau de rectangles, au bout de 2190 (je crois) provoque une overflow exception, donc c'est pas très cool

Donc voilà, si y'a des petites idées ... Mais mis à part ça c'est parfait !

Un grand merci pour ton investissement banana32 !

Antho 25
------------------------------------
Rien n'empêche Melba
0
Réponse 9 / 12
Utilisateur anonyme
21 oct. 2010 à 21:55
Salut,
Je vois que tu avances bien dans ton projet

Ta fonction IntersectsWith s'appelle elle même ce qu'il faut absolument éviter.

Utilise plutôt une liste typée pour stocker tes rectangles c'est bien plus pratique pour ajouter retirer trier etc... 

Dim MyList As New List(Of Rectangle)
Dim monRectangle As New Rectangle(2, 10, 30, 50)
MyList.Add(New Rectangle(0, 0, 10, 10))
MyList.Add(monRectangle)
MyList.Remove(monRectangle)
MyList.RemoveAt(0)


Pense aussi à utiliser La fonction Offset de ton rectangle qui permet de déplacer ton rectangle dans la direction que tu souhaite et inflate pour le faire grossir.

Lorsqu'une intersection à été détectée avec un rectangle déja en place, tu peux stocker les points d'intersections obtenus et commencer un nouveau rectangle à cet emplacement.

A bientôt.
0
Réponse 10 / 12
Utilisateur anonyme
21 oct. 2010 à 22:04
Oups j'ai écrit un peu vite
Elle ne s'appelle pas elle même autant pour moi.
Bon courage
0
Réponse 11 / 12
cs_antho2005 Messages postés 150 Date d'inscription samedi 8 avril 2006 Statut Membre Dernière intervention 1 mai 2012 3
21 oct. 2010 à 23:36
[quote=banana32]Utilise plutôt une liste typée pour stocker tes rectangles c'est bien plus pratique pour ajouter retirer trier etc... /quote
Merci du conseil, j'en prend note

[quote=banana32]Pense aussi à utiliser La fonction Offset de ton rectangle qui permet de déplacer ton rectangle dans la direction que tu souhaite et inflate pour le faire grossir. /quote
J'avais utilisé inflate au début mais j'ai préféré recentrer le rectangle sur le point à chaque fois (et avec offset il aurait fallu que je décale d'1/2 quand je rajoute 1 en taille, or j'utilise des Rectangle et non des RectangleF donc avec les arrondis ça n'aurait servi à rien) et du coup j'ai trouvé que faire comme dans le code ci-dessus était une solution pas trop mal (mais à voir)

[quote=banana32]Lorsqu'une intersection à été détectée avec un rectangle déja en place, tu peux stocker les points d'intersections obtenus et commencer un nouveau rectangle à cet emplacement. /quote
Il va falloir que j'essaye ça

Et au risque de me répéter, merci banana32

Antho 25
------------------------------------
Rien n'empêche Melba
0
Réponse 12 / 12
cs_antho2005 Messages postés 150 Date d'inscription samedi 8 avril 2006 Statut Membre Dernière intervention 1 mai 2012 3
7 nov. 2010 à 12:31
Bonjour Banana32,
Désolé pour le temps de latence, mais j'étais assez chargé ces derniers temps. J'ai regardé ton code et ça m'a l'air très bien ! C'est clair et ça donne un bon résultat
Donc je prend bien sûr, merci encore pour tout ce que tu as fait

Antho 25
------------------------------------
Rien n'empêche Melba
0

Discussions similaires

la division en java
cs_aliomar -
KIRAIII -

3 réponses
Partie entiére d'un nombre
stephbb75 -
stephbb75 -

2 réponses
afficher le reste d'une division
busta74 -
busta74 -

2 réponses
Problème de division réelle (et oui...)
playmo420 -
nomad56 -

4 réponses
[Division] récupérer la partie entière d'une division avec un arrondi supérieur
Frouf85 -
Frouf85 -

8 réponses
Rejoignez-nous