domingo, 19 de octubre de 2014

Solución a reto Solveet (MayorSinDigito)



Se tiene un número X y se indica un dígito Y. Devolver un número Z que sea menor a X y que no posea el dígito Y.
La función/método puede aceptar dos argumentos: el número X y el dígito Y. No es necesario agregar ninguna validación para Y.
Ejemplos:
mayorSinDigito(123, 2) => 119
mayorSinDigito(113, 2) => 111
mayorSinDigito(113, 1) => 99


' gambas class file

' by postapase

Public Sub Form_Open()
Dim Num As Integer

Repeat
cbxDigitos.Add(Num)
Inc Num
Until Num > 9
cbxDigitos.Index = 0

End

Public Sub btnBuscar_Click()
MayorSinDigito(txtMayor.Text, cbxDigitos.Text)
End

Public Sub MayorSinDigito(Mayor As String, Digito As Integer)
Dim a, Resta1 As Integer

Resta1 = Mayor - 1

For a = Resta1 To 1 Step -1
If InStr(CString(a), CString(Digito)) = 0 Then
LabResultado.Text = "Número mayor es:" & a & " , sin digito " & Digito
Break
Endif
Next

End

sábado, 18 de octubre de 2014

Solución a Reto Solveet (Desglose en billetes)

Usando un bucle mediante Repeat/Until y Continue. Si la cantidad data es igual o mayor que 500 le restamos 500 si el resto es mayor o igual a 500 repetimos la operación sino continuamos con el billete menor de 200 así sucesivamente con las demás cantidades, cuando el resto sea 0 detenemos el bucle .



' gambas class file

' by postapase

Public Sub btnDesglosar_Click()
Dim Euros As Long
Dim Resto As Long
Dim Billete500, Billete200, Billete100, Billete50, Billete20, Billete10, Billete5, Moneda2, Moneda1 As Long
Euros = Val(txtEuros.Text)

TextArea1.Clear

Repeat
If Euros >= 500 Then
Resto = Euros - 500
Euros = Resto
Inc Billete500
If Euros < 500 Then
If Billete500 > 1 Then
TextArea1.Text &= Billete500 & " Billetes de 500 euros" & gb.NewLine
Else
TextArea1.Text &= Billete500 & " Billete de 500 euros" & gb.NewLine
Endif
Endif
If Resto > 500 Then Continue
Endif

If Euros >= 200 Then
Resto = Euros - 200
Euros = Resto
Inc Billete200
If Euros < 200 Then
If Billete200 > 1 Then
TextArea1.Text &= Billete200 & " Billetes de 200 euros" & gb.NewLine
Else
TextArea1.Text &= Billete200 & " Billete de 200 euros" & gb.NewLine
Endif
Endif
If Resto > 200 Then Continue
Endif

If Euros >= 100 Then
Resto = Euros - 100
Euros = Resto
Inc Billete100
If Euros < 500 Then
If Billete100 > 1 Then
TextArea1.Text &= Billete100 & " Billetes de 100 euros" & gb.NewLine
Else
TextArea1.Text &= Billete100 & " Billete de 100 euros" & gb.NewLine
Endif
Endif
If Resto > 100 Then Continue
Endif

If Euros >= 50 Then
Resto = Euros - 50
Euros = Resto
Inc Billete50
If Euros < 50 Then
If Billete50 > 1 Then
TextArea1.Text &= Billete50 & " Billetes de 50 euros" & gb.NewLine
Else
TextArea1.Text &= Billete50 & " Billete de 50 euros" & gb.NewLine
Endif
Endif
If Resto > 50 Then Continue
Endif

If Euros >= 20 Then
Resto = Euros - 20
Euros = Resto
Inc Billete20
If Euros < 20 Then
If Billete20 > 1 Then
TextArea1.Text &= Billete20 & " Billetes de 20 euros" & gb.NewLine
Else
TextArea1.Text &= Billete20 & " Billete de 20 euros" & gb.NewLine
Endif
Endif
If Resto > 20 Then Continue
Endif

