BoxInteger (clase)

Esta clase hereda de textbox, todo, valga la redundancia, pero le añadiremos un comportamiento particular en su evento KeyPress(). Este evento se lanza o se produce cuando presionamos una tecla. Por medio de un observador capturaremos este evento, haremos un filtro que si la tecla presionada no es un número del 0 a 9 retornemos previamente parando el evento mediante Stop Event haciendo que no se escriba el carácter elegido por el usuario mediante el teclado. Para escribir un número tendrá que presionar nuevamente otra tecla para lanzar el evento nuevamente y ahí actuará nuestro filtro. Otras teclas que permitiremos para que el usuario pueda editar serán suprimir, retornar, inicio, fin y alguna mas.

' gambas class file

'by postapase 07 abr 2020
Export

Inherits TextBox

Public Const Properties As String = "*"
Public Const _IsControl As Boolean = True
Public Const _DefaultSize As String = "14,4"
Public Const _Group As String = "Form"

Public obs As Observer

Property Read Valor As Integer

Public Sub _new()
'aquí esta el observador con el cual podremos manipular los eventos del textbox mediante la palabra "boxinteger" (aquí podemos poner un nombre a elección"
Obs = New Observer(Me) As "BoxInteger"

End




Public Sub BoxInteger_KeyPress()

Select Case Key.Code
Case Key.Del
Return
Case Key.Return
Return
Case Key.Home
Return
Case Key.End
Return
Case 16777234
Return
Case 16777236
Return
Case 16777219
Return
Case 48 To 57 'estos son los códigos ascii del número 0 al 9
Return
Default
End Select

Stop Event
Return

End

Private Function Valor_Read() As Integer

If Me.Text = "" Then Return 0

Return CInt(Me.Text)

End

Código:
https://gambas.one/gambasfarm/?id=776&action=search

Convertir números a números romanos

 Convierte números a números romanos y viceversa!!.

' gambas module file

'by postapase

Public Sub Main()

Dim a As Integer

For a = 1 To 4000
Print a & "=" & gb.Tab & EnteroToRomano(a)
Next

End

Public Sub EnteroToRomano(entero As Integer) As String

Select Case entero
Case 1
Return "I"
Case 2
Return "II"
Case 3
Return "III"
Case 4
Return "IV"
Case 5
Return "V"
Case 6
Return "VI"
Case 7
Return "VII"
Case 8
Return "VIII"
Case 9
Return "IX"
Case 10
Return "X"
Case 11 To 19
Return "X" & EnteroToRomano(entero - 10)
Case 20
Return "XX"
Case 21 To 29
Return "XX" & EnteroToRomano(entero - 20)
Case 30
Return "XXX"
Case 31 To 39
Return "XXX" & EnteroToRomano(entero - 30)
Case 40
Return "XL"
Case 41 To 49
Return "XL" & EnteroToRomano(entero - 40)
Case 50
Return "L"
Case 51 To 59
Return "L" & EnteroToRomano(entero - 50)
Case 60
Return "LX"
Case 61 To 69
Return "LX" & EnteroToRomano(entero - 60)
Case 70
Return "LXX"
Case 71 To 79
Return "LXX" & EnteroToRomano(entero - 70)
Case 80
Return "LXXX"
Case 81 To 89
Return "LXXX" & EnteroToRomano(entero - 80)
Case 90
Return "XC"
Case 91 To 99
Return "XC" & EnteroToRomano(entero - 90)
Case 100
Return "C"
Case 101 To 199
Return "C" & EnteroToRomano(entero - 100)
Case 200
Return "CC"
Case 201 To 299
Return "CC" & EnteroToRomano(entero - 200)
Case 300
Return "CCC"
Case 301 To 399
Return "CCC" & EnteroToRomano(entero - 300)
Case 400
Return "CD"
Case 401 To 499
Return "CD" & EnteroToRomano(entero - 400)
Case 500
Return "D"
Case 501 To 599
Return "D" & EnteroToRomano(entero - 500)
Case 600
Return "DC"
Case 601 To 699
Return "DC" & EnteroToRomano(entero - 600)
Case 700
Return "DCC"
Case 701 To 799
Return "DCC" & EnteroToRomano(entero - 700)
Case 800
Return "DCCC"
Case 801 To 899
Return "DCCC" & EnteroToRomano(entero - 800)
Case 900
Return "CM"
Case 901 To 999
Return "CM" & EnteroToRomano(entero - 900)
Case 1000
Return "M"
Case 1001 To 1999
Return "M" & EnteroToRomano(entero - 1000)
Case 2000
Return "MM"
Case 2001 To 2999
Return "MM" & EnteroToRomano(entero - 2000)
Case 3000
Return "MMM"
Case 3001 To 3999
Return "MMM" & EnteroToRomano(entero - 3000)
Default
Return entero & " no supe convertirlo"
End Select

