Guidance
指路人
g.yi.org
software / rapidq / Examples / Game / JeaRie.bas

Register 
注册
Search 搜索
首页 
Home Home
Software
Upload

  
'***************************************************************************
' Pour mes filles jumelles Jeanne et Marie (4 ans en janvier 2003)         *
' for my twins, Jeanne and Marie (4 years old on February 2003)            *
' (all comments in Franch, but you should easely understand it)            *
'                                                                          *
' Sized for Windows XP (windows bar a little bit higher) : should need to  *
' review procedures MainFormPaint and MainFormShape a little bit to adapt  *
'
' To play with other pictures, just add new BMP (only BMP in the jeaRie.Exe*
' folder and remove old ones                                               *
'***************************************************************************
     CONST JeaRiePurpose   AS STRING  = "Petit jeu pour apprendre les lettres, les chiffres ...."
     CONST JeaRieTitre     AS STRING  = "        Jea*Rie"
     CONST JeaRieCopyright AS STRING  = "© Pascal Delcombel - freeware - pdelcombel@free.fr"
     CONST JeaRieVersion   AS STRING  = "1.0 du 12 décembre 2002"
     $INCLUDE "RAPIDQ.INC"
     $TYPECHECK ON

'**********************
'les éléments globaux *
'**********************
'Fichiers ressources
     $RESOURCE BmpBoutonStd  AS "BoutonStandard"
     $RESOURCE Icone         AS "JeaRie.ico"
     $RESOURCE WavBravo      AS "applaudir.wav"
     $RESOURCE WavLettreOK   AS "sonnaille.wav"
     $RESOURCE WavFin        AS "fin.wav"
     $RESOURCE WavRate       AS "rate.wav"
     $RESOURCE WavAide       AS "aide.wav"
     $RESOURCE WavNouveau    AS "BruitsDeMachine.wav"

'Quelques constantes
     CONST LettreMax = 10
     CONST Lettre AS STRING = "ABCDEFGHIJKLMNOPQRSTUVWXYZéèêû"

'Variables globales
     DIM PetiteLargeur           AS INTEGER
     DIM GrandeLargeur           AS INTEGER
     DIM ShapeCoul(5)            AS QOVALBTN
     DIM CouleursTransparent(5)  AS INTEGER
     DIM CouleursFond(5)         AS INTEGER
     DIM CouleursBordure(5)      AS INTEGER
     DIM ChoixCouleur            AS INTEGER
     ChoixCouleur                = 1
     CouleursTransparent(1)      = &HCCCCCC
     CouleursTransparent(2)      = &HCCCCCC
     CouleursTransparent(3)      = &HCCCCCC
     CouleursTransparent(4)      = &HCCCCCC
     CouleursTransparent(5)      = &HCCCCCC
     CouleursFond(1)             = &HFF00
     CouleursBordure(1)          = &H8000
     CouleursFond(2)             = &HFF0000
     CouleursBordure(2)          = &H800000
     CouleursFond(3)             = &HFF
     CouleursBordure(3)          = &H80
     CouleursFond(4)             = &HFF00FF
     CouleursBordure(4)          = &H8000FF
     CouleursFond(5)             = &HC0C0C0
     CouleursBordure(5)          = &H0

     DIM i AS INTEGER, j AS INTEGER, k AS INTEGER
     DIM ListeImages(0) AS STRING
     DIM NombreImages AS INTEGER
     DIM LettresTrouvées AS INTEGER
     DIM LettreTrouvée(10) AS INTEGER
     DIM MotTrouve AS INTEGER
     DIM Ratés AS INTEGER
     DIM NomImage AS STRING
     DIM JeuEnCours AS INTEGER
     DIM Couleurs(30) AS LONG

     Couleurs(1) = RGB(250,0,0)
     Couleurs(7) = RGB(0,0,200)
     Couleurs(13) = RGB(100,200,0)
     Couleurs(19) = RGB(0,200,200)
     Couleurs(25) = RGB(200,200,0)

     DIM MyFont AS QFONT
     MyFont.Size = 24
     MyFont.Name = "Arial"
     Myfont.addstyles("bold")

'Les procédures
     DECLARE SUB Barre(NB AS INTEGER, Texte AS STRING)
     DECLARE SUB MainFormShape
     DECLARE SUB MinusculeMajuscule
     DECLARE SUB Chiffres(iM AS INTEGER)
     DECLARE SUB ChargerImages
     DECLARE SUB MouseDown (MouseButton AS LONG, X AS LONG, Y AS LONG, Shift AS LONG, Sender AS QBUTTON)
     DECLARE SUB NouveauMotATrouver
     DECLARE SUB NouveauCalculATrouver
     DECLARE SUB NouveauCompteATrouver
     DECLARE SUB NouveauHeureATrouver
     DECLARE SUB AideEnLigne
     DECLARE SUB Sortie
     DECLARE SUB SwitchMajus
     DECLARE SUB SwitchDigit
     DECLARE SUB MainFormPaint(Sender AS QFORM)
     DECLARE SUB NouvelleCouleur(Sender AS QOVALBTN)
     DECLARE FUNCTION Nombre(x%) AS STRING
     DECLARE SUB DessineBouton(Btn AS QBUTTON)
     DECLARE FUNCTION NiveauDeJeu() AS INTEGER