If Euros >= 10 Then
Resto = Euros - 10
Euros = Resto
Inc Billete10
If Euros < 10 Then
If Billete10 > 1 Then
TextArea1.Text &= Billete10 & " Billetes de 10 euros" & gb.NewLine
Else
TextArea1.Text &= Billete10 & " Billete de 10 euros" & gb.NewLine
Endif
Endif
If Resto > 10 Then Continue
Endif

If Euros >= 5 Then
Resto = Euros - 5
Euros = Resto
Inc Billete5
If Euros < 5 Then
If Billete20 > 1 Then
TextArea1.Text &= Billete5 & " Billetes de 5 euros" & gb.NewLine
Else
TextArea1.Text &= Billete5 & " Billete de 5 euros" & gb.NewLine
Endif
Endif
If Resto > 5 Then Continue
Endif

If Euros >= 2 Then
Resto = Euros - 2
Euros = Resto
Inc Moneda2
If Euros < 2 Then
If Moneda2 > 1 Then
TextArea1.Text &= Moneda2 & " Monedas de 2 euros" & gb.NewLine
Else
TextArea1.Text &= Moneda2 & " Moneda de 2 euros" & gb.NewLine
Endif
Endif
If Resto >= 2 Then Continue
Endif

If Euros >= 1 Then
Resto = Euros - 1
Euros = Resto
Inc Moneda1
If Euros < 1 Then
If Moneda1 > 1 Then
TextArea1.Text &= Moneda1 & " Monedas de 1 euros" & gb.NewLine
Else
TextArea1.Text &= Moneda1 & " Moneda de 1 euros" & gb.NewLine
Endif
Endif
If Resto > 1 Then Continue
Endif
Until Resto = 0

End

jueves, 11 de septiembre de 2014

Ejemplo de uso de Append

' lo que hace Append es escribir a partir del final del archivo
'si usaramos solo write el archivo se reescribe de cero con la informacion nueva...




' gambas class file

'by postapase
' usando Append
Private RutaX As String = User.Home &/ "Registro_eventos.txt"

Public Sub Form_Open()
Me.Center
TextArea1.Clear
End

Public Sub btnDos_Click()
TextArea1.Clear
AddLog("btnDos_Click")
End

Public Sub btnUno_Click()
TextArea1.Clear
AddLog("btnUno_Click")
TextArea1.Pos = 0
End

Public Sub AddLog(nombre As String)
Dim ArchivoX As File
Dim LineaX As String

ArchivoX = Open RutaX For Write Append ' lo que hace Append es escribir a partir del final del archivo
'si usaramos solo write el archivo se reescribe de cero con la informacion nueva, es decir si guardamos en el
'archivo la palabra "gambas" y despues guardamos otra palabra "libre" el archivo solo contendra la palabra libre
'ahora si usamos el conjunto de comando Write Append veremos gambas en la primera linea y libre en la segunda
'y asi sucesivamente con lo que guardemos en el archivo, aparentemente si el archivo no existe Append lo crea
'Append es ideal para hacer archivos de log por eso hice este ejemplo para que podamos entender
'para que sirve Append y la diferencia con el comando Write si va solo.

Write #ArchivoX, nombre & " - " & Date(Year(Now), Month(Now), Day(Now), Hour(Now), Minute(Now), Second(Now)) & gb.NewLine

Close ArchivoX

LeerArchivo()

End

Public Sub LeerArchivo()
Dim ArchivoX As File
Dim LineaX As String

ArchivoX = Open RutaX For Read

While Not Eof(ArchivoX)
Line Input #ArchivoX, LineaX
TextArea1.Text = LineaX & gb.NewLine & TextArea1.Text
Wend

Close ArchivoX

End

Public Sub btnClear_Click()

If Not Exist(RutaX) Then
Message.Info("Archivo no existe!")
Else
Try Kill RutaX
TextArea1.Clear
Endif

