Traçage de triangles dans la PictureBox

Résolu
Lenouveauapprenti Messages postés 306 Date d'inscription   Statut Membre Dernière intervention   -  
Lenouveauapprenti Messages postés 306 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour :

Franchement je me suis trouvé dans l'impasse. J'ai besoin de votre aide.
Je m'explique :

J'ai :
6 pièces de 75 cm x 60 cm
5 pièces de 70 cm x 40 cm
1 plaque de 30 cm x 300 cm

je tente une fois je clique sur le bouton "Afficher"
- la PictureBox (Picture1) apparaît avec dedans
- Premiere rangée 4 triangles de 75 x 60 ( capacité de la longueur : 300 \ 75 )
- Deuxième rangée 2 triangles de 75 x 60 (Reste de triangles )
- Troisième rangée 4 triangles de 70 x 40 (Capacité de la longueur)
- Quatrième rangée 1 triangle de 70 x 40 (Reste)
avec bien sûr une condition de vérification de la capacité de la largeur (Hauteur ) si jamais elle atteint sa capacité passe à une deuxième plaque, ainsi de suite


je vous expose mes codes ( Veuillez excuser mon écriture, je fais de mon mieux, toute correction est la bienvenue avec toute ma reconnaissance) 


Dim A, B As Double
Dim Decoupe, DecoupeR As String
Decoupe = "Decoupe"
Dim I, PI, DI, NbrePieces, NFois, ResteP As Integer


SQLs = "select * from TableOperations where ((Dossier='" & CStr(VarDossier) & "') and (Operation='" & CStr(Decoupe) & "')" _
& "and (Facture=" & CInt(FDecoupe.TAffaire) & "))" & "order by NOrdre asc"

If RS.State = adStateOpen Then RS.Close
RS.Open SQLs, DB, adOpenKeyset, adLockPessimistic

If RS![NOrdre] <> 0 Then
RS.MoveFirst
PI = RS![NOrdre]
End If

SQLs = "select * from TableOperations where ((Dossier='" & CStr(VarDossier) & "') and (Operation='" & CStr(Decoupe) & "')" _
& "and (Facture=" & CInt(FDecoupe.TAffaire) & "))" & "order by NOrdre asc"

If RS.State = adStateOpen Then RS.Close
RS.Open SQLs, DB, adOpenKeyset, adLockPessimistic

If RS![NOrdre] <> 0 Then
RS.MoveLast
DI = RS![NOrdre]
End If

'Boucle

Dim PLigne, PColonne As Integer
Dim PL, AL, PLigne1, NOrdrePiece, NOrdrePrime As Integer
Dim PosL As Integer



PosL = 0


For I = PI To DI Step 1

    'Références de Pieces

    SQLs = "select * from TableOperations where ((Dossier='" & CStr(VarDossier) & "') and (NOrdre=" & CInt(I) & "))"

    If RS.State = adStateOpen Then RS.Close
    RS.Open SQLs, DB, adOpenKeyset, adLockPessimistic

    If RS![NOrdre] = I Then
    DecoupeR = RS![Operation]


    If DecoupeR <> Decoupe Then
    GoTo Ignore:
    Exit Sub
    End If
   
   
   NbrePieces = RS![NbrePiece]
   A = RS![Longueur]
   B = RS![Largeur]
   End If
   RS.Close
   
   
   'Nombre de pièces par ligne (Longueur)
   PLigne = CDbl(LblLongueur) \ A
   
   'Nombre de pièces par hauteur (Largeur)
   PColonne = CDbl(LblLargeur) \ B
   
   
  If PLigne <> 0 Then
  GoTo Ok1:
  Exit Sub
  Else
  GoTo Pas1:
  Exit Sub
  End If
  
Ok1:
  
  If PColonne <> 0 Then
  GoTo Ok2:
  Exit Sub
  Else
  GoTo Pas2:
  Exit Sub
  End If
  
Ok2:

  'Placer les objets
  

  For PL = 1 To PLigne Step 1
  
  
    Picture1.Line (0 + ((PL - 1) * A), 0 + PosL)-Step(A, B), vbRed, B
    
        'Définir Nombre de pièce restées à tracer sur la ragngée suivante
        
        ResteP = CInt(NbrePieces) - CInt(PLigne)
  
  
  
        If PL = PLigne Then
           If ResteP = 0 Then
            GoTo Ok4:
            Exit Sub
            Else
            GoTo Ok5:
            Exit Sub
            End If
  