'********************
' l'écran principal *
'********************
     DIM Barres(3)     AS QLABEL
     DIM Lettres(30)   AS QBUTTON
     DIM MainForm      AS QFORM
     DIM NouveauMot    AS QBUTTON
     DIM NouveauCalcul AS QBUTTON
     DIM NouveauCompte AS QBUTTON
     DIM NouveauHeure  AS QBUTTON
     DIM Sortir        AS QBUTTON
     DIM Help          AS QBUTTON
     DIM Ecriture      AS QPANEL
     DIM Dessin        AS QIMAGE
     DIM Dessins(10)   AS QIMAGE
     DIM AideB         AS QBUTTON
     DIM FondImage     AS QBITMAP
     DIM FondDessin    AS QBITMAP
     DIM Majus         AS QOVALBTN
     DIM Digit         AS QOVALBTN
     DIM MyTimer       AS QTIMER
     DIM DessineBtn    AS QBITMAP
     DIM niveau(3)     AS QCOOLBTN

     MainForm.CAPTION     = JeaRieTitre
     MainForm.width       = 370 + 60 * (LettreMax-1) - 10
     MainForm.height      = 605

     FondImage.width      = MainForm.width
     FondImage.height     = MainForm.height
     MainForm.IcoHandle   = Icone
     MainForm.OnPaint     = MainFormPaint
     PetiteLargeur        = (Mainform.Width - MainForm.ClientWidth) / 2
     GrandeLargeur        = MainForm.Height - MainForm.ClientHeight - PetiteLargeur

     Niveau(1).left       = 115
     Niveau(2).left       = 141
     Niveau(3).left       = 167
     FOR i = 1 TO 3
      Niveau(i).PARENT     = MainForm
      Niveau(i).Groupindex = 44
      Niveau(i).Width      = 26
      Niveau(i).Height     = 26
      Niveau(i).Top        = 23
      Niveau(i).Groupindex = 44
      FondDessin.width  = 80
      FondDessin.height = 20
      FondDessin.FillRect(0,0,80,20,&h0)
      FondDessin.FillRect(1,1,79,19,CouleursFond(i))
      FondDessin.Font.Size = 14
      FondDessin.Font.Name = "Arial"
      FondDessin.Font.Name = "Wingdings"
      FondDessin.font.addstyles("bold")
      FondDessin.TextOut(1,1,CHR$(73+i),CouleursBordure(i),-1)
      FondDessin.TextOut(21,1,CHR$(73+i),CouleursBordure(i),-1)
      FondDessin.TextOut(41,1,CHR$(73+i),CouleursBordure(i),-1)
      FondDessin.TextOut(61,1,CHR$(73+i),CouleursBordure(i),-1)
      FondDessin.SaveToFile("JeaRie")
      Niveau(i).NumBMPs = 4
      Niveau(i).bmp     = "JeaRie"
      Niveau(i).hint = "Niveau de jeu"
      Niveau(i).showhint = true
     NEXT
     Niveau(1).down       = true

     Majus.PARENT    = MainForm
     Majus.left      = 3
     Majus.top       = 57
     Majus.width     = 38
     Majus.height    = 25
     Majus.Font.Size = 10
     Majus.CAPTION   = "MAJ"
     Majus.down      = true
     Majus.groupindex= 1
     Majus.hint      = "MAJUSCULE ou minuscule"
     Majus.ShowHint  = 1
     Majus.OnClick   = SwitchMajus

     Digit.PARENT    = MainForm
     Digit.left      = 41
     Digit.top       = 57
     Digit.width     = 38
     Digit.height    = 25
     Digit.Font.Size = 10
     Digit.CAPTION   = "UN"
     Digit.down      = false
     Digit.groupindex= 2
     Digit.hint      = "UN ou 1"
     Digit.ShowHint  = 1
     Digit.OnClick   = SwitchDigit

     FOR i = 1 TO 5
      ShapeCoul(i).PARENT  = MainForm
      ShapeCoul(i).width   = 15
      ShapeCoul(i).height  = 15
      ShapeCoul(i).onClick = NouvelleCouleur
      ShapeCoul(i).tag     = i
      shapecoul(i).COLOR   = couleursFond(i)
      shapecoul(i).hint    = "Change les couleurs"
      shapecoul(i).ShowHint= 1
     NEXT
     ShapeCoul(1).top     = 1
     ShapeCoul(1).left    = 39
     ShapeCoul(2).top     = 15
     ShapeCoul(2).left    = 49
     ShapeCoul(3).top     = 18
     ShapeCoul(3).left    = 67
     ShapeCoul(4).top     = 14
     ShapeCoul(4).left    = 85
     ShapeCoul(5).top     = 1
     ShapeCoul(5).left    = 97

     Barres(1).PARENT     = MainForm
     Barres(2).PARENT     = MainForm
     Barres(3).PARENT     = MainForm
     Barres(1).width      = 300
     Barres(2).width      = 160
     Barres(3).width      = 318
     Barres(1).height     = 20
     Barres(2).height     = 20
     Barres(3).height     = 20
     Barres(1).left       = 54
     Barres(2).left       = 355
     Barres(3).left       = 515
     Barres(1).top        = 552
     Barres(2).top        = 552
     Barres(3).top        = 552
     Barres(1).layout     = 1
     Barres(2).layout     = 1
     Barres(3).layout     = 1
     Barres(1).font.size  = 10
     Barres(2).font.size  = 10
     Barres(3).font.size  = 10
     Barre(1,"Allez, commençons un nouveau Mot !!")
     Barre(2,"Mot déjà trouvé : 0")
     Barre(3,JeaRieCopyright)

     NouveauMot.OnClick   = NouveauMotATrouver
     NouveauMot.PARENT    = MainForm
     NouveauMot.left      = 200
     NouveauMot.top       = 10
     NouveauMot.width     = 80
     NouveauMot.height    = 80
     NouveauMot.hint      = "Nouveau mot"
     NouveauMot.ShowHint  = 1
     NouveauMot.Tag       = 1
     DessineBouton(NouveauMot)

     NouveauCompte.OnClick   = NouveauCompteATrouver
     NouveauCompte.PARENT    = MainForm
     NouveauCompte.left      = 300
     NouveauCompte.top       = 10
     NouveauCompte.width     = 80
     NouveauCompte.height    = 80
     NouveauCompte.hint      = "Nouveau comptage"
     NouveauCompte.ShowHint  = 1
     NouveauCompte.Tag       = 2
     DessineBouton(NouveauCompte)

     NouveauCalcul.OnClick   = NouveauCalculATrouver
     NouveauCalcul.PARENT    = MainForm
     NouveauCalcul.left      = 400
     NouveauCalcul.top       = 10
     NouveauCalcul.width     = 80
     NouveauCalcul.height    = 80
     NouveauCalcul.hint      = "Nouveau calcul"
     NouveauCalcul.ShowHint  = 1
     NouveauCalcul.Tag       = 3
     DessineBouton(NouveauCalcul)

     NouveauHeure.OnClick   = NouveauHeureATrouver
     NouveauHeure.PARENT    = MainForm
     NouveauHeure.left      = 500
     NouveauHeure.top       = 10
     NouveauHeure.width     = 80
     NouveauHeure.height    = 80
     NouveauHeure.hint      = "Les heures"
     NouveauHeure.ShowHint  = 1
     NouveauHeure.Tag       = 4
     DessineBouton(NouveauHeure)

     Ecriture.PARENT      = Mainform
     Ecriture.left        = 320
     Ecriture.top         = 100
     Ecriture.width       = MainForm.Width - Ecriture.Left - 20
     Ecriture.height      = MainForm.Height - Ecriture.top - 60
     dessin.PARENT        = Ecriture
     dessin.left          = 5
     dessin.top           = 5
     dessin.width         = ecriture.width - 10
     dessin.Height        = ecriture.Height - 10
     dessin.visible       = 0

     FOR i = 1 TO LettreMax
      dessins(i).PARENT  = Ecriture
      dessins(i).width   = 40
      dessins(i).height  = 60
      dessins(i).left    = 10 + 50 * (i-1)
      dessins(i).top     = ecriture.height - 60 - 10
      dessins(i).visible = false
     NEXT

     AideB.PARENT    = Ecriture
     AideB.visible   = false
     AideB.enabled   = false

     Sortir.OnClick = Sortie
     Sortir.PARENT    = MainForm
     Sortir.left      = 800
     Sortir.top       = 10
     Sortir.width     = 80
     Sortir.height    = 80
     Sortir.hint      = "Fin"
     Sortir.ShowHint  = 1
     Sortir.Tag       = 6
     DessineBouton(Sortir)

     Help.OnClick = AideEnLigne
     Help.PARENT    = MainForm
     Help.left      = 700
     Help.top       = 10
     Help.width     = 80
     Help.height    = 80
     Help.hint      = "Aide"
     Help.ShowHint  = 1
     Help.enabled   = false
     Help.Tag       = 5
     DessineBouton(Help)

     ChargerImages        'Images dans le folder de l'application
     MainFormShape        'forme et couleurs de la fenêtre MainForm
     MainForm.SHOWMODAL   'c'est parti...

