home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 7_2009-2012.ISO / data / zips / Video_Surv21911810202010.psc / CommonLib.bas < prev    next >
BASIC Source File  |  2009-08-12  |  2KB  |  66 lines
  1. Attribute VB_Name = "Commonlib"
  2.  
  3. Function lista(ByVal lCadena As String, ByVal lElemento As Long, ByVal lSeparador As String) As Variant
  4. Dim LocalCadena, LocalSeparador As String
  5. Dim LocalElementos, PosicionInicial, PosicionFinal As Long
  6. LocalCadena = lCadena: LocalSeparador = "░"
  7. LocalCadena = Replace(LocalCadena, lSeparador, LocalSeparador)
  8. If Left$(LocalCadena, 1) <> LocalSeparador Then LocalCadena = LocalSeparador + LocalCadena
  9. If Right(LocalCadena, 1) <> LocalSeparador Then LocalCadena = LocalCadena + LocalSeparador
  10. LocalElementos = 0: PosicionInicial = 0: PosicionFinal = 0
  11. For i = 1 To Len(LocalCadena)
  12.    If Mid$(LocalCadena, i, 1) = LocalSeparador Then
  13.       LocalElementos = LocalElementos + 1
  14.       If lElemento = LocalElementos Then PosicionInicial = i
  15.       If lElemento + 1 = LocalElementos Then PosicionFinal = i
  16.    End If
  17. Next i
  18. If lElemento = 0 Then
  19.    lista = LocalElementos - 1
  20. Else
  21.    If lElemento > LocalElementos - 1 Then
  22.       lista = "ErrorOverflow"
  23.    Else
  24.       lista = Mid$(LocalCadena, PosicionInicial + 1, PosicionFinal - PosicionInicial - 1)
  25.    End If
  26. End If
  27. End Function
  28.  
  29. Public Function Maximo(ByVal valor1 As Double, ByVal valor2 As Double) As Double
  30.  Maximo = valor2
  31.  If valor1 > valor2 Then Maximo = valor1
  32. End Function
  33.  
  34. Public Function Minimo(ByVal valor1 As Long, ByVal valor2 As Long) As Long
  35.  Minimo = valor2
  36.  If valor1 < valor2 Then Minimo = valor1
  37. End Function
  38.  
  39. Public Function LastPos(cadena As String, caracter As String) As Long
  40. Dim i, posicion As Long
  41. posicion = 0
  42. For i = 1 To Len(cadena)
  43.    If Mid$(cadena, i, 1) = caracter Then posicion = i
  44. Next i
  45. LastPos = posicion
  46. End Function
  47.  
  48. Public Sub Progress(ByVal P1 As PictureBox, ByVal Nvalor As Long, ByVal MaxVal As Long, Optional Barcolor As ColorConstants, Optional fondo As ColorConstants)
  49. Dim valor As Long
  50. If Barcolor = 0 Then
  51.    P1.FillColor = vbRed
  52. Else
  53.    P1.FillColor = Barcolor
  54. End If
  55. P1.FillStyle = 0
  56. If fondo > 0 Then P1.BackColor = fondo
  57.  
  58. 'P1.ForeColor = Barcolor
  59. If Nvalor >= 0 And Nvalor <= MaxVal Then
  60.    valor = Nvalor * P1.Width / MaxVal
  61.    P1.Cls
  62.    P1.Line (0, 0)-(valor, P1.Top + P1.Height), Barcolor, B 'HOR
  63. End If
  64. End Sub
  65.  
  66.