End


 

Código completo para ver como funciona la conversión de número a números romanos y viceversa:
https://gambas.one/gambasfarm/?id=775&action=search

Obviamente también está en la granja de Gambas.

Paint Clip

Algo que se esta poniendo de moda son las imágenes recortadas en forma de círculo. Bueno aquí les dejo un código algo crudo para que practiquen.

El ejemplo esta en la granja de gambas.

Ejemplo Clase Respaldo

FMain:

' gambas class file

Public Respaldo1 As Respaldo

Public Sub Form_Open()
Respaldo1 = New Respaldo(1, txtOrigen.Text, txtDestino.Text)
cbxMes.Index = 9
End

Public Sub Button2_Click()
Dialog.Path = User.Home
If Dialog.OpenFile() Then Return
txtOrigen.Text = Dialog.Path
End

Public Sub cbxPeriodo_Click()

Select Case cbxPeriodo.Index
Case 0
Respaldo1.Periodo = 1
Case 1
Respaldo1.Periodo = 2
Case 2
Respaldo1.Periodo = 3
Case 3
Respaldo1.Periodo = 7
Case 4
Respaldo1.Periodo = 15
Case 5
Respaldo1.Periodo = 30
End Select

End

Public Sub Button1_Click()

If Respaldo1.Verificar() Then
LabInfo.Text = "se efectuo el respaldo"
Else
LabInfo.Text = "No se realizo respaldo"
Endif

End

Public Sub Button3_Click()
Dialog.Path = User.Home
If Dialog.SelectDirectory() Then Return
txtDestino.Text = Dialog.Path
End

Public Sub Button4_Click()
Shell "stat " & txtOrigen.Text
End

Public Sub Button5_Click()
Shell "touch -a -m -t " & cbxAnios.Text & cbxMes.Text & txtDia.Text & "0000.00 " & txtOrigen.Text
End

Clase Respaldo:

' gambas class file

'by postapase (humilde aporte a la comunidad gambera)

Property Periodo As Byte ''1=un día,2=dos días, 3=tres días,7 una semana, 15 una quincena, 30 un mes
Property RutaOrigen As String '' Ruta completa del archivo a respaldar
Property RutaDestino As String '' Lugar donde se respaldara el archivo

Private $Periodo As Byte
Private $RutaOrigen As String
Private $RutaDestino As String

Private $Diferencia As Integer
Private $NameArchivo As String
Private $Rutafinal As String
Private $UltimaModificacion As Date


Public Sub _new(periodo As Byte, origen As String, destino As String) ''Periodo,Origen,Destino
$Periodo = periodo
$RutaOrigen = origen
$RutaDestino = destino
$NameArchivo = File.BaseName($RutaOrigen)
End

Private Function Periodo_Read() As Byte
Return $Periodo
End

Private Sub Periodo_Write(Value As Byte)
$Periodo = Value
End

Private Function RutaOrigen_Read() As String
Return $RutaOrigen
End

Private Sub RutaOrigen_Write(Value As String)
$RutaOrigen = Value
End

Private Function RutaDestino_Read() As String
Return $RutaDestino
End

Private Sub RutaDestino_Write(Value As String)
$RutaDestino = Value
End

Public Sub Respaldar()
If Exist($Rutafinal) Then
Kill $Rutafinal
Wait 0.2
Copy $RutaOrigen To $RutaFinal
Else
Copy $RutaOrigen To $RutaFinal
Endif
End

Public Sub Verificar() As Boolean
$Rutafinal = $RutaDestino &/ $NameArchivo & "_" & Replace$(CString(Date), "/", "-")
$UltimaModificacion = Stat($RutaOrigen).LastModified

$Diferencia = DateDiff($UltimaModificacion, Date, gb.Day) '

If $Diferencia >= $Periodo Then
Respaldar()
Return True
Else
Return False
Endif
End

dropbox: Clase_Respaldo-0.1.tar.gz

Como crear un comando para Linux en Gambas

Creamos un nuevo proyecto gambas de tipo consola y pegamos este código.
luego lo copilamos, despues intalamos el paquete .deb, y despues lo probamos en la terminal.

' gambas module file
'by postapase

Public Sub Main()
 Dim modificador As String

 modificador = Application.Args[1] 'esto lo aprendi de Shell

 Select modificador
   Case "arquitectura"
     Shell "uname -m"
   Case "codename"
     Shell "uname -n"
   Case "--help"
     Print Application.Name & "-" & Application.Version
   Case Else
     Print "modificador desconocido"
     Print "escriba  'PcInfo --help'"
 End Select

End

necesario registrarse en el foro, código fuente:
http://www.gambas-es.org/download.php?id=617

Saludos, comenten....

Dibujo Basico

' Gambas class file

