miércoles, 18 de marzo de 2020

Convertir números a números romanos





' 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

jueves, 20 de febrero de 2020

La clase MaxZ


En el programa VisorRV1960 de forma muy repetitiva estoy usando botones que lo que hacen es maximizar el formulario y minimizarlo, pues bien era hora de crear una clase pues esa es la esencia de una clase que cuando hay un tarea repetitiva en vez de repetir el código se usa una clase.

El código esta en la granja de gambas, después amplio el post, saludos

codigo de clase:

' Gambas class file

'gb.settings debe estar incluida en el proyecto

Export

Inherits UserControl

Public Const _Properties As String = "*,Borde=true,Ayuda,Pintura,IconoMax,IconoMin"
Public Const _IsControl As Boolean = True
Public Const _DefaultEvent As String = "Clic"
Public Const _DefaultSize As String = "4,4"
Public Const _Group As String = "Form"

Static Public MaxZs As New MaxZ[]

Event Clic

Property Read Maximizar As Boolean
Property Borde As Boolean
Property Ayuda As String
Property IconoMax As Picture
Property IconoMin As Picture
Property Pintura As Picture

Private $FMaxZ As FMaxZ
Private $Amo As Form
Private $Borde As Boolean
Private $Ayuda As String
Private $IconoMax As Picture
Private $IconoMin As Picture
Private $Pintura As Picture
Private $Maximizado As Boolean

Public Sub _new()
 
  $FMaxZ = New FMaxZ(Me) As "evMaxz"
  Me.Proxy = $FMaxZ
 
  ObtenerForm(Me.Parent)
 
  MaxZs.Add(Me)
 
End

Private Sub ObtenerForm(padre As Object)
 
  If padre.parent Then
    If Object.Is(padre.parent, "Form") Then
      $Amo = padre.parent
    Else
      ObtenerForm(padre.parent)
    Endif
  Else
    'Sino tiene parent quiere decir que es un formulario
    If Object.Is(padre, "Form") Then
      $Amo = padre
    Endif
  Endif
 
End

Public Sub _Click()
 
  Raise Clic
 
  If IsNull($amo) Then Return
 
  $Amo.Maximized = Not $Amo.Maximized
  $Maximizado = $Amo.Maximized
 
  ActualizarIcono
 
  Settings[Me.Name & "/" & Me.Name & "_Maximizar"] = $Amo.Maximized
  Settings.Save
 
End

Public Sub ActualizarIcono()
 
  ' If $amo.Maximized Then
  If $Maximizado Then
    $FMaxZ.btnIcono.Picture = $IconoMin
  Else
    $FMaxZ.btnIcono.Picture = $IconoMax
  Endif
 
End

Public Sub Borrar()
 
  Settings.Clear(Me.Name)
  Settings.Save
 
End

Static Public Sub BorrarTodos() ''
 
  Dim MaxZx As MaxZ
 
  For Each MaxZx In MaxZs
    Settings.Clear(MaxZx.Name)
  Next
 
  Settings.Save
 
End

Private Function Borde_Read() As Boolean
 
  Return $Borde
 
End

Private Sub Borde_Write(Value As Boolean)
 
  $Borde = Value
 
  $FMaxZ.btnIcono.Border = Value
 
End

Private Function Maximizar_Read() As Boolean
 
  $Maximizado = Settings[Me.Name & "/" & Me.Name & "_Maximizar", False]
 
  ActualizarIcono
 
  Return Settings[Me.Name & "/" & Me.Name & "_Maximizar", False]
 
End

Private Function Ayuda_Read() As String
 
  Return $Ayuda
 
End

Private Sub Ayuda_Write(Value As String)
 
  $Ayuda = Value
 
  $FMaxZ.btnIcono.Tooltip = Value
 
End

Private Function IconoMax_Read() As Picture
 
  Return $IconoMax
 
End

Private Sub IconoMax_Write(Value As Picture)
 
  $IconoMax = Value
 
End

Private Function IconoMin_Read() As Picture
 
  Return $IconoMin
 
End

Private Sub IconoMin_Write(Value As Picture)
 
  $IconoMin = Value
 
End

Private Function Pintura_Read() As Picture
 
  Return $Pintura
 
End

Private Sub Pintura_Write(Value As Picture)
 
  $Pintura = Value
  $FMaxZ.btnIcono.Picture = Value
 
End

Codigo de formulario:

Public Sub Form_Open()

  Me.Maximized = MaxZ1.Maximizar

End

miércoles, 11 de septiembre de 2019

Como poner un formulario dentro de otro


Aún no he hecho ningún programa que tenga esta función pero es necesario aprender a hacerlo en principio, pues tiene que ver con el manejo de interfaces y como diseñar interfaces inteligentemente o cual es la mejor forma de visualizar la información para nuestro programa.

Les dejo aquí mi primera prueba sobre esta función que nos permite gambas, que trata de incrustar un formulario dentro de otro, un ejemplo profesional lo tenemos en la ide de gambas mismo con la ventana consola.


' gambas class file

Public Sub Form_Open()

CargarEnContenedor()

End

Public Sub Form_Show()

Me.x = 0
Me.y = 0

End

Public Sub btnSalir_Click()

If Not ventana.Parent Then
ColocarEnContenedor()
Else
SacarDeContenedor()
Endif

End

Public Sub ColocarEnContenedor()

'asignamos un nuevo contenedor a ventana
ventana.Reparent(PanContenedor, 0, 0)
ventana.Center 'centramos ventana

End

Public Sub SacarDeContenedor()

'quitamos la ventana de su contenedor por medio de null
ventana.Reparent(Null, 0, 0)
ventana.Center 'centramos el formulario en la pantalla

End

Public Sub CargarEnContenedor()

'cargamos un formulario x en un contendor x
ventana.Load(PanContenedor)
ventana.Show

End


Public Sub btnCargar_Click()

CargarEnContenedor()

End


Formulario secundario


' gambas class file

Public Sub btnSalir_Click()

  If Not ventana.Parent Then Return
  FMain.SacarDeContenedor

End

Public Sub btnEntrar_Click()

  FMain.ColocarEnContenedor

End



 El proyecto esta en la Granja de gambas.