Ok5:
        
        GoTo AutreLigne:
        Exit Sub
        ElseIf PL = NbrePieces Then
        GoTo Ok3:
        Exit Sub
        End If
        
AutreLigne:
  
      If ResteP > PLigne Then
      PLigne1 = PLigne
      GoTo Li:
      Exit Sub
      ElseIf ResteP <= PLigne Then
      PLigne1 = ResteP
      GoTo Li1:
      Exit Sub
      End If
      
      
Li:
Li1:
      
      
      
       'La rangée suivante
       
       For AL = 1 To PLigne1 Step 1
       
             
       Picture1.Line (0 + ((AL - 1) * A), 0 + B)-Step(A, B), vbRed, B
  
            
       Next AL
    
    
    Next PL
    
Ok4:
Ok3:
Pas1:
Pas2:
Ignore:

'Définir le n fois de rangées

NFois = NFois + 1

'Définir la position de la rangée

PosL = CDbl(PosL) + (CDbl(B) * NFois)

Next I


Mon problème est que les tracées s'imbriquent.

Merci d'avance pour toute aide ou correction

2 réponses

Réponse 1 / 2
Lenouveauapprenti Messages postés 306 Date d'inscription   Statut Membre Dernière intervention   2
 
Bonjour

Suite à ma première demande d'aide pour mes boucles à tracer des rectangles à l'intérieur de PictureBox, et pour laquelle je n'ai aucune réaction, j'ai pu après plusieurs essais à les bien placer avec la mention de leurs dimensions au centre de chacun d'eux.
Seulement je me suis rendu compte que lorsque le nombre de pièces dépasse un nombre bien précis ( en relation avec la capacité de la longueur) la boucle ignore l'instruction de tracer le reste à la troisième rangée ( La question de la capacité de la largeur est restée pou après )

Voilà les données une autre fois:
- Plaque ( représentée par PictureBox "Picture1") de 300 cm x 300 cm
- Pièces (représentées par Triangles )
-7 pièces de 75 cm x 60 cm
-8 pièces de 70 cm x 40 cm 

Private Sub CmdAfficher_Click()

With Picture1
.Visible = True
.Cls
.AutoRedraw = True
.ScaleMode = vbPixels
.Appearance = 0
.BorderStyle = 0
.Left = 4300
.Top = 1000
.Width = CDbl(LblLongueur) * Screen.TwipsPerPixelX
.Height = CDbl(LblLargeur) * Screen.TwipsPerPixelY
End With



'__________________________________


Dim A, B As Double
Dim Decoupe, DecoupeR As String
Decoupe = "Decoupe"
Dim I, PI, DI, NbrePieces, NFois, ResteP As Integer


SQLs = "select * from TableOperations where ((Dossier='" & CStr(VarDossier) & "') and (Operation='" & CStr(Decoupe) & "')" _
& "and (Facture=" & CInt(FDecoupe.TAffaire) & "))" & "order by NOrdre asc"

If RS.State = adStateOpen Then RS.Close
RS.Open SQLs, DB, adOpenKeyset, adLockPessimistic

If RS![NOrdre] <> 0 Then
RS.MoveFirst
PI = RS![NOrdre]
End If

SQLs = "select * from TableOperations where ((Dossier='" & CStr(VarDossier) & "') and (Operation='" & CStr(Decoupe) & "')" _
& "and (Facture=" & CInt(FDecoupe.TAffaire) & "))" & "order by NOrdre asc"

If RS.State = adStateOpen Then RS.Close
RS.Open SQLs, DB, adOpenKeyset, adLockPessimistic

If RS![NOrdre] <> 0 Then
RS.MoveLast
DI = RS![NOrdre]
End If

'Boucle

Dim PLigne, PColonne As Integer
Dim PL, AL, AL1, PLigne1, PLi As Integer
Dim PosL, Larg, Larg1 As Double



PosL = 0
PLi = 0