End

Código fuente: append-0.0.1.tar.gz

martes, 9 de septiembre de 2014

Manipulando datos de un ComboBox

Guardar datos de un ComboBox y cargar datos a un ComboBox





' gambas class file

'by postapase

Public Sub Form_Open()
Me.Center
End

Public Sub btnAgregar_Click()

ComboBox1.Add(ComboBox1.Text)
ComboBox1.Text = ""
ComboBox1.SetFocus

End

Public Sub btnGuardarLista_Click()
Dim dato, lista As String

For Each dato In ComboBox1.List
lista &= dato & ","
Next

lista = Left(lista, Len(lista) - 1)
Settings["ListaDeDatos/Datos"] = lista
Settings.Save

LeerArchivoSettings()

End

Public Sub btnCargarLista_Click()
Dim lista As String
Dim separando As String[]
Dim x As Integer

TextArea1.Clear
ComboBox1.Clear
lista = Settings["ListaDeDatos/Datos", ""]
separando = Split(lista, ",")

For x = 0 To separando.Count - 1
ComboBox1.Add(separando[x])
Next

LeerArchivoSettings()
End

Public Sub LeerArchivoSettings() 'rutina que se encargara de leer el archivo Settings y mostrarlo en el TextArea
Dim ArchivoSettings As File 'declaramos una variable de tipo archivo para poder leer los datos de un archivo
Dim LineaX As String 'variable de tipo string que contendra los dato de una linea del archivo que estemos leyendo
Dim RutaArchivoSettings As String 'variable de tipo string que contendra la ruta del archivo a leer

TextArea1.Clear 'borramos el textarea sino no visualizaremos los datos como corresponde
RutaArchivoSettings = Settings.Path 'asignamos la ruta del archivo al string

ArchivoSettings = Open RutaArchivoSettings For Read
'open abre un archivo x en la ruta especificada en este caso Settings.path ( )
'For Read indica que abre el archivo solo con intenciones de lectura

'while...wend (El bucle se repite mientras que la expresión es verdadera.)
'Eof devuelve TRUE si estamos al final de un Flujo. (en este caso un archivo)
While Not Eof(ArchivoSettings) 'si eof NO es true ejecute el bluce (comienzo del bluce)
' cuando Eof(ArchivoSettings) es true significa que llego al final del archivo y el bluce no se ejecuta mas
Line Input #ArchivoSettings, LineaX 'lee de a una linea el archivo
' y lo que hay en esa linea lo deposita en lineaX que es una variable de tipo String
TextArea1.Text &= LineaX & gb.NewLine 'va escribiendo en el textarea linea a linea pasando lo que hay en lineax,
' gb.NewLine es una constante equivalente a poner LineaX & "\n" (salto de linea)
Wend


Close ArchivoSettings  ' agregue esta linea
End

Public Sub btnGuardarLista2_Click()
Dim ArchivoX As File
Dim dato, lista As String

For Each dato In ComboBox1.List
lista &= dato & gb.NewLine
Next

ArchivoX = Open User.Home & "/lista.txt" For Write Create

Write #ArchivoX, lista

Close ArchivoX

btnCargarLista2_Click()

End

Public Sub btnCargarLista2_Click()
Dim ArchivoX As File
Dim LineaX As String
ComboBox1.Clear
TextArea2.Clear
ArchivoX = Open User.Home & "/lista.txt" For Read

While Not Eof(ArchivoX)
Line Input #ArchivoX, LineaX
TextArea2.Text &= LineaX & gb.NewLine
ComboBox1.Add(LineaX)
Wend

Close ArchivoX

End

Public Sub Button1_Click()
TextArea2.Clear
End

Public Sub Button2_Click()
TextArea1.Clear
End

Public Sub Button4_Click()

ComboBox1.Clear

End

Código fuente: GuardarCargarListaComboBox-0.0.1.tar.gz

lunes, 8 de septiembre de 2014

CBoolean y Settings

