aqui teneis las capturas de los formularios del juego de SUDOKU que he realizado en Visual Estudio 2010 y que os lo dejo en la sección de descargas. El código es abierto y podeis analizarlo y aprender bastante de él.
Asteriscos en JavaScript
Programa que escribe en el navegador con Javascript el número de asteriscos que introducimos en el textbox.
IMAGEN:
IMAGEN:
Esta es la imagen que ofrece el navegador firefox, a continuacion os pongo el...
CODIGO:
solo es un ejercicio sencillo como otro cualquiera, importante para comprender la lógica de programación, nada mas.
Conversor de Numeros Romanos
Otro Programilla made in Nino para el personal, el conversor que hice en visual basic version 6 y version 10 ahora lo traigo en Gambas para ubuntu, que me sobra el tiempo libre...
CARCASA
CARCASA
y para que no os canseis tambien os dejo el codigo, pero ya sabeis, si sois tan señoritos que ni siquiera los escribis, cuidado con el copu/paste que cambia las comillas, en fin, ya sois grandes...
CODIGO:
' Gambas class file
PUBLIC SUB btnSalir_Click()
DIM mensaje AS String
mensaje = Message.Warning("¿Seguro que quieres salir?", "Si", "No", "Cancelar")
IF mensaje = 1 THEN
Message.Info("Gracias por usar mi segundo programa en gambas", "Aceptar")
ME.Close
ELSE
Message.Info("Tas tonta", "Aceptar")
END IF
END
PUBLIC SUB btnTransformador_Click()
DIM num, col AS Integer
Label3.Caption = ""
TextBox1.SetFocus
'num = Val(TextBox1.Text) aqui no se puede asignar el valor a la variable
col = 15
IF IsNumber(Val(TextBox1.Text)) = FALSE THEN
Message.Info("Debe ser un numero del 1 al 5000", "Aceptar")
ME.Close
ELSE
num = Val(TextBox1.Text) 'mucho cuidado, esta linea debe ir aqui
WHILE num >= 1000
Label3.Caption = Label3.Caption & "M"
num = num - 1000
col = col + 1
WEND
WHILE num >= 900
Label3.Caption = Label3.Caption & "CM"
num = num - 900
col = col + 2
WEND
WHILE num >= 500
Label3.Caption = Label3.Caption & "D"
num = num - 500
col = col + 1
WEND
WHILE num >= 100
Label3.Caption = Label3.Caption & "C"
num = num - 100
col = col + 1
WEND
WHILE num >= 90
Label3.Caption = Label3.Caption & "XC"
num = num - 90
col = col + 2
WEND
WHILE num >= 50
Label3.Caption = Label3.Caption & "L"
num = num - 50
col = col + 1
WEND
WHILE num >= 40
Label3.Caption = Label3.Caption & "XL"
num = num - 40
col = col + 2
WEND
WHILE num >= 10
Label3.Caption = Label3.Caption & "X"
num = num - 10
col = col + 1
WEND
WHILE num >= 9
Label3.Caption = Label3.Caption & "IX"
num = num - 9
col = col + 2
WEND
WHILE num >= 5
Label3.Caption = Label3.Caption & "V"
num = num - 5
col = col + 1
WEND
WHILE num >= 4
Label3.Caption = Label3.Caption & "IV"
num = num - 4
col = col + 2
WEND
WHILE num > 0
Label3.Caption = Label3.Caption & "I"
num = num - 1
col = col + 1
WEND
END IF
END
PUBLIC SUB opc_rojo_Click()
FMain.BackColor = &C10A41&
TextBox1.BackColor = &062805&
TextBox1.ForeColor = &EBE7E9&
END
PUBLIC SUB opc_azul_Click()
FMain.Refresh
FMain.BackColor = &1C33FF&
END
PUBLIC SUB opc_verde_Click()
FMain.BackColor = &1FBF19&
END
PUBLIC SUB btnSalir_Click()
DIM mensaje AS String
mensaje = Message.Warning("¿Seguro que quieres salir?", "Si", "No", "Cancelar")
IF mensaje = 1 THEN
Message.Info("Gracias por usar mi segundo programa en gambas", "Aceptar")
ME.Close
ELSE
Message.Info("Tas tonta", "Aceptar")
END IF
END
PUBLIC SUB btnTransformador_Click()
DIM num, col AS Integer
Label3.Caption = ""
TextBox1.SetFocus
'num = Val(TextBox1.Text) aqui no se puede asignar el valor a la variable
col = 15
IF IsNumber(Val(TextBox1.Text)) = FALSE THEN
Message.Info("Debe ser un numero del 1 al 5000", "Aceptar")
ME.Close
ELSE
num = Val(TextBox1.Text) 'mucho cuidado, esta linea debe ir aqui
WHILE num >= 1000
Label3.Caption = Label3.Caption & "M"
num = num - 1000
col = col + 1
WEND
WHILE num >= 900
Label3.Caption = Label3.Caption & "CM"
num = num - 900
col = col + 2
WEND
WHILE num >= 500
Label3.Caption = Label3.Caption & "D"
num = num - 500
col = col + 1
WEND
WHILE num >= 100
Label3.Caption = Label3.Caption & "C"
num = num - 100
col = col + 1
WEND
WHILE num >= 90
Label3.Caption = Label3.Caption & "XC"
num = num - 90
col = col + 2
WEND
WHILE num >= 50
Label3.Caption = Label3.Caption & "L"
num = num - 50
col = col + 1
WEND
WHILE num >= 40
Label3.Caption = Label3.Caption & "XL"
num = num - 40
col = col + 2
WEND
WHILE num >= 10
Label3.Caption = Label3.Caption & "X"
num = num - 10
col = col + 1
WEND
WHILE num >= 9
Label3.Caption = Label3.Caption & "IX"
num = num - 9
col = col + 2
WEND
WHILE num >= 5
Label3.Caption = Label3.Caption & "V"
num = num - 5
col = col + 1
WEND
WHILE num >= 4
Label3.Caption = Label3.Caption & "IV"
num = num - 4
col = col + 2
WEND
WHILE num > 0
Label3.Caption = Label3.Caption & "I"
num = num - 1
col = col + 1
WEND
END IF
END
PUBLIC SUB opc_rojo_Click()
FMain.BackColor = &C10A41&
TextBox1.BackColor = &062805&
TextBox1.ForeColor = &EBE7E9&
END
PUBLIC SUB opc_azul_Click()
FMain.Refresh
FMain.BackColor = &1C33FF&
END
PUBLIC SUB opc_verde_Click()
FMain.BackColor = &1FBF19&
END
Queridos seguidores, voy a seguir con mis cosillas, me voy a poner un poquito de Eric Clapton y algo de Kansas y a crear programillas. Me acabo de acordar de la calculadora que hice en visual y voy a ver si es muy dificil hacerla en gambas... ya os dire.
El Juego del Laberinto en VB6
Un juego:
' La información del laberinto.
Private NumRows As Integer
Private NumCols As Integer
Private LegalMove() As Boolean
' El tamaño de un cuadrado.
Private Const SQUARE_WID = 20
Private Const SQUARE_HGT = 20
' La posición del jugador.
Private PlayerR As Integer
Private PlayerC As Integer
' La posición final.
Private RFinish As Integer
Private CFinish As Integer
Private StartTime As Single
' Busque las teclas de movimiento.
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim r As Integer
Dim c As Integer
r = PlayerR
c = PlayerC
Select Case KeyCode
Case vbKeyLeft
c = PlayerC - 1
Case vbKeyRight
c = PlayerC + 1
Case vbKeyDown
r = PlayerR + 1
Case vbKeyUp
r = PlayerR - 1
Case Else
Exit Sub
End Select
If LegalMove(r, c) Then PositionPlayer r, c
End Sub
' Inicialice el laberinto y el reproductor.
Private Sub Form_Load()
ScaleMode = vbPixels
AutoRedraw = True
picPlayer.Visible = False
'Inicialice el laberinto.
LoadMaze
End Sub
' Dibujar el laberinto.
Private Sub DrawMaze()
Dim r As Integer
Dim c As Integer
Dim clr As Long
' Empezar desde cero.
Cls
For r = 1 To NumRows
For c = 1 To NumCols
If LegalMove(r, c) Then
If r = RFinish And c = CFinish Then
clr = vbYellow
Else
clr = vbWhite
End If
Else
clr = RGB(128, 128, 128)
End If
Line (c * SQUARE_WID, r * SQUARE_HGT)-Step(-SQUARE_WID, -SQUARE_HGT), clr, BF
Next c
Next r
End Sub
' Inicialice el laberinto.
Private Sub LoadMaze()
Dim fnum As Integer
Dim r As Integer
Dim c As Integer
Dim ch As String
Dim row_info As String
' Abra el archivo laberinto.
fnum = FreeFile
Open App.Path & "\maze.dat" For Input As #fnum
' Leer el número de filas y columnas.
Input #fnum, NumRows, NumCols
ReDim LegalMove(1 To NumRows, 1 To NumCols)
' Lea los datos.
For r = 1 To NumRows
Line Input #fnum, row_info
For c = 1 To NumCols
ch = Mid$(row_info, c, 1)
LegalMove(r, c) = (ch <> "#")
If LCase$(ch) = "s" Then
' Es el comienzo.
PlayerR = r
PlayerC = c
ElseIf LCase$(ch) = "f" Then
' Es la meta.
RFinish = r
CFinish = c
End If
Next c
Next r
' Cierre el archivo.
Close #fnum
' Tamaño del formulario.
Width = ScaleX(SQUARE_WID * NumCols, ScaleMode, vbTwips) + _
Width - ScaleX(ScaleWidth, ScaleMode, vbTwips)
Height = ScaleY(SQUARE_HGT * NumRows, ScaleMode, vbTwips) + _
Height - ScaleY(ScaleHeight, ScaleMode, vbTwips)
' Dibujar el laberinto.
DrawMaze
' Coloque el reproductor.
PositionPlayer PlayerR, PlayerC
'Guarde la hora de inicio.
StartTime = Timer
End Sub
' Dibujar el jugador.
Private Sub PositionPlayer(r As Integer, c As Integer)
Dim x As Single
Dim y As Single
' Borrar vieja posición del jugador.
If PlayerR > 0 Then
x = (PlayerC - 1) * SQUARE_WID + (SQUARE_WID - picPlayer.Width) / 2
y = (PlayerR - 1) * SQUARE_HGT + (SQUARE_HGT - picPlayer.Height) / 2
Line (x - 1, y - 1)-Step(picPlayer.Width, picPlayer.Height), vbWhite, BF
End If
' Mueve al jugador.
PlayerR = r
PlayerC = c
' Dibujar el jugador.
x = (c - 1) * SQUARE_WID + (SQUARE_WID - picPlayer.Width) / 2
y = (r - 1) * SQUARE_HGT + (SQUARE_HGT - picPlayer.Height) / 2
PaintPicture picPlayer.Picture, x, y
' A ver si el jugador llegó a la meta.
If r = RFinish And c = CFinish Then
If MsgBox("El juego acabara en " & _
Int(Timer - StartTime) & " segundos." & _
vbCrLf & "Jugar de nuevo?", vbYesNo, _
"Felicidades") = vbYes _
Then
Form_Load
Else
Unload Me
End If
End If
End Sub
Cuidado con el COPY/PASTE que cambia las comillas y practicad cambiando el formulario para manejar el cacharro este. Por cierto, no he arreglado del todo la sangria, pero es que es un coñazo, hacedlo vosotros en vuestro visual basic.
Este es el formulario en cuestion, ahora vayamos a por el codigo. Siempre que tengamos problemas podemos ir a la pagina oficial de Visual Basic y buscar lo que necesitemos, para ayudaros aqui teneis un enlace a u na buena pagina de ayuda a visual basic==========>
pasamos al CODIGO:
Option Explicit
' La información del laberinto.
Private NumRows As Integer
Private NumCols As Integer
Private LegalMove() As Boolean
' El tamaño de un cuadrado.
Private Const SQUARE_WID = 20
Private Const SQUARE_HGT = 20
' La posición del jugador.
Private PlayerR As Integer
Private PlayerC As Integer
' La posición final.
Private RFinish As Integer
Private CFinish As Integer
Private StartTime As Single
' Busque las teclas de movimiento.
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim r As Integer
Dim c As Integer
r = PlayerR
c = PlayerC
Select Case KeyCode
Case vbKeyLeft
c = PlayerC - 1
Case vbKeyRight
c = PlayerC + 1
Case vbKeyDown
r = PlayerR + 1
Case vbKeyUp
r = PlayerR - 1
Case Else
Exit Sub
End Select
If LegalMove(r, c) Then PositionPlayer r, c
End Sub
' Inicialice el laberinto y el reproductor.
Private Sub Form_Load()
ScaleMode = vbPixels
AutoRedraw = True
picPlayer.Visible = False
'Inicialice el laberinto.
LoadMaze
End Sub
' Dibujar el laberinto.
Private Sub DrawMaze()
Dim r As Integer
Dim c As Integer
Dim clr As Long
' Empezar desde cero.
Cls
For r = 1 To NumRows
For c = 1 To NumCols
If LegalMove(r, c) Then
If r = RFinish And c = CFinish Then
clr = vbYellow
Else
clr = vbWhite
End If
Else
clr = RGB(128, 128, 128)
End If
Line (c * SQUARE_WID, r * SQUARE_HGT)-Step(-SQUARE_WID, -SQUARE_HGT), clr, BF
Next c
Next r
End Sub
' Inicialice el laberinto.
Private Sub LoadMaze()
Dim fnum As Integer
Dim r As Integer
Dim c As Integer
Dim ch As String
Dim row_info As String
' Abra el archivo laberinto.
fnum = FreeFile
Open App.Path & "\maze.dat" For Input As #fnum
' Leer el número de filas y columnas.
Input #fnum, NumRows, NumCols
ReDim LegalMove(1 To NumRows, 1 To NumCols)
' Lea los datos.
For r = 1 To NumRows
Line Input #fnum, row_info
For c = 1 To NumCols
ch = Mid$(row_info, c, 1)
LegalMove(r, c) = (ch <> "#")
If LCase$(ch) = "s" Then
' Es el comienzo.
PlayerR = r
PlayerC = c
ElseIf LCase$(ch) = "f" Then
' Es la meta.
RFinish = r
CFinish = c
End If
Next c
Next r
' Cierre el archivo.
Close #fnum
' Tamaño del formulario.
Width = ScaleX(SQUARE_WID * NumCols, ScaleMode, vbTwips) + _
Width - ScaleX(ScaleWidth, ScaleMode, vbTwips)
Height = ScaleY(SQUARE_HGT * NumRows, ScaleMode, vbTwips) + _
Height - ScaleY(ScaleHeight, ScaleMode, vbTwips)
' Dibujar el laberinto.
DrawMaze
' Coloque el reproductor.
PositionPlayer PlayerR, PlayerC
'Guarde la hora de inicio.
StartTime = Timer
End Sub
' Dibujar el jugador.
Private Sub PositionPlayer(r As Integer, c As Integer)
Dim x As Single
Dim y As Single
' Borrar vieja posición del jugador.
If PlayerR > 0 Then
x = (PlayerC - 1) * SQUARE_WID + (SQUARE_WID - picPlayer.Width) / 2
y = (PlayerR - 1) * SQUARE_HGT + (SQUARE_HGT - picPlayer.Height) / 2
Line (x - 1, y - 1)-Step(picPlayer.Width, picPlayer.Height), vbWhite, BF
End If
' Mueve al jugador.
PlayerR = r
PlayerC = c
' Dibujar el jugador.
x = (c - 1) * SQUARE_WID + (SQUARE_WID - picPlayer.Width) / 2
y = (r - 1) * SQUARE_HGT + (SQUARE_HGT - picPlayer.Height) / 2
PaintPicture picPlayer.Picture, x, y
' A ver si el jugador llegó a la meta.
If r = RFinish And c = CFinish Then
If MsgBox("El juego acabara en " & _
Int(Timer - StartTime) & " segundos." & _
vbCrLf & "Jugar de nuevo?", vbYesNo, _
"Felicidades") = vbYes _
Then
Form_Load
Else
Unload Me
End If
End If
End Sub
Cuidado con el COPY/PASTE que cambia las comillas y practicad cambiando el formulario para manejar el cacharro este. Por cierto, no he arreglado del todo la sangria, pero es que es un coñazo, hacedlo vosotros en vuestro visual basic.
COMO UTILIZAR QBColor en VB
CODIGO:
Option Explicit
Private Sub HScroll1_Change()
If Val(Text1.Text) < 16 And Val(HScroll1.Value) < 16 Then
Text1.Text = HScroll1.Value
Text3.BackColor = QBColor(HScroll1.Value)
Else
MsgBox "Debe ser un numero inferior a 16 para que el cacharro funciones"
End If
End Sub
Private Sub HScroll1_Scroll()
If Val(Text1.Text) < 16 And Val(HScroll1.Value) < 16 Then
Text1.Text = HScroll1.Value
Text3.BackColor = QBColor(HScroll1.Value)
Else
MsgBox "Debe ser un numero inferior a 16 para que el cacharro funciones"
End If
End Sub
Private Sub HScroll2_Change()
If Val(Text2.Text) < 16 And Val(HScroll2.Value) < 16 Then
Text2.Text = HScroll2.Value
Text3.ForeColor = QBColor(HScroll2.Value)
Else
MsgBox "Debe ser un numero inferior a 16 para que el cacharro funcione"
End If
End Sub
Private Sub HScroll2_Scroll()
If Val(Text2.Text) < 16 And Val(HScroll2.Value) < 16 Then
Text2.Text = HScroll2.Value
Text3.ForeColor = QBColor(HScroll2.Value)
Else
MsgBox "Debe ser un numero inferior a 16 para que el cacharro funcione"
End If
End Sub
Private Sub opc_salir_Click()
If MsgBox("¿Seguro que quieres abandonar el programa?", vbYesNo, "Información del Sistema") = vbYes Then
End
End If
End Sub
Tablas de Multiplicar en VB2010
El IDE para Visual Basic 2010 es bastante completo, y muy facil de usar. Os traigo una chorradica hecha con este entorno para que veais la diferencia con vb6
IMAGEN:
El codigo es la mar de sencillito, por mas que no hace casi ni falta que os lo ponga:
CODIGO:
Dim i As Integer
i = 1
ListBox1.Items.Clear()
If TextBox1.Text <> "" And IsNumeric(TextBox1.Text) = True Then
While i <= 10
ListBox1.Items.Add(i & " X " & Val(TextBox1.Text) & " = " & i * Val(TextBox1.Text))
i = i + 1
End While
TextBox1.Text = ""
TextBox1.Focus()
Else
MsgBox("Debe ser un numero entero", vbOKOnly, "Información del sistema")
End If
Las diferencias son todas exclusivamente de sintaxis, lo que es el lenguaje de programación es el mismo, el codigo del boton cerrar creo que sereis capaces de descubrirlo vosotros solos.
IMAGEN:
CODIGO:
Dim i As Integer
i = 1
ListBox1.Items.Clear()
If TextBox1.Text <> "" And IsNumeric(TextBox1.Text) = True Then
While i <= 10
ListBox1.Items.Add(i & " X " & Val(TextBox1.Text) & " = " & i * Val(TextBox1.Text))
i = i + 1
End While
TextBox1.Text = ""
TextBox1.Focus()
Else
MsgBox("Debe ser un numero entero", vbOKOnly, "Información del sistema")
End If
Las diferencias son todas exclusivamente de sintaxis, lo que es el lenguaje de programación es el mismo, el codigo del boton cerrar creo que sereis capaces de descubrirlo vosotros solos.
Suscribirse a:
Entradas (Atom)