For I = PI To DI Step 1

    
    'Références de Pieces

    SQLs = "select * from TableOperations where ((Dossier='" & CStr(VarDossier) & "') and (NOrdre=" & CInt(I) & "))"

    If RS.State = adStateOpen Then RS.Close
    RS.Open SQLs, DB, adOpenKeyset, adLockPessimistic

    If RS![NOrdre] = I Then
    DecoupeR = RS![Operation]


    If DecoupeR <> Decoupe Then
    GoTo Ignore:
    Exit Sub
    End If
   
   
   NbrePieces = RS![NbrePiece]
   A = RS![Longueur]
   B = RS![Largeur]
   End If
   RS.Close
   
   
   'Nombre de pièces par ligne (Longueur)
   PLigne = CDbl(LblLongueur) \ A
   
   'Nombre de pièces par hauteur (Largeur)
   PColonne = CDbl(LblLargeur) \ B
   
   
  If PLigne <> 0 Then
  GoTo Ok1:
  Exit Sub
  Else
  GoTo Pas1:
  Exit Sub
  End If
  
Ok1:
  
  If PColonne <> 0 Then
  GoTo Ok2:
  Exit Sub
  Else
  GoTo Pas2:
  Exit Sub
  End If
  
Ok2:

   'Largeur

   
   
  'Placer les objets
  
 
    
    
    For PL = 1 To PLigne Step 1
  
    
    
    Larg = CDbl(B)
      
    Picture1.Line (0 + ((PL - 1) * A), 0 + PosL)-Step(A, B), vbRed, B
    
    Picture1.CurrentX = ((0 + (CDbl(A) / 4)) + (PL - 1) * A)
    Picture1.CurrentY = ((0 + (CDbl(B) / 4)) + PosL)
    Picture1.Print "" & A & "x" & B
    
    
        'Définir Nombre de pièce restées à tracer sur la ragngée suivante
        
        ResteP = CInt(NbrePieces) - CInt(PLigne)
  
  
  
        If PL = PLigne Then
           If ResteP = 0 Then
            GoTo Ok4:
            Exit Sub
            Else
            GoTo Ok5:
            Exit Sub
            End If
  
Ok5:
        
        GoTo AutreLigne:
        Exit Sub
        ElseIf PL = NbrePieces Then
        GoTo Ok3:
        Exit Sub
        End If
        
AutreLigne:
      
      If ResteP > PLigne Then
      PLigne1 = PLigne
      GoTo Li:
      Exit Sub
      ElseIf ResteP <= PLigne Then
      PLigne1 = ResteP
      GoTo Li1:
      Exit Sub
      End If
      
      
Li:
Li1:

'La rangée suivante
                          
       For AL = 1 To PLigne1 Step 1
       
       Larg1 = CDbl(B)
             
       Picture1.Line (0 + ((AL - 1) * A), 0 + (Larg1 + PosL))-Step(A, B), vbRed, B
       
       Picture1.CurrentX = ((0 + CDbl(A / 4)) + (AL - 1) * A)
       'Picture1.CurrentY = ((0 + (CDbl(B) / 4)) + B)
       Picture1.CurrentY = ((0 + (CDbl(B) / 4)) + (Larg1 + PosL))
       Picture1.Print "" & A & "x" & B
             
                
               
       Next AL
    

    
    Next PL
Ok4:
Ok3:
Pas1:
Pas2:
Ignore:

'Définir la position de la rangée

 PosL = CDbl(PosL) + CDbl(Larg) + CDbl(Larg1)
Next I

End Sub



Avec ces boucles tout marche bien, et les triangles se tracent convenablement.
Mais, et vu que je n'ai que deux boucles, le problème est là, lorsque
-Pièces de 75 cm x 60 cm est supérieur à 8 unités
-Pièce de 70 cm x 40 cm est supérieur à 8 unités

C'est vrai que pour résoudre ce problème je devrai ajouter une autre boucle ce qui chargera trop mes codes
C'est dans ce sens que je m'adresse à vous LES AVERTIS de la programmation ( VB6) de bien vouloir me donner une formule qui peut me donner la bonne solution peu importe le nombre de pièces.

Merci d'avance
0
Réponse 2 / 2
Lenouveauapprenti Messages postés 306 Date d'inscription   Statut Membre Dernière intervention   2
 
Bonjour

Enfin, après maintes reflexions et essais, j'ai trouvé l'astuce de placer les formes juridiques en nombres déclarés et sans imbrications.

Je vous remets le code : 

With Picture1
.Visible = True
.Cls
.AutoRedraw = True
.ScaleMode = vbPixels
.Appearance = 0
.BorderStyle = 0
.Left = 4300
.Top = 1000
.Width = CDbl(LblLongueur) * Screen.TwipsPerPixelX
.Height = CDbl(LblLargeur) * Screen.TwipsPerPixelY
End With