'*****************************************************************
'procédures et fonctions                                         *
'*****************************************************************
'Traitement des couleurs et forme de la fenêtre
'==============================================
'Changement de Couleur (demandé par l'utilisateur)
     SUB NouvelleCouleur(Sender AS QOVALBTN)
      ChoixCouleur = Sender.tag
      IF ChoixCouleur > 0 THEN MainFormShape
     END SUB

'Forme de MainForm (calcul de la forme)
     SUB MainFormShape
      DIM i AS INTEGER

      Barres(1).COLOR       = CouleursBordure(ChoixCouleur)
      Barres(2).COLOR       = CouleursBordure(ChoixCouleur)
      Barres(3).COLOR       = CouleursBordure(ChoixCouleur)
      Barres(1).font.COLOR  = couleursFond(ChoixCouleur)
      Barres(2).font.COLOR  = couleursFond(ChoixCouleur)
      Barres(3).font.COLOR  = couleursFond(ChoixCouleur)
      Ecriture.COLOR        = CouleursBordure(ChoixCouleur)

    'préparation
      FondImage.fillrect(0,0,1000,700,couleursTransparent(ChoixCouleur))
      FondImage.fillrect(40,45,200,95,couleursFond(ChoixCouleur))
      FondImage.fillrect(4,95,889,595,couleursFond(ChoixCouleur))
      FondImage.fillrect(887,95,889,595,couleursBordure(ChoixCouleur))
      FondImage.fillrect(4,95,6,595,couleursBordure(ChoixCouleur))
      FondImage.fillrect(4,593,889,595,couleursBordure(ChoixCouleur))
      FondImage.fillrect(40,43,200,45,couleursBordure(ChoixCouleur))

    'Partie en haut à gauche
      FondImage.Circle(18,20,103,105,CouleursBordure(ChoixCouleur),CouleursBordure(ChoixCouleur))
      FondImage.Circle(20,22,101,103,CouleursTransparent(ChoixCouleur),CouleursTransparent(ChoixCouleur))
      FondImage.fillrect(0,20,50,95,CouleursTransparent(ChoixCouleur))
      FondImage.Circle(4,70,84,120,CouleursBordure(ChoixCouleur),CouleursBordure(ChoixCouleur))
      FondImage.Circle(6,72,82,118,CouleursFond(ChoixCouleur),CouleursFond(ChoixCouleur))
      FondImage.Circle(40,0,120,60,CouleursBordure(ChoixCouleur),CouleursBordure(ChoixCouleur))
      FondImage.Circle(42,2,118,58,CouleursFond(ChoixCouleur),CouleursFond(ChoixCouleur))
      FondImage.fillrect(80,45,150,55,CouleursFond(ChoixCouleur))
      FondImage.fillrect(6,97,88,150,CouleursFond(ChoixCouleur))

    'Partie en haut, les créneaux
      FOR i = 0 TO 6
       IF i <> 4 THEN
        FondImage.fillrect(100*i+200,22,100*i+290,100,CouleursBordure(ChoixCouleur))
        FondImage.Circle(100*i+200,0,100*i+290,80,CouleursBordure(ChoixCouleur),CouleursBordure(ChoixCouleur))
        FondImage.Circle(100*i+202,2,100*i+288,78,CouleursFond(ChoixCouleur),CouleursFond(ChoixCouleur))
        FondImage.FillRect(100*i+206,26,100*i+284,30,CouleursBordure(ChoixCouleur))
        FondImage.FillRect(100*i+200,0,100*i+290,29,CouleursTransparent(ChoixCouleur))
        FondImage.fillrect(100*i+202,42,100*i+288,98,CouleursFond(ChoixCouleur))
        FondImage.fillrect(100*i+200,45,100*i+288,100,CouleursFond(ChoixCouleur))
       END IF
      NEXT
      FOR i = 0 TO 6
       IF i <> 4 THEN
        FondImage.Fillrect(100*i+288,40,100*i+302,100,CouleursBordure(ChoixCouleur))
        FondImage.Fillrect(100*i+290,0,100*i+300,98,CouleursTransparent(ChoixCouleur))
       END IF
      NEXT
    'pas de créneau 4
      FondImage.Fillrect(588,40,702,100,CouleursBordure(ChoixCouleur))
      FondImage.Fillrect(590,0,700,98,CouleursTransparent(ChoixCouleur))
    'un peu de propre
      FondImage.fillrect(887,34,889,595,couleursBordure(ChoixCouleur))

    'Partie en bas à gauche
      FondImage.fillrect(4,545,58,595,CouleursBordure(ChoixCouleur))
      FondImage.Circle(4,530,58,560,CouleursBordure(ChoixCouleur),CouleursBordure(ChoixCouleur))
      FondImage.Circle(6,532,56,558,CouleursTransparent(ChoixCouleur),CouleursTransparent(ChoixCouleur))
      FondImage.fillrect(4,544,56,595,CouleursTransparent(ChoixCouleur))

    'Partie bas droite
      FondImage.Circle(889-50,595-50,889+10,595+10,CouleursBordure(ChoixCouleur),CouleursBordure(ChoixCouleur))
      FondImage.Circle(889-48,595-48,889+8,595+8,CouleursTransparent(ChoixCouleur),CouleursTransparent(ChoixCouleur))

    'La fin, un peu de propre
      FondImage.fillrect(0,0,1000,5,couleursTransparent(ChoixCouleur))
      FondImage.fillrect(0,595,1000,600,couleursTransparent(ChoixCouleur))
      FondImage.fillrect(0,0,4,600,couleursTransparent(ChoixCouleur))
      FondImage.fillrect(889,0,1000,600,couleursTransparent(ChoixCouleur))
      FondImage.saveTofile("JeaRie")

   'C'est bon: on dessine
      MainForm.COLOR = &HAAAAAA
      MainForm.shapeForm("JeaRie",CouleursTransparent(ChoixCouleur))
      MainFormPaint(MainForm)
      FOR i = 1 TO 5
       shapecoul(i).enabled = false
       shapecoul(i).enabled = true
      NEXT
      FOR i = 1 TO 3
       Niveau(i).enabled = false
       Niveau(i).enabled = true
      NEXT
      SwitchMajus
      Majus.enabled = false
      Majus.enabled = true
      SwitchDigit
      Digit.enabled = false
      Digit.enabled = true
     END SUB