Public puntoInicialX As Integer
Public puntoInicialY As Integer
Public puntoFinalX As Integer
Public puntoFinalY As Integer
Public ColorDibujo As Integer 'variable donde se guardara la elección del color
Public TipoDEdibujo As String 'variable que nos dira que tipo de dibujo queremos ejecutar


Public Sub _new()

End

Public Sub Form_Open()
Me.Center 'centramos el formulario
End

Public Sub AreaDibujo_MouseDown() 'evento que sucede cuando apretamos el boton del raton
   puntoInicialX = Mouse.X
   puntoInicialY = Mouse.y
End

Public Sub AreaDibujo_MouseUp() 'evento que sucede cuando soltamos el boton del raton
   puntoFinalX = Mouse.X
   puntoFinalY = Mouse.y
End

Public Sub AreaDibujo_MouseMove() 'evento que sucede cuando movemos el raton

 Select Case TipoDEdibujo
   Case "punto"
      Draw.Begin(AreaDibujo) 'comienzo del dibujo
      Draw.Foreground = ColorDibujo 'el color del punto que elegimos y guardamos en la variable ColorDibujo
      Draw.Point(Mouse.x, Mouse.y) 'point es punto, dibujará un punto en las coordenadas del puntero del raton
      Draw.End 'fin del dibujo
   Case "linea"
      Draw.Begin(AreaDibujo)
      Draw.Foreground = ColorDibujo
      Draw.Line(puntoInicialX, puntoInicialY, Mouse.x, Mouse.y) 'Line es línea, dibujará lineas
      Draw.End
   Case "goma"
      Draw.Begin(AreaDibujo)
      Draw.Foreground = &HFFFFFF
      Draw.FillColor = &HFFFFFF
      Draw.FillStyle = Fill.Solid
      Draw.Ellipse(Mouse.x - 15, Mouse.y - 15, 30, 30)
      Draw.End
  End Select

 End

Public Sub btnColor_Click()
   If Dialog.SelectColor() Then Return
   ColorDibujo = Dialog.Color
End

Public Sub btnLinea_Click()
  TipoDEdibujo = "linea"
End

Public Sub btnPunto_Click()
  TipoDEdibujo = "punto"
End

Public Sub btnGoma_Click()
  TipoDEdibujo = "goma"
End

Public Sub btnLimpiar_Click()

  AreaDibujo.Cached = False ' desactivamos la cache para poder borrar el DrawArea
  AreaDibujo.Clear 'borramos todo el DrawArea
  AreaDibujo.Cached = True ' activamos la cache para poder redibujar nuevamente en el DrawArea

End
Código fuente: DibujoBasico-0.0.1.tar.gz

Tanteador de Tenis de mesa

Buenas gente tanto tiempo, estoy medio desconectado de la programación y por eso me cuesta mucho retomar y programar se me olvidan cosas recién aprendidas, les consulto algo, soy jugador de ping pong y se me ocurrió crear un anotador de tantos digital para visualizar en pantalla completa, pero me encontré que no es simple como pensaba pues esta lleno de variables, y la verdad necesito mucha ayuda o mejor dicho me gustaría que alguien se sumara con este proyecto ojala sean todos a ver si sacamos este proyecto adelante ya que seria muy beneficioso para el deporte.
Recién comense el proyecto y esta plagado de errores y código basura pero soy novato y estoy aprendiendo voy a subir lo que he hecho, si alguien le interesa y le hace mejoras me gustaría que las subieran también. gracias

Tres cosas importantes faltan, una es terminar el proyecto que funcione bien
dos: que se ponga en pantalla completa
tres: que se pueda ir para atrás y para adelante en los tantos manteniendo todo como estaba antes por si el que anota se equivoca.

Nota: este post es estrategico: Como Crear Grupos De Trabajo Para Hacer Proyectos De Programación...
http://www.gambas-es.org/viewtopic.php?f=7&t=2799

Código fuente:  Dropbox: Tanteador-0.0.3
(el boton mas del jugador 2 esta funcionando, algunas mejoras visuales en el codigo fuente)
Dropbox: Tanteador-0.0.4.tar.gz
Dropbox: Tanteador-0.0.7.tar.gz
Dropbox: Tanteador-0.0.8.tar.gz
(ahora el boton saque indica adecuadamente quien saca en cada nuevo set)problema 2 resuelto.
Dropbox: Tanteador-0.0.9.tar.gz
problema 1 resuelto ( bueno por primera vez el programa toma color y esta funcionando, aun hay pequeños detalles que corregir pero FUNCIONAAAAAA!!!!)
DEJO UN PAQUETE DE INSTALACION DEB AQUI: gambas3-tanteador_0.0.1-0ubuntu1_all.deb  (ubuntu, mint)
sourceforge: tanteador 0.1.3

Tanteador-0.1.7.tar.gz
gambas3-tanteador_0.0.1-0ubuntu3_all.deb

Última versión