Questo sito utilizza cookies solo per scopi di autenticazione sul sito e nient'altro. Nessuna informazione personale viene tracciata. Leggi l'informativa sui cookies.
Username: Password: oppure
Cerca Oro - frmGioco.frm

frmGioco.frm

Caricato da: Red
Scarica il programma completo

  1. Option Explicit
  2. Dim pepita As Integer
  3. Dim mosse As Integer
  4. Dim bonus() As Integer
  5. Dim malus() As Integer
  6. Dim morte() As Integer
  7. Dim dimentica() As Integer
  8.  
  9.  
  10. Private Sub cmdCasella_Click(index As Integer)
  11. Dim i As Integer
  12. Dim ok As Integer
  13. Dim j As Integer
  14. mosse = mosse - 1
  15. txtMosse.Text = mosse
  16. cmdCasella(index).Enabled = False
  17. If mosse <= 0 Then perso
  18. If index = pepita Then
  19.     vinto
  20.     cmdCasella(index).Caption = "P"
  21.     cmdCasella(index).BackColor = &HFF80FF
  22. End If
  23. For i = 0 To UBound(morte)
  24.     If index = morte(i) Then
  25.     perso
  26.     cmdCasella(index).BackColor = &H0&
  27.     ok = 1
  28.     End If
  29. Next i
  30. For i = 0 To UBound(bonus)
  31.     If index = bonus(i) Then
  32.     mosse = mosse + 5
  33.     txtMosse.Text = mosse
  34.     cmdCasella(index).BackColor = &HFFFF00
  35.     ok = 1
  36.     End If
  37. Next i
  38. For i = 0 To UBound(malus)
  39.     If index = malus(i) Then
  40.     mosse = mosse - 5
  41.     txtMosse.Text = mosse
  42.     cmdCasella(index).BackColor = &HFF&
  43.     ok = 1
  44.     End If
  45. Next i
  46. For i = 0 To UBound(dimentica)
  47.     If index = dimentica(i) Then
  48.     For j = 0 To 599
  49.         cmdCasella(j).Enabled = True
  50.         cmdCasella(j).Caption = ""
  51.         cmdCasella(j).BackColor = &H8000000F
  52.     Next j
  53.     cmdCasella(index).Enabled = False
  54.     cmdCasella(index).BackColor = &HFF00&
  55.     ok = 1
  56.     End If
  57. Next i
  58. If ok <> 1 Then distanza index
  59. End Sub
  60.  
  61. Private Sub cmdNuova_Click()
  62. cmdNuova.Visible = False
  63. mnuNuovo_Click
  64. End Sub
  65.  
  66.  
  67. Private Sub mnuAbout_Click()
  68. Load frmAbout
  69. frmAbout.Show
  70. End Sub
  71.  
  72. Private Sub mnuDifficile_Click()
  73. mnuDifficile.Checked = True
  74. mnuFacile.Checked = False
  75. mnuNormale.Checked = False
  76. mnuNuovo_Click
  77. End Sub
  78.  
  79. Private Sub mnuEsci_Click()
  80. End
  81. End Sub
  82.  
  83. Private Sub mnuFacile_Click()
  84. mnuDifficile.Checked = False
  85. mnuFacile.Checked = True
  86. mnuNormale.Checked = False
  87. mnuNuovo_Click
  88. End Sub
  89.  
  90.  
  91. Private Sub mnuIstruzioni_Click()
  92. Load frmIstruzioni
  93. frmIstruzioni.Show
  94. End Sub
  95.  
  96. Private Sub mnuNormale_Click()
  97. mnuDifficile.Checked = False
  98. mnuFacile.Checked = False
  99. mnuNormale.Checked = True
  100. mnuNuovo_Click
  101. End Sub
  102.  
  103. Private Sub mnuNuovo_Click()
  104. main
  105. End Sub
  106.  
  107. Private Sub main()
  108. Dim i As Integer
  109. For i = 0 To 599
  110.     cmdCasella(i).Enabled = True
  111.     cmdCasella(i).Caption = ""
  112.     cmdCasella(i).BackColor = &H8000000F
  113. Next i
  114. imgPepita.Visible = False
  115. lblRisultato.Visible = False
  116. mnuTrucchi.Enabled = True
  117. pos_pepita
  118. If mnuFacile.Checked = True Then
  119. livello 20, 20, 10, 1, 1
  120. Else
  121.     If mnuNormale.Checked = True Then
  122.     livello 10, 15, 15, 2, 2
  123.     Else
  124.     livello 5, 5, 20, 5, 5
  125.     End If
  126. End If
  127. End Sub
  128.  
  129. Private Sub pos_pepita()
  130. Randomize
  131. pepita = (600 * Rnd) - 1
  132. End Sub
  133.  
  134. Private Static Sub distanza(index As Integer)
  135. cmdCasella(index).BackColor = &H80FFFF
  136. cmdCasella(index).Appearance = 0
  137. Dim col_pepita As Integer
  138. Dim col_index As Integer
  139. Dim rig_index As Single
  140. Dim rig_pepita As Single
  141. Dim x As Integer
  142. Dim y As Integer
  143. col_pepita = pepita + 1
  144. col_index = index + 1
  145. rig_pepita = pepita
  146. rig_index = index
  147.     Do While col_index > 30
  148.     col_index = col_index - 30
  149.     Loop
  150.     Do While col_pepita > 30
  151.     col_pepita = col_pepita - 30
  152.     Loop
  153. rig_index = (rig_index / 30) + 1
  154. rig_pepita = (rig_pepita / 30) + 1
  155. If ((col_pepita - col_index) >= 0) Then x = col_pepita - col_index Else x = col_index - col_pepita
  156. If ((rig_pepita - rig_index) >= 0) Then y = rig_pepita - rig_index Else y = rig_index - rig_pepita
  157. If x > y Then
  158.     cmdCasella(index).Caption = (x - y) + y
  159. Else
  160.     cmdCasella(index).Caption = (y - x) + x
  161. End If
  162. End Sub
  163.  
  164. Private Sub livello(mos As Integer, bon As Integer, mal As Integer, mor As Integer, dime As Integer)
  165. mosse = mos
  166. txtMosse.Text = mos
  167. pos_bonus (bon)
  168. pos_malus (mal)
  169. pos_morte (mor)
  170. pos_dimentica (dime)
  171. End Sub
  172.  
  173. Private Sub vinto()
  174. Dim i As Integer
  175. For i = 0 To 599
  176.     cmdCasella(i).Enabled = False
  177. Next i
  178. lblRisultato.Visible = True
  179. lblRisultato.Caption = "Vittoria!!!"
  180. imgPepita.Visible = True
  181. cmdNuova.Visible = True
  182. End Sub
  183.  
  184. Private Sub perso()
  185. Dim i As Integer
  186. For i = 0 To 599
  187.     cmdCasella(i).Enabled = False
  188. Next i
  189. lblRisultato.Visible = True
  190. lblRisultato.Caption = "Hai perso..."
  191. cmdNuova.Visible = True
  192. End Sub
  193.  
  194. Private Sub pos_morte(n As Integer)
  195. ReDim morte(n)
  196. Dim i As Integer
  197. Dim j As Integer
  198. Dim app As Integer
  199. Dim ok As Integer
  200. For i = 0 To n
  201.     morte(i) = -1
  202. Next i
  203. For i = 0 To n - 1
  204. Randomize
  205. app = (600 * Rnd)
  206. app = app - 1
  207.     For j = i To 0 Step -1
  208.         If (app <> morte(i)) And (app <> pepita) And (app <> -1) Then ok = 0 Else ok = 1
  209.         If ok = 0 Then
  210.             morte(i) = app
  211.             j = -1
  212.         End If
  213.     Next j
  214. If ok = 1 Then i = i - 1
  215. Next i
  216. End Sub
  217.  
  218. Private Sub pos_bonus(n As Integer)
  219. ReDim bonus(n)
  220. Dim i As Integer
  221. Dim j As Integer
  222. Dim app As Integer
  223. Dim ok As Integer
  224. For i = 0 To n
  225.     bonus(i) = -1
  226. Next i
  227. For i = 0 To n - 1
  228. Randomize
  229. app = (600 * Rnd)
  230. app = app - 1
  231.     For j = i To 0 Step -1
  232.         If (app <> bonus(i)) And (app <> pepita) And (app <> -1) Then ok = 0 Else ok = 1
  233.         If ok = 0 Then
  234.             bonus(i) = app
  235.             j = -1
  236.         End If
  237.     Next j
  238. If ok = 1 Then i = i - 1
  239. Next i
  240. End Sub
  241.  
  242. Private Sub pos_malus(n As Integer)
  243. ReDim malus(n)
  244. Dim i As Integer
  245. Dim j As Integer
  246. Dim app As Integer
  247. Dim ok As Integer
  248. For i = 0 To n
  249.     malus(i) = -1
  250. Next i
  251. For i = 0 To n - 1
  252. Randomize
  253. app = (600 * Rnd)
  254. app = app - 1
  255.     For j = i To 0 Step -1
  256.         If (app <> malus(i)) And (app <> pepita) And (app <> -1) Then ok = 0 Else ok = 1
  257.         If ok = 0 Then
  258.             malus(i) = app
  259.             j = -1
  260.         End If
  261.     Next j
  262. If ok = 1 Then i = i - 1
  263. Next i
  264. End Sub
  265.  
  266. Private Sub pos_dimentica(n As Integer)
  267. ReDim dimentica(n)
  268. Dim i As Integer
  269. Dim j As Integer
  270. Dim app As Integer
  271. Dim ok As Integer
  272. For i = 0 To n
  273.     dimentica(i) = -1
  274. Next i
  275. For i = 0 To n - 1
  276. Randomize
  277. app = (600 * Rnd)
  278. app = app - 1
  279.     For j = i To 0 Step -1
  280.         If (app <> dimentica(i)) And (app <> pepita) And (app <> -1) Then ok = 0 Else ok = 1
  281.         If ok = 0 Then
  282.             dimentica(i) = app
  283.             j = -1
  284.         End If
  285.     Next j
  286. If ok = 1 Then i = i - 1
  287. Next i
  288. End Sub
  289.  
  290. Private Sub mnuTrucchi_Click()
  291. Dim codice As String
  292. codice = InputBox("Inserisci nell'area di testo il trucco da attivare.", "Trucchi")
  293. If codice = "cerca bonus" Then visualizza bonus, &HFFFF00
  294. If codice = "cerca malus" Then visualizza malus, &HFF&
  295. If codice = "cerca morte" Then visualizza morte, &H0&
  296. If codice = "cerca dimentica" Then visualizza dimentica, &HFF00&
  297. End Sub
  298.  
  299. Private Sub visualizza(app() As Integer, colore As String)
  300. Dim i As Integer
  301. For i = 0 To UBound(app) - 1
  302. cmdCasella(app(i)).BackColor = colore
  303. Next i
  304. End Sub