'Fond d'écran (colorisation de la fenêtre)
     SUB MainFormPaint(Sender AS QFORM)
      DIM Dest AS QRECT
      DIM Source AS QRECT

      Source.top      = 30
      Source.left     = 4
      source.Right    = source.left + Sender.width
      source.bottom   = source.top  + Sender.height
      Dest.top        = 0
      Dest.left       = 0
      Dest.Right      = Sender.Width
      Dest.bottom     = Sender.height
      sender.copyrect(Dest,FondImage,Source)
     END SUB


'Traitement des solutions
'========================
'Aide en ligne (à la demande du joueur, donne la prochaine lettre/chiffre à jouer)
     SUB AideEnLIgne
      DIM i AS INTEGER, j AS INTEGER, k AS INTEGER
      DIM wC AS STRING

      PLAYWAV WavAide,SND_ASYNC
      FOR i = 1 TO LettreMax
       IF LettreTrouvée(i) = false  THEN
        FOR j = 1 TO 30
         IF UCASE$(lettres(j).CAPTION) = UCASE$(MID$(NomImage,i,1)) THEN
          AideB.left    = dessins(i).left
          AideB.top     = dessins(i).top
          AideB.width   = dessins(i).width
          AideB.height  = dessins(i).height
          AideB.font    = MyFont
          AideB.Font.COLOR = dessins(i).font.COLOR
          AideB.visible = 1
          wC = lettres(j).CAPTION
          FOR k = 1 TO 32
           SLEEP 0.20
           IF (k MOD 2) = 0 THEN
            lettres(j).CAPTION = wC
            AideB.CAPTION = ""
           ELSE
            lettres(j).CAPTION = ""
            AideB.CAPTION = wC
           END IF
          NEXT
          AideB.visible = 0
          j = 30
         END IF
        NEXT j
        i = LettreMax
       END IF
      NEXT i
     END SUB

