home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / JCG_Tetris20261610202006.psc / Module1.bas < prev   
BASIC Source File  |  2006-10-17  |  3KB  |  113 lines
  1. Attribute VB_Name = "Module1"
  2. 'Desarrollado Por Julio C. Gotuzzo
  3. 'Buenos Aires - Argentina
  4. 'gotuzzo@excite.com
  5.  
  6. Public Type Scores
  7.  Nombre As String
  8.  score As Long
  9. End Type
  10.  
  11. Public score(9) As Scores
  12. Public detenido As Boolean
  13.  
  14. Public Sub cuadrado_relleno(X As Long, Y As Long, tamano As Long, color As Long, donde As PictureBox)
  15.  Dim n As Long
  16.  donde.ForeColor = color
  17.  n = 0
  18.  Do While n <= tamano
  19.   donde.Line (X, Y + n)-(X + tamano, Y + n)
  20.   n = n + 1
  21.  Loop
  22. End Sub
  23.  
  24. Public Sub cuadrado_vacio(X As Long, Y As Long, tamano As Long, color As Long, donde As PictureBox)
  25.  donde.ForeColor = color
  26.  donde.Line (X, Y)-(X + tamano, Y)
  27.  donde.Line (X, Y)-(X, Y + tamano)
  28.  donde.Line (X, Y + tamano)-(X + tamano, Y + tamano)
  29.  donde.Line (X + tamano, Y)-(X + tamano, Y + tamano)
  30. End Sub
  31.  
  32. Public Sub rectangulo_relleno(x1 As Long, y1 As Long, x2 As Long, y2 As Long, color As Long, donde As PictureBox)
  33.  Dim n As Long
  34.  donde.ForeColor = color
  35.  n = y1
  36.  Do While n <= y2
  37.   donde.Line (x1, n)-(x2, n)
  38.   n = n + 1
  39.  Loop
  40. End Sub
  41.  
  42. Private Function encode(palabra As String) As String
  43.  Dim n As Integer
  44.  Dim letra As String
  45.  n = 1
  46.  encode = ""
  47.  Do While n <= Len(palabra)
  48.   letra = Mid(palabra, n, 1)
  49.   letra = Chr(Asc(letra) + 20)
  50.   encode = encode + letra
  51.   n = n + 1
  52.  Loop
  53. End Function
  54.  
  55. Private Function decode(palabra As String) As String
  56.  Dim n As Integer
  57.  Dim letra As String
  58.  n = 1
  59.  decode = ""
  60.  Do While n <= Len(palabra)
  61.   letra = Mid(palabra, n, 1)
  62.   letra = Chr(Asc(letra) - 20)
  63.   decode = decode + letra
  64.   n = n + 1
  65.  Loop
  66. End Function
  67.  
  68. Public Function Cargar_Scores() As Boolean
  69.     Dim sLineIn As String
  70.     Dim n As Integer
  71.     n = 0
  72.     On Error GoTo ErrLoadListFromFile
  73.     
  74.     Open App.Path + "\scores.dat" For Input As #1
  75.     Do While n <= 9
  76.         Line Input #1, sLineIn
  77.         score(n).Nombre = decode(sLineIn)
  78.         Line Input #1, sLineIn
  79.         score(n).score = Val(Trim(decode(sLineIn)))
  80.         n = n + 1
  81.     Loop
  82.     Close #1
  83.  Cargar_Scores = True
  84. AfterLoadListFromFile:
  85. Exit Function
  86.  
  87. ErrLoadListFromFile:
  88.     Cargar_Scores = False
  89.     Resume AfterLoadListFromFile
  90.     
  91. End Function
  92.  
  93. Public Function Guardar_Scores() As Boolean
  94.   
  95. Dim iFile As Integer
  96. Dim n As Integer
  97.  
  98. n = 0
  99. iFile = FreeFile
  100. Open App.Path + "\scores.dat" For Output As #iFile
  101.  
  102. Do While n <= 9
  103.  Print #iFile, encode(score(n).Nombre)
  104.  Print #iFile, encode(Trim(Str(score(n).score)))
  105.  n = n + 1
  106. Loop
  107. Guardar_Scores = True
  108.  
  109. ErrorHandler:
  110.  
  111. Close #iFile
  112. End Function
  113.