Otro ejemplo de Settings con Cboolean, la razón de porque hago muchos ejemplos con Settings es que a mi me costo enormidades entender el funcionamiento de este componente que es vital para cualquier programa, ya que sin el no podemos guardar configuraciones y datos importantes de funcionamiento de nuestra aplicación, y la info que hay por ahí es escasa.
Ojala que ustedes con esta info no pasen tantas dificultades como pase yo para poder comprender y usar Settings.




' gambas class file

'by postapase
Public Sub Form_Open()
Me.Center
CheckBox1.Value = Settings["Opciones/" & CheckBox1.Text, False]
CheckBox2.Value = Settings["Opciones/" & CheckBox2.Text, False]
CheckBox3.Value = Settings["Opciones/" & CheckBox3.Text, False]
End

Public Sub CheckBox1_Click()
Settings["Opciones/" & CheckBox1.Text] = CBoolean(CheckBox1.Value)
LeerArchivoDeConfiguracion()
End

Public Sub CheckBox2_Click()
Settings["Opciones/" & CheckBox2.Text] = CBoolean(CheckBox2.Value)
LeerArchivoDeConfiguracion()
End

Public Sub CheckBox3_Click()
Settings["Opciones/" & CheckBox3.Text] = CBoolean(CheckBox3.Value)
LeerArchivoDeConfiguracion()
End

Public Sub LeerArchivoDeConfiguracion()
Dim ArchivoX As File
Dim Linea As String
Dim Ruta As String

Settings.Save
TextArea1.Clear
Ruta = Settings.DefaultDir &/ Application.Name & ".conf"
ArchivoX = Open Ruta For Read

While Not Eof(ArchivoX)
Line Input #ArchivoX, Linea
TextArea1.Text &= Linea & gb.NewLine
Wend

Close ArchivoX

End


Código fuente: Cboolean-0.0.1.tar.gz

domingo, 7 de septiembre de 2014

Contar números pares e impares

Usando MOD


' Gambas class file

'by postapase

Public Sub Form_Open()
Dim x, Num, dato, dato1, par, impar As Integer
Dim Numeros As New Integer[]
Dim todos As String

For x = 0 To 10
    Randomize
    Wait 0.1
    Num = Rnd(0, 100)
    Numeros.Add(Num)
Next

For Each dato In Numeros
   If dato Mod 2 = 0 Then
     Inc par
   Else
     Inc impar
   Endif
Next

For Each dato1 In Numeros
  todos &= dato1 & ","
Next

Print Left$(todos, Len(todos) - 1)
Print "Impares= " & impar
Print "Pares= " & par

End

jueves, 4 de septiembre de 2014

Ordenamiento de burbuja usando Repeat y Continue

Otro ejemplo usando Repeat y Continue



Que es el Ordenamiento_de_burbuja?

' gambas class file
'by postapase

Public num As Integer
Public numeritos As String

Public Sub Form_Open()
Me.Center
End

Public Sub Button1_Click()
Dim arrayNum As Integer[] = ["55", "86", "48", "16", "82"]
Dim x, y, a, s, Rota1, Rota2 As Integer

TextArea1.Clear

Repeat
If a = 4 Then a = 0
If y = 4 Then y = 0
If arrayNum[y] < arrayNum[a + 1] Then
Inc y
Inc a
Inc s
Continue
Endif
Rota1 = 0
Rota2 = 0
Rota1 = arrayNum[y]
Rota2 = arrayNum[a + 1]
arrayNum[y] = Rota2
arrayNum[a + 1] = Rota1
Dec s
For Each num In arrayNum
numeritos &= num & " "
Wait 0.2
Next
TextArea1.Text &= numeritos & gb.NewLine
numeritos = ""
Until s > 4

For Each num In arrayNum
numeritos &= num & " "
Wait 0.2
Next
TextArea1.Text &= gb.NewLine & "Resultado final es: " & numeritos & gb.NewLine
End

Código fuente: OrdenandoNumeros