'Drag les boutons (et vérifie si la réponse est correcte)
     SUB MouseDown (MouseButton AS LONG, X AS LONG, Y AS LONG, Shift AS LONG, Sender AS QBUTTON)
      DIM nx AS INTEGER, ny AS INTEGER
      DIM i AS INTEGER, k AS INTEGER
      DIM Trouve AS INTEGER

      nx = Sender.left
      ny = Sender.Top
      Sender.StartDrag

      Trouve = false
      FOR i = 1 TO LettreMax
       IF Sender.left                >= Ecriture.left + dessins(i).left - 20 AND _
        Sender.Left+Sender.Width   <= Ecriture.left + dessins(i).left + dessins(LettresTrouvées+1).Width + 20 AND _
        Sender.top                 >= Ecriture.top  + dessins(i).top - 20 AND _
        Sender.top+Sender.height   <= Ecriture.top + dessins(i).top + dessins(LettresTrouvées+1).height + 20 AND _
        LettreTrouvée(i) = false  THEN

        Sender.left = Ecriture.left + dessins(i).left
        Sender.top  = Ecriture.top  + dessins(i).top

        IF UCASE$(sender.CAPTION) = UCASE$(MID$(NomImage,i,1)) THEN
         Trouve = true
         LettresTrouvées++
         Ratés = 0
         LettreTrouvée(i) = 1
         IF LettresTrouvées = 1 THEN
          Barre(1,"Première lettre trouvée: bravo !")
         ELSE
          barre(1,"Déjà "+STR$(LettresTrouvées)+ " lettres trouvées : continues !!")
         END IF
         dessins(i).Font = MyFont
         dessins(i).Font.COLOR = Sender.font.COLOR
         dessins(i).fillrect(0,0,40,60,RGB(150,150,50))
         dessins(i).TextOut(10,10,Sender.CAPTION,Sender.Font.COLOR,-1)
         IF LettresTrouvées = LEN(NomImage) THEN
          Help.enabled = false
          MotTrouve++
          barre(1,"Bravo : tu as parfaitement complété le mot !")
          IF MotTrouve = 1 THEN
           barre(2,"Mot déjà trouvé : 1")
          ELSE
           barre(2,"Mots déjà trouvés : "+STR$(MotTrouve))
          END IF
          FOR k = 1 TO 30
           lettres(k).enabled = false
          NEXT
          PLAYWAV WavBravo,SND_ASYNC
          FOR k = 1 TO 30
           lettres(k).visible = false
          NEXT
         ELSE
          PLAYWAV WavLettreOK,SND_ASYNC
          Sender.left = nx
          Sender.Top  = ny
         END IF
        END IF
       END IF
       IF trouve THEN i = LettreMax
      NEXT
      IF trouve = false THEN
       Sender.left = nx
       Sender.Top  = ny
       PLAYWAV WavRate,SND_ASYNC
       Ratés++
       IF Ratés >= 5 THEN AideEnLigne
      END IF
     END SUB

'Nouveau calcul à trouver (initie un nouveau jeu)
'========================
     SUB NouveauCalculATrouver
      DIM i AS INTEGER,iM AS INTEGER
      DIM j AS INTEGER

      FOR i = 1 TO 30
       lettres(i).visible = false
      NEXT
      PLAYWAV WavNouveau,SND_ASYNC
      RANDOMIZE
      SELECT CASE NiveauDeJeu()
      CASE 1
       i = RND(2) + 1
       j = RND(3) + 1
       iM= 5
      CASE 2
       i = RND(4) + 1
       j = RND(5) + 1
       iM= 9
      CASE ELSE
       i = RND(9) + 1
       j = RND(9) + 1
       iM=10
      END SELECT
      IF Digit.down THEN
       MinusculeMajuscule
      ELSE
       chiffres(iM)
      END IF
      NomImage = STR$(i)+"+"+STR$(j)+"= "
      FondDessin.width = ecriture.width - 5
      FondDessin.height= ecriture.Height-5
      FondDessin.fillrect(0,0,ecriture.width-5,ecriture.height-5,couleursBordure(ChoixCouleur))
      fondDessin.SaveToFile("JeaRie2")
      Dessin.bmp = "jeaRie2"
      dessin.font.name = MyFont.Name
      dessin.font.size = 50
      dessin.textout(0,0,NomImage,COuleursFond(ChoixCouleur),COuleursBordure(ChoixCouleur))
      IF Digit.down THEN
       NomImage = Nombre(i+j)
      ELSE
       NomImage = STR$(i+j)
      END IF
      iM = LEN(NomImage)
      IF iM > LettreMax THEN iM = LettreMax
      FOR i = 1 TO LettreMax
       SLEEP 0.1
       dessins(i).visible = false
       LettreTrouvée(i) = false
      NEXT
      FOR i = 1 TO iM
       dessins(i).visible = true
       FOR j = 1 TO 30
        IF UCASE$(lettres(j).CAPTION) = UCASE$(MID$(NomImage,i,1)) THEN
         dessins(i).fillrect(0,0,40,60,Lettres(j).font.COLOR )
        END IF
       NEXT
      NEXT
      dessin.visible       = true
      LettresTrouvées      = 0
      Help.enabled         = 1 'true
      Ratés = 0
      Barre(1,"Commences par le premier chiffre !")
     END SUB


