Traçage de triangles dans la PictureBox
Résolu/Fermé
Lenouveauapprenti
Messages postés
300
Date d'inscription
samedi 22 décembre 2018
Statut
Membre
Dernière intervention
7 avril 2024
-
Modifié le 6 mars 2020 à 16:52
Lenouveauapprenti Messages postés 300 Date d'inscription samedi 22 décembre 2018 Statut Membre Dernière intervention 7 avril 2024 - 8 mars 2020 à 14:00
Lenouveauapprenti Messages postés 300 Date d'inscription samedi 22 décembre 2018 Statut Membre Dernière intervention 7 avril 2024 - 8 mars 2020 à 14:00
A voir également:
- Traçage de triangles dans la PictureBox
- Tracage de telephone - Guide
- Triangle qui clignote en bas à droite de la télé freebox révolution ✓ - Forum Freebox
- Traçage mobile ✓ - Forum Mobile
- Triangle qui clignote en bas à droite de la télé (freebox révolution) - Forum Samsung
- FreeBox Révolution - Les code erreurs - Astuces et Solutions
2 réponses
Lenouveauapprenti
Messages postés
300
Date d'inscription
samedi 22 décembre 2018
Statut
Membre
Dernière intervention
7 avril 2024
2
7 mars 2020 à 17:48
7 mars 2020 à 17:48
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
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
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
Lenouveauapprenti
Messages postés
300
Date d'inscription
samedi 22 décembre 2018
Statut
Membre
Dernière intervention
7 avril 2024
2
8 mars 2020 à 14:00
8 mars 2020 à 14:00
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 :
Merci quand même
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