'________________________________________________________________


Dim A, B As Double
Dim Decoupe, DecoupeR As String
Decoupe = "Decoupe"
Dim I, PI, DI, NbrePieces, NFois, ResteP As Integer


SQLs = "select * from TableOperations where ((Dossier='" & CStr(VarDossier) & "') and (Operation='" & CStr(Decoupe) & "')" _
& "and (Facture=" & CInt(FDecoupe.TAffaire) & "))" & "order by NOrdre asc"

If RS.State = adStateOpen Then RS.Close
RS.Open SQLs, DB, adOpenKeyset, adLockPessimistic

If RS![NOrdre] <> 0 Then
RS.MoveFirst
PI = RS![NOrdre]
End If

SQLs = "select * from TableOperations where ((Dossier='" & CStr(VarDossier) & "') and (Operation='" & CStr(Decoupe) & "')" _
& "and (Facture=" & CInt(FDecoupe.TAffaire) & "))" & "order by NOrdre asc"

If RS.State = adStateOpen Then RS.Close
RS.Open SQLs, DB, adOpenKeyset, adLockPessimistic

If RS![NOrdre] <> 0 Then
RS.MoveLast
DI = RS![NOrdre]
End If

'Boucle

Dim Pligne, PColonne, PL, CumulPLigne As Integer
Dim NbreRangees, NbreRangeesSansDecimal, Deci, R, LargRangee As Double



LargRangee = 0
CumulPLigne = 0

For I = PI To DI Step 1

    
    'Références de Pieces

    SQLs = "select * from TableOperations where ((Dossier='" & CStr(VarDossier) & "') and (NOrdre=" & CInt(I) & "))"

    If RS.State = adStateOpen Then RS.Close
    RS.Open SQLs, DB, adOpenKeyset, adLockPessimistic

    If RS![NOrdre] = I Then
    DecoupeR = RS![Operation]


    If DecoupeR <> Decoupe Then
    GoTo Ignore:
    Exit Sub
    End If
   
   
   NbrePieces = RS![NbrePiece]
   A = RS![Longueur]
   B = RS![Largeur]
   End If
   RS.Close
   
   
   'Nombre de pièces par ligne (Longueur)
   Pligne = CDbl(LblLongueur) \ A
   
   'Nombre de pièces par hauteur (Largeur)
   PColonne = CDbl(LblLargeur) \ B
   
   
  'Nombre de rangees
  NbreRangees = NbrePieces / Pligne
  
  NbreRangeesSansDecimal = Format(NbreRangees, "#,0")
  Deci = CDbl(NbreRangees) - CDbl(NbreRangeesSansDecimal)
   
  NbreRangees = CDbl(NbreRangees) + (1 - CDbl(Deci))
   
 

 
   
  
   
   
  'Placer les objets
  
 
   For R = 1 To NbreRangees Step 1
    
    For PL = 1 To Pligne Step 1
  
    
            
    Picture1.Line (0 + ((PL - 1) * A), 0 + LargRangee)-Step(A, B), vbRed, B
    
    Picture1.CurrentX = ((0 + (CDbl(A) / 4)) + (PL - 1) * A)
    Picture1.CurrentY = ((0 + (CDbl(B) / 4)) + LargRangee)
    Picture1.Print "" & A & "x" & B
    
        
    CumulPLigne = CInt(CumulPLigne) + 1
    
     
    
    If CumulPLigne = NbrePieces Then
    GoTo AutreDimensions:
    Exit Sub
    End If
    
   
    
    Next PL
    LargRangee = CDbl(LargRangee) + CDbl(B)
    
       
    Next R
    
Ignore:

AutreDimensions:
LargRangee = CDbl(LargRangee) + CDbl(B)
CumulPLigne = 0

Next I


Merci quand même
0

Discussions similaires

"freebox" clignote (TV)
tetelle -
Twiggy -

62 réponses
FreeBox Révolution - Les code erreurs
baissaoui -
baissaoui -

0 réponse
triangle rouge
bichikouninette -
nina3066 -

2 réponses
FREEBOX : rectangle clignotant permanent
boloc -
foq -

17 réponses
Triangle rouge freebox tv révolution Light
sosop06 -
bazfile -

1 réponse