'Nouveau compte à trouver (initie un nouveau jeu)
'========================
     SUB NouveauCompteATrouver
      DIM i AS INTEGER,iM AS INTEGER
      DIM j AS INTEGER, k AS INTEGER
      DIM lig AS INTEGER,col AS INTEGER
      DIM Des AS STRING

      FOR i = 1 TO 30
       lettres(i).visible = false
      NEXT
      PLAYWAV WavNouveau,SND_ASYNC
      RANDOMIZE
      SELECT CASE NiveauDeJeu()
      CASE 1
       i = RND(3) + 1
       iM= 3
      CASE 2
       i = RND(5) + 1
       iM= 5
      CASE ELSE
       i = RND(9) + 1
       iM=10
      END SELECT
      IF Digit.down THEN
       MinusculeMajuscule
      ELSE
       chiffres(iM)
      END IF
      FondDessin.width = ecriture.width - 5
      FondDessin.height= ecriture.Height-5
      FondDessin.fillrect(0,0,ecriture.width-5,ecriture.height-5,couleursBordure(ChoixCouleur))
      fondDessin.SaveToFile("JeaRie2")
      Dessin.bmp = "jeaRie2"
      lig = 5
      col = 5
      Dessin.font.Name = "Wingdings"
      SELECT CASE (RND(7) + 1)  ' 1 à 7
      CASE 1
       Des = "J"
      CASE 2
       Des = "%"
      CASE 3
       Des = "{"
      CASE 4
       Des = "¯"
      CASE 5
       Des = "["
      CASE 6
       Des = "µ"
      CASE ELSE
       Des = "¥"
      END SELECT
      FOR j = 1 TO i
       Dessin.Font.Size = 40 + RND(20)
       dessin.textout(col,lig,Des,couleursFond(ChoixCouleur),couleursBordure(ChoixCouleur))
       col = col + 60
       IF col > 190 THEN
        lig = lig + 60
        col = 5
       END IF
      NEXT
      IF Digit.down THEN
       NomImage = Nombre(i)
      ELSE
       NomImage = STR$(i)
      END IF
      iM = LEN(NomImage)
      IF iM > LettreMax THEN iM = LettreMax
      FOR i = 1 TO LettreMax
       SLEEP 0.1
       dessins(i).visible = false
       LettreTrouvée(i) = false
      NEXT
      FOR i = 1 TO iM
       dessins(i).visible = true
       FOR j = 1 TO 30
        IF UCASE$(lettres(j).CAPTION) = UCASE$(MID$(NomImage,i,1)) THEN
         dessins(i).fillrect(0,0,40,60,Lettres(j).font.COLOR )
        END IF
       NEXT
      NEXT
      dessin.visible       = true
      LettresTrouvées      = 0
      Help.enabled         = 1 'true
      Ratés = 0
      Barre(1,"Alors, combien y-a t-il d'ovales ?")
     END SUB

'Heure à trouver (initie un nouveau jeu)
'===============
     SUB NouveauHeureATrouver
      DIM i AS INTEGER,iM AS INTEGER
      DIM j AS INTEGER, k AS INTEGER
      DIM Des AS STRING

      FOR i = 1 TO 30
       lettres(i).visible = false
      NEXT
      PLAYWAV WavNouveau,SND_ASYNC

      RANDOMIZE
      SELECT CASE NiveauDeJeu()
      CASE 1
       i = RND(3) + 1
       iM= 3
      CASE 2
       i = RND(6) + 1
       iM= 6
      CASE ELSE
       i = RND(12) + 1
       iM=12
      END SELECT

      IF Digit.down THEN
       MinusculeMajuscule
      ELSE
       chiffres(iM)
      END IF
      FondDessin.width = ecriture.width - 5
      FondDessin.height= ecriture.Height-5
      FondDessin.fillrect(0,0,ecriture.width-5,ecriture.height-5,couleursBordure(ChoixCouleur))
      fondDessin.SaveToFile("JeaRie2")
      Dessin.bmp = "jeaRie2"
      Dessin.font.Name = "Wingdings"
      Dessin.Font.Size = 180
      dessin.textout(0,0,CHR$(i+182),couleursFond(ChoixCouleur),couleursBordure(ChoixCouleur))
      IF Digit.down THEN
       NomImage = Nombre(i)
      ELSE
       NomImage = STR$(i)
      END IF
      iM = LEN(NomImage)
      IF iM > LettreMax THEN iM = LettreMax
      FOR i = 1 TO LettreMax
       SLEEP 0.1
       dessins(i).visible = false
       LettreTrouvée(i) = false
      NEXT
      FOR i = 1 TO iM
       dessins(i).visible = true
       FOR j = 1 TO 30
        IF UCASE$(lettres(j).CAPTION) = UCASE$(MID$(NomImage,i,1)) THEN
         dessins(i).fillrect(0,0,40,60,Lettres(j).font.COLOR )
        END IF
       NEXT
      NEXT
      dessin.visible       = true
      LettresTrouvées      = 0
      Help.enabled         = 1 'true
      Ratés = 0
      Barre(1,"Alors, combien y-a t-il d'ovales ?")
     END SUB

