Publié par SFLPMEA le 13/12/2006
DAMIER.BAS Source Qbasic Version 4.5. Constitution d'un damier avec déplacement de cercle. Début d'un programme de jeu de Sazuke83 légèrement modifié par SFLPMEA
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54
CLS : SCREEN 12: WINDOW SCREEN (1, 1)-(640, 480) largeurcarre = 50: nbligne = 7: nbcol = 8: ecart = 10 Xdep = 30: Ydep = 10 rayoncercle = largeurcarre / 2 - 1 ' *** - 1 pour ne pas empiéter sur les cases du damier Pas = largeurcarre + ecart YCercle = -Pas: Xcercle = Pas '-----DAMIER----- FOR K = 0 TO (nbligne - 1) FOR J = 0 TO (nbcol - 1) X = Xdep + J * (largeurcarre + ecart) Y = Ydep + K * (largeurcarre + ecart) IF (K = 2) AND (J = 1) THEN '----case colore----- LINE (X, Y)-(X + largeurcarre, Y + largeurcarre), 12, B: LINE (X + 2, Y + 2)-(X + largeurcarre - 2, Y + largeurcarre - 2), 5, BF ELSE LINE (X, Y)-(X + largeurcarre, Y + largeurcarre), 12, B END IF NEXT J X = Xdep NEXT K '-----CERCLE----- Xcercle = X + (largeurcarre / 2) YCercle = Y + (largeurcarre / 2) 'création du cercle avec les coordonnées Xcercle, Ycercle CIRCLE (Xcercle, YCercle), rayoncercle - 1, 11 CIRCLE (Xcercle, YCercle), rayoncercle - 2, 11 LOCATE 29, 10: PRINT Xcercle; YCercle; ' *** A Supprimer après tests X.Pr = Xcercle Y.Pr = YCercle DO ' ***** BOUCLE GENERALE '---- TOUCHES de COMMANDES ----- INK: Touche$ = INKEY$: IF Touche$ = "" GOTO INK IF Touche$ = CHR$(27) THEN END SELECT CASE Touche$ CASE CHR$(0) + "H": YCercle = YCercle - Pas CASE CHR$(0) + "P": YCercle = YCercle + Pas CASE CHR$(0) + "K": Xcercle = Xcercle - Pas CASE CHR$(0) + "M": Xcercle = Xcercle + Pas END SELECT ' *** Il ne faut pas sortir du damier ... IF Xcercle < 55 THEN Xcercle = 55: BEEP: GOTO INK IF Xcercle > 475 THEN Xcercle = 475: BEEP: GOTO INK IF YCercle > 395 THEN YCercle = 395: BEEP: GOTO INK IF YCercle < 35 THEN YCercle = 35: BEEP: GOTO INK CIRCLE (X.Pr, Y.Pr), rayoncercle - 1, POINT(X.Pr, Y.Pr)'(ou 0) CIRCLE (X.Pr, Y.Pr), rayoncercle - 2, POINT(X.Pr, Y.Pr)'0 LOCATE 29, 10: PRINT Xcercle; YCercle; ' *** A Supprimer après tests CIRCLE (Xcercle, YCercle), rayoncercle - 1, 11 CIRCLE (Xcercle, YCercle), rayoncercle - 2, 11 X.Pr = Xcercle: Y.Pr = YCercle LOOP ' ***** FIN de BOUCLE GENERALE '------------- case-----------------------
