Option Explicit Public Declare Sub Sleep Lib "Kernel32.dll" (ByVal dwMillisenconds As Long) Public scH As Long Public scW As Long Public i As Integer ' indice de boucle Public V As Variant ' centre de la boule Public H As Variant ' centre de la boule Public N As Variant ' Côté opposé Public Hz, Vt As Integer 'Distance horizontale et verticale Public Rap As Variant '= tangente de l'angle de déplacement Public Att As Integer 'Variable pour le temps de Sleep en millisec Public Lx1, Lx2, Ly1, Ly2 ' Extrémités de la ligne L Public Clk As Boolean ' Bouton souris enfoncé ou pas Public Lq As Integer ' longueur de la queue de billard Public Ecart As Integer 'Déplacement de l'extrémité de la queue _________________________________________________________ Public Sub Main() scH = Screen.Height: scW = Screen.Width ' 12960 x 23040 Ecran.Height = scH: Ecran.Width = scW Ecran.Fin.Left = scW - 1000: Ecran.Fin.Top = scH - 500 Ecran.Go.Left = scW - 2000: Ecran.Go.Top = scH - 500 Ecran.Tape.Left = scW - 3000: Ecran.Tape.Top = scH - 500 Ecran.TP.Height = 8000: Ecran.TP.Width = 16000 Ecran.TP.Left = 2500: Ecran.TP.Top = 2500 H = 6500: V = 6500 H2 = 13000: V2 = 3200 Lq = 2800 'Longueur de la queue Q : 2800 Ecran.B.Left = H - 240: Ecran.B.Top = V - 240 Ecran.R.Left = H2 - 240: Ecran.R.Top = V2 - 240 Ecran.Q.X2 = H: Ecran.Q.Y2 = V Ecran.Q.X1 = H - Lq: Ecran.Q.Y1 = V Ecran.L.X1 = Lx1: Ecran.L.Y1 = Ly1: Ecran.L.X2 = Lx2: Ecran.L.Y2 = Ly2 Att = 8 Ecran.Lb.Left = 19000 Ecran.Show 'Ecran.QQ.Left = 100: Ecran.QQ.Top = V - 50 End Sub '==================================================
Public Sub Deplace() 'If Vt = 0 Then ' EN ATTENTE 'If Hz = 0 Then' EN ATTENTE If Vt > 0 And Hz > 0 Then NO If Vt > 0 And Hz < 0 Then NE If Vt < 0 And Hz < 0 Then SE If Vt < 0 And Hz > 0 Then SO End Sub _________________________________________________________ Public Sub NO() ' Venant du SE For i = 1 To 500 Step 10 V = V - i * Rap: H = H - i If V - 240 < 2500 Then Rap = -Rap: SO If H - 240 < 2500 Then Rap = -Rap: NE Trace Next End Sub _________________________________________________________ Public Sub NE() ' Venant du SO For i = 1 To 500 Step 10 V = V + i * Rap: H = H + i If V - 240 < 2500 Then Rap = -Rap: SE If H + 240 > 18500 Then Rap = -Rap: NO Trace Next End Sub _________________________________________________________ Public Sub SO() ' Venant du NE For i = 1 To 500 Step 10 V = V - i * Rap: H = H - i If V + 240 > 10500 Then Rap = -Rap: NO If H - 240 < 2500 Then Rap = -Rap: SE Trace Next End Sub _________________________________________________________ Public Sub SE() ' Venant du NO For i = 1 To 500 Step 10 V = V + i * Rap: H = H + i If V + 240 > 10500 Then Rap = -Rap: NE If H + 240 > 18500 Then Rap = -Rap: SO Trace Next End Sub _________________________________________________________ Public Sub Trace() ' Affichage de la boule 'If V > 2740 And V < 10260 And H < 18260 And H > 2740 Then Ecran.B.Left = H - 240: Ecran.B.Top = V - 240: Sleep (100) ' Else ' Retour si la boule est sortie du tapis ' H = 6500: V = 6500 ' Ecran.B.Left = H - 240: Ecran.B.Top = V - 240 'End If End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) ' Ancrage de la ligne au centre de la boule Lx1 = H: Ly1 = V: Clk = True End Sub _________________________________________________________ Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) ' Placement de la ligne de lancement avec le clic de la souris Lx2 = X: Ly2 = Y If Clk Then With Me.L .X1 = Lx1 .Y1 = Ly1 .X2 = Lx2 .Y2 = Ly2 .Visible = True End With End If End Sub _________________________________________________________ Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) ' Ancrage du bout de la ligne avant de lancer la boule Lx2 = X: Ly2 = Y: Clk = False Vt = (Y - V): Hz = (X - H): Rap = Vt / Hz 'Lb.Caption = "horiz = " & Hz & vbCrLf & "vert = " & Vt & vbCrLf & "Rap = " & Vt / Hz End Sub _________________________________________________________ Private Sub Go_Click() ' Lancement de la boule ' et calcul de la direction par rapport à son centre 'If Vt = 0 Then ' EN ATTENTE 'End If 'If Hz = 0 Then ' EN ATTENTE 'End If If Vt > 0 And Hz > 0 Then SudEst If Vt > 0 And Hz < 0 Then SudOuest If Vt < 0 And Hz < 0 Then NordOuest If Vt < 0 And Hz > 0 Then NordEst End Sub _________________________________________________________ Public Sub SudEst() Att = Att + 10 ' à chaque rebond la boule ralentit For i = 1 To 500 ' Déplacement de la boule et rebond si elle arrive au bord tu tapis V = V + i * Rap: H = H + i If V + 240 > 10500 Then Rap = -Rap: NordEst If H + 240 > 18500 Then Rap = -Rap: SudOuest affich Next End Sub _________________________________________________________ Public Sub SudOuest() Att = Att + 10 For i = 1 To 500 V = V - i * Rap: H = H - i If V + 240 > 10500 Then Rap = -Rap: NordOuest If H - 240 < 2500 Then Rap = -Rap: SudEst affich Next End Sub _________________________________________________________ Public Sub NordOuest() Att = Att + 10 For i = 1 To 500 V = V - i * Rap: H = H - i If V - 240 < 2500 Then Rap = -Rap: SudOuest If H - 240 < 2500 Then Rap = -Rap: NordEst affich Next End Sub _________________________________________________________ Public Sub NordEst() Att = Att + 10 For i = 1 To 500 V = V + i * Rap: H = H + i If V - 240 < 2500 Then Rap = -Rap: SudEst If H + 240 > 18500 Then Rap = -Rap: NordOuest affich Next End Sub _________________________________________________________ Public Sub affich() ' Tant que la boule reste sur le tapis If H > 2500 And H < 18500 And V > 2500 And V < 10500 Then B.Left = H - 240: B.Top = V - 240: Sleep (Att) End If End Sub Private Sub Fin_Click() End End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 27 Then End Lb.Caption = "" Ecart = 10 ' Déplacement de l'exremité de la queue pour trouver le bon angle Select Case KeyCode Case 37 If Q.X1 - Ecart < H - 2800 Then Exit Sub Q.X1 = Q.X1 - Ecart XY (Abs(H - Q.X1)) If Q.Y1 < V Then Q.Y1 = V - N Else Q.Y1 = V + N Case 38 If Q.Y1 - Ecart < V - 2800 Then Exit Sub Q.Y1 = Q.Y1 - Ecart XY (Abs(V - Q.Y1)) If Q.X1 < H Then Q.X1 = H - N Else Q.X1 = H + N Case 39 If Q.X1 + Ecart > H + 2800 Then Exit Sub Q.X1 = Q.X1 + Ecart XY (Abs(H - Q.X1)) If Q.Y1 < V Then Q.Y1 = V - N Else Q.Y1 = V + N Case 40 If Q.Y1 + Ecart > V + 2800 Then Exit Sub Q.Y1 = Q.Y1 + Ecart XY (Abs(V - Q.Y1)) If Q.X1 < H Then Q.X1 = H - N Else Q.X1 = H + N Case 27 End End Select Vt = Q.Y1 - V: Hz = Q.X1 - H: Rap = Vt / Hz Lb.Caption = "Vert = " & Vt & vbCrLf & "Horiz = " & Hz & vbCrLf & "Rap = " & Vt / Hz End Sub _________________________________________________________ Public Function XY(z) ' calcul du côté opposé pour avoir la tangente N = Sqr(Abs((2800 ^ 2) - (z ^ 2))) End Function _________________________________________________________ Private Sub Tape_Click() ' Lancement de la boule ' (La procédure "Deplace" est dans le module) Deplace End Sub
Public Sub SudOuest() Att = Att + 10 For i = 1 To 500 V = V - i * Rap: H = H - i If V + 240 > 10500 Then Rap = -Rap: NordOuest If H - 240 < 2500 Then Rap = -Rap: SudEst affich Next End Sub
If V + 240 > 10500 Then Rap = -Rap: NordOuest
If V + 240 > 10500 Then Rap = -Rap NordOuest End If
Public Sub SudOuest() Att = Att + 10 For i = 1 To 500 V = V - i * Rap: H = H - i If V + 240 > 10500 Then Rap = -Rap: NordOuest If H - 240 < 2500 Then Rap = -Rap: SudEst affich Next End Sub
Public Sub SudOuest() Dim Exit as Integer Att = Att + 10 Do V = V - 1 * Rap: H = H - 1 If V + 240 > 10500 Then Exit = 1: Exit Do If H - 240 < 2500 Then Exit = 2: Exit Do affich Loop If Exit = 1 Then Rap = -Rap: NordOuest If Exit = 2 Then Rap = -Rap: SudEst End Sub
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionPublic Sub SudOuest() Dim Exit as Integer Att = Att + 10 Do V = V - 1 * Rap: H = H - 1 If V + 240 > 10500 Then Exit = 1: Exit Do ' Exit Do obligatoire car code en sortie de boucle If H - 240 < 2500 Then Exit = 2: Exit Do affich Loop If Exit = 1 Then Rap = -Rap: NordOuest If Exit = 2 Then Rap = -Rap: SudEst End Sub Public Sub SudOuest() Dim Exit as Integer Att = Att + 10 Do V = V - 1 * Rap: H = H - 1 If V + 240 > 10500 Then Exit Do ' Exit Do ou Exit Sub mais préférer Exit Do car boucle Do Loop If H - 240 < 2500 Then Exit Do affich Loop End Sub Public Sub TestFichier(Fichier as String) If System.IO.File.Exits(Fichier) = false then Exit Sub ' là c'est un Exit Sub obligatoire ' suite du code si le fichier existe '''''' '''''' End sub