'Nouveau mot (initie un nouveau jeu)
'===========
     SUB NouveauMotATrouver
      DIM i AS INTEGER,iM AS INTEGER
      DIM j AS INTEGER

      FOR i = 1 TO 30
       lettres(i).visible = false
      NEXT
      PLAYWAV WavNouveau,SND_ASYNC
      MinusculeMajuscule
      iM = 0
      DO
       RANDOMIZE
       i = RND(NombreImages) + 1
       NomImage = ListeImages(i)
       iM = LEN(NomImage) - 4
       SELECT CASE NiveauDeJeu()
       CASE 1
        IF iM > 6 THEN iM = 0
       CASE 2
        IF iM > 8 THEN iM = 0
       CASE ELSE
       END SELECT
      LOOP UNTIL iM > 0
      IF iM > LettreMax THEN iM = LettreMax
      dessin.bmp = NomImage
      NomImage = LEFT$(NomImage,iM)
      FOR i = 1 TO LettreMax
       SLEEP 0.1
       dessins(i).visible = false
       LettreTrouvée(i) = false
      NEXT
      FOR i = 1 TO iM
       dessins(i).visible = true
       FOR j = 1 TO 30
        IF UCASE$(lettres(j).CAPTION) = UCASE$(MID$(NomImage,i,1)) THEN
         dessins(i).fillrect(0,0,40,60,Lettres(j).font.COLOR )
        END IF
       NEXT
      NEXT
      dessin.visible       = true
      LettresTrouvées      = 0
      Help.enabled         = 1 'true
      Ratés = 0
     END SUB

'Redessine toutes les lettres (en Majuscule ou Minuscule)
'============================
     SUB MinusculeMajuscule
      k = 0

      FOR i = 1 TO 5
       FOR j = 1 TO 6
        k++
        SLEEP 0.10
        lettres(k).OnMouseDown = MouseDown
        Lettres(k).PARENT      = MainForm
        lettres(k).enabled     = true
        lettres(k).visible     = true
        Couleurs(k)            = couleurs(6*(i-1) + 1)
        Lettres(k).left        = (j-1) * 50 + 10
        lettres(k).top         = (i-1) * 70 + 100
        Lettres(k).width       = 40
        lettres(k).height      = 60
        Lettres(k).COLOR       = couleurs(k)
        Lettres(k).font        = MyFont
        Lettres(k).font.COLOR  = couleurs(k)
        IF Majus.down THEN
         Lettres(k).CAPTION = MID$(Lettre,k,1)
         IF k >= 27 THEN lettres(k).visible = false
        ELSE
         Lettres(k).CAPTION = LCASE$(MID$(Lettre,k,1))
        END IF
       NEXT
      NEXT
     END SUB
'Redessine tous les chiffres (pour les jeux Comptage et Addition)
'===========================
     SUB Chiffres(iM AS INTEGER)
      k = 0

      FOR i = 1 TO 2
       FOR j = 1 TO 6
        k++
        IF k <= iM+1 AND k <= 10 THEN
         SLEEP 0.10
         lettres(k).OnMouseDown = MouseDown
         Lettres(k).PARENT      = MainForm
         lettres(k).enabled     = true
         lettres(k).visible     = true
         Couleurs(k)            = couleurs(6*(i-1) + 1)
         Lettres(k).left        = (j-1) * 50 + 10
         lettres(k).top         = (i-1) * 70 + 100
         Lettres(k).width       = 40
         lettres(k).height      = 60
         Lettres(k).COLOR       = couleurs(k)
         Lettres(k).font        = MyFont
         Lettres(k).font.COLOR  = couleurs(k)
         Lettres(k).CAPTION = STR$(k-1)
        END IF
       NEXT
      NEXT
     END SUB

'Charger les images
'==================
     SUB ChargerImages
      NombreImages = 0
      REDIM ListeImages(NombreImages) AS STRING
      NomImage = DIR$("*.bmp",0)
      WHILE NomImage <> ""
       NombreImages++
       REDIM ListeImages(NombreImages) AS STRING
       ListeImages(NombreImages) = NomImage
       NomImage = DIR$
      WEND
     END SUB

'Divers routines
'===============
'Barres de message (simulation permettant d'autoriser la couleur )
     SUB Barre(NB AS INTEGER, Texte AS STRING)
      Barres(NB).CAPTION        = " "+Texte+" "
     END SUB

'Switch Digit/Lettre et Majuscule/Minuscule
     SUB Switch
      IF Digit.down THEN
       Digit.CAPTION = "UN"
       Digit.COLOR = CouleursFond(ChoixCouleur)
       Digit.font.COLOR = CouleursBordure(ChoixCouleur)
      ELSE
       Digit.CAPTION = "1"
       Digit.COLOR = CouleursBordure(ChoixCouleur)
       Digit.font.COLOR = CouleursFond(ChoixCouleur)
      END IF
      IF Majus.down THEN
       Majus.CAPTION = "MAJ"
       Majus.COLOR = CouleursFond(ChoixCouleur)
       Majus.font.COLOR = CouleursBordure(ChoixCouleur)
      ELSE
       Majus.CAPTION = "min"
       Majus.COLOR = CouleursBordure(ChoixCouleur)
       Majus.font.COLOR = CouleursFond(ChoixCouleur)
      END IF
      MyTimer.Enabled = false
     END SUB
     SUB SwitchDigit
      MyTimer.interval = 10
      MyTimer.OnTimer  = Switch
      MyTimer.enabled  = true
     END SUB
     SUB SwitchMajus
      MyTimer.interval = 10
      MyTimer.OnTimer  = Switch
      MyTimer.enabled  = true
     END SUB

'Fin du jeu
     SUB sortie
      PLAYWAV WavFin,SND_SYNC
      MainForm.CLOSE
     END SUB

'Nombre en toute lettre
     FUNCTION Nombre(x%) AS STRING
      SELECT CASE x%
      CASE 1
       Nombre = "UN"
      CASE 2
       Nombre = "DEUX"
      CASE 3
       Nombre = "TROIS"
      CASE 4
       Nombre = "QUATRE"
      CASE 5
       Nombre = "CINQ"
      CASE 6
       Nombre = "SIX"
      CASE 7
       Nombre = "SEPT"
      CASE 8
       Nombre = "HUIT"
      CASE 9
       Nombre = "NEUF"
      CASE 10
       Nombre = "DIX"
      CASE 11
       Nombre = "ONZE"
      CASE 12
       Nombre = "DOUZE"
      CASE 13
       Nombre = "TREIZE"
      CASE 14
       Nombre = "QUATORZE"
      CASE 15
       Nombre = "QUINZE"
      CASE 16
       Nombre = "SEIZE"
      CASE 17
       Nombre = "DIX SEPT"
      CASE 18
       Nombre = "DIX HUIT"
      CASE 19
       Nombre = "DIX NEUF"
      CASE 20
       Nombre = "VINGT"
      CASE ELSE
       Nombre "???"
      END SELECT
     END FUNCTION

'Images des boutons
     SUB DessineBouton(btn AS QCOOLBTN)
      DessineBtn.bmphandle = BmpBoutonStd
      SELECT CASE Btn.tag
      CASE 1
       DessineBtn.Font.Size = 24
       DessineBtn.Font.Name = "Arial"
       DessineBtn.font.addstyles("bold")
       DessineBtn.TextOut(11,17,"mot",&H0,-1)
       DessineBtn.TextOut(171,17,"mot",&H800000,-1)
       DessineBtn.TextOut(251,17,"mot",&H800000,-1)
      CASE 2
       DessineBtn.Font.Size = 36
       DessineBtn.Font.Name = "Wingdings"
       DessineBtn.font.addstyles("bold")
       DessineBtn.TextOut(18,17,"v",&H0,-1)
       DessineBtn.TextOut(178,17,"v",&H800000,-1)
       DessineBtn.TextOut(258,17,"v",&H800000,-1)
      CASE 3
       DessineBtn.Font.Size = 24
       DessineBtn.Font.Name = "Arial"
       DessineBtn.font.addstyles("bold")
       DessineBtn.TextOut(12,17,"1+1",&H0,-1)
       DessineBtn.TextOut(172,17,"1+1",&H800000,-1)
       DessineBtn.TextOut(252,17,"1+1",&H800000,-1)
      CASE 4
       DessineBtn.Font.Size = 36
       DessineBtn.Font.Name = "Wingdings"
       DessineBtn.font.addstyles("bold")
       DessineBtn.TextOut(18,17,"œ",&H0,-1)
       DessineBtn.TextOut(178,17,"œ",&H800000,-1)
       DessineBtn.TextOut(258,17,"œ",&H800000,-1)
      CASE 5
       DessineBtn.Font.Size = 36
       DessineBtn.Font.Name = "Wingdings"
       DessineBtn.font.addstyles("bold")
       DessineBtn.TextOut(28,17,"'",&H0,-1)
       DessineBtn.TextOut(188,17,"'",&H800000,-1)
       DessineBtn.TextOut(268,17,"'",&H800000,-1)
      CASE 6
       DessineBtn.Font.Size = 36
       DessineBtn.Font.Name = "Wingdings"
       DessineBtn.font.addstyles("bold")
       DessineBtn.TextOut(16,17,"x",&H0,-1)
       DessineBtn.TextOut(176,17,"x",&H800000,-1)
       DessineBtn.TextOut(256,17,"x",&H800000,-1)
      CASE ELSE
      END SELECT
      DessineBtn.SaveToFile("JeaRie2")
      Btn.NumBMPs = 3
      Btn.bmp     = "JeaRie2"
     END SUB

'Niveau de jeu
     FUNCTION NiveauDeJeu() AS INTEGER
      IF Niveau(1).down THEN
       NiveauDeJeu = 1
      ELSE
       IF Niveau(2).down THEN
        NiveauDeJeu = 2
       ELSE
        NiveauDeJeu = 3
       END IF
      END IF
     END FUNCTION
掌柜推荐
 
 
 
 
 
 
 
 
 
 
 
 
© Sat 2024-4-20  Guidance Laboratory Inc.
Email:webmaster1g.yi.org Hits:0 Last modified:2003-02-02 18:45:58