Programación y Estructuras. RPN / QB64

Mi Programa con las funciones de Fechas

Número de días y años entre dos fechas

(Actualizado mayo 2023)

FCHA=DIA.MESAÑO

0= FECHA ACTUAL

1 DIA? 06.03.2012 Fecha 1 Dia 06.032012

2 DIA? 18.08.2022 Fecha 2 Dia 18.082022

N.dias=3,817. Número de días

N.Anos=10.5 Número de años

1Dia n.Sem=2.0 Número de la semana del 1 Día (2=martes) (Está en otra APP)

No Funciona

(Free42) UNTIL - How long until...?

This program uses the date/time functions of Free42, and thus will not work with a "real" 42S. It will, however, work on a DM42, which is where I wrote/use it.

UNTIL will tell you how many days and/or hours/minutes/seconds until some specified date/time. It's mostly just some convenience UI around DDAYS, HMS-, etc.

Run UNTIL, then use the Up and Down keys to choose one of the three menus based on whether you're comparing time, date, or both. Enter a value, and press DATE or TIME to set the reference date/time. Then press HMS, DAYS, or D,HMS to calculate the time remaining until the time/date entered, with results in hours/minutes/seconds, decimal days, or days (y) + hours/minutes/seconds (x) respectively.

Example:

How long until 8:00 AM Christmas day, 2018?

XEQ "UNTIL"
Up
12.252018 [DATE]
8.00 [TIME]
[D,HMS]
y: 63
x: 22.260972

63 days, 22 hours, 26 minutes, 9.72 seconds (results will obviously vary depending on when you run this).

00 { 324-Byte Prgm }

01▸LBL "UNTIL"

02▸LBL 01

03 SF 81

04 CF 82

05 CLMENU

06 "TIME"

07 KEY 1 XEQ 11

08 KEY 7 GTO 03

09 KEY 8 GTO 02

10 GTO 08

11▸LBL 02

12 CF 81

13 SF 82

14 CLMENU

15 "DATE"

16 KEY 1 XEQ 12

17 KEY 7 GTO 01

18 KEY 8 GTO 03

19 GTO 08

20▸LBL 03

21 SF 81

22 SF 82

23 CLMENU

24 "DATE"

25 KEY 1 XEQ 12

26 "TIME"

27 KEY 2 XEQ 11

28 KEY 7 GTO 02

29 KEY 8 GTO 01

30▸LBL 08

31 "HMS"

32 KEY 4 XEQ 14

33 "DAYS"

34 KEY 5 XEQ 15

35 "D,HMS"

36 KEY 6 XEQ 16

37▸LBL 07

38 MENU

39 STOP

40 GTO 07

41▸LBL 11

42 STO "TM"

43 RTN

44▸LBL 12

45 STO "DT"

46 RTN

47▸LBL 14

48 XEQ 20

49 →HMS

50 GTO 91

51▸LBL 15

52 XEQ 20

53 24

54 ÷

55▸LBL 91

56 RCL "U_L"

57 STO ST L

58 R↓

59 RCL "U_Z"

60 RCL "U_Y"

61 RCL "U_X"

62 R↑

63 GTO 99

64▸LBL 16

65 XEQ 20

66 ENTER

67 ENTER

68 24

69 ÷

70 IP

71 X<>Y

72 24

73 RCL× ST Z

74 -

75 →HMS

76 RCL "U_L"

77 STO ST L

78 R↓

79 RCL "U_Y"

80 RCL "U_X"

81 R↓

82 R↓

83 GTO 99

84▸LBL 20

85 XEQ 90

86 0

87 FC? 82

88 GTO 21

89 DATE

90 RCL "DT"

91 DDAYS

92 24

93 ×

94 +

95▸LBL 21

96 FC? 81

97 RTN

98 RCL "TM"

99 →HR

100 TIME

101 →HR

102 -

103 +

104 RTN

105▸LBL 90

106 STO "U_X"

107 X<> ST L

108 STO "U_L"

109 X<> ST L

110 R↓

111 STO "U_Y"

112 R↓

113 STO "U_Z"

114 R↓

115 R↓

116 RTN

117▸LBL 99

118 CLV "U_Z"

119 CLV "U_Y"

120 CLV "U_X"

121 CLV "U_L"

122 .END.

Versión TI5X (TI-59)

Dia de la semana y días entre dos Fechas

Formato de fecha mmdd.años

Tecla A 1ª Fecha

Tecla B 2ª Fecha

Tecla C Nro, de días entre fechas

Tecla D Día de la semana

STA estadística

Inicio Entrada antigua

Dia de la Semana de una fecha

El mismo programa en Quick Basic (QB64)

Dim UserDate As String

Dim Day As Integer

Dim Month As Long

Dim Year As Long

Dim NewYear As String

Dim DMY As Integer

Dim Century As Integer

Dim Weekday As String

Dim TxtDay(7) As String

Dim TxtMonth(12) As String

Dim Suffix As String

Data Domingo,lunes,Martes,Miercoles,Jueves,Viernes,Sabado

Data Enero,Febrero,Marzo,Abril,Mayo,Junio,Julio

Data Agosto,Septiembre,Octubre,Noviembre,Diciembre

For Count = 0 To 6

Read TxtDay(Count)

Next Count

For Count = 0 To 11

Read TxtMonth(Count)

Next Count

Cls

Locate 10, 28

Print "Introduzca Fecha:"

Locate 12, 20

Print "en Formato DD MM YYYY"

Locate 15, 33

Line Input ; UserDate$

If Len(UserDate$) = 0 Then End

Loop Until Len(UserDate$) = 10

'*** Separar el día, mes, año ***

Day = Val(Left$(UserDate$, 2))

Month = Val(Mid$(UserDate$, 4, 2))

Year = Val(Right$(UserDate$, 4))

'*** iniciar la impresión

Suffix$ = "th"

If Day Mod 10 = 1 Then Suffix$ = "st"

If Day Mod 10 = 2 Then Suffix$ = "nd"

If Day Mod 10 = 3 Then Suffix$ = "rd"

If Day > 10 And Day < 14 Then Suffix = "th"

Locate 18, 21

Print RTrim$(Str$(Day)); " de "; TxtMonth$(Month - 1); Year; "es ";

'*** Para cualquier fecha en enero o febrero agregue 12 al mes y

'*** restar 1 del año

If Month < 3 Then

Month = Month + 12

Year = Year - 1

End If

'*** Sumar 1 al mes y multiplicar por 2,61 '*** Suelta la fracción (no redonda) después

Month = Month + 1

Month = Fix(Month * 2.61)

'*** Agregar día, mes y los dos últimos dígitos del año

NewYear$ = LTrim$(Str$(Year))

Year = Val(Right$(NewYear$, 2))

DMY = Day + Month + Year

Century = Val(Left$(NewYear$, 2))

'*** Suma una cuarta parte de los dos últimos dígitos del año '*** (truncado no redondeado)

Year = Fix(Year / 4)

DMY = DMY + Year

'*** Agregue los siguientes factores para el año

If Century = 18 Then Century = 2

If Century = 19 Then Century = 0

If Century = 20 Then Century = 6

If Century = 21 Then Century = 4

DMY = DMY + Century

'*** El día de la semana es el módulo de DMY dividido por 7

DMY = DMY Mod 7

Print TxtDay(DMY)

End

Inicio Entrada antigua

Dia Mes Año y hora actual

Inserta DIA / MES / AÑO y HORA actual en cualquier programa que lo necesite para su cabecera

DATE Returns the current date to the X register. In MDY mode, the date is returned as MM.DDYYYY; in DMY mode, it is returned as DD.MMYYYY; and in YMD mode, it is returned as YYYY.MMDD.

TIME Devuelve la hora actual en el registro X. La hora se devuelve en formato HH.MMSSss, con HH de 0 a 23, independientemente de la configuración CLK12/CLK24. Además, cuando se ejecuta desde el teclado, muestra la hora en formato "HH:MM:SS AM" o "HH:MM:SS", cuando el formato de visualización es CLK12 o CLK24, respectivamente.

Ajustamos (FIX) a 0 y eliminamos los decimales (IP) para obtener el numero entero

DMY DATE = DIA

MDY DATE = MES

YMD DATE = AÑO

TIME retorna la HORA

30/07/2023 10.42

00 { 539-Byte Prgm }

01▸LBL "MENSU"

02 " "

03 ADV

04 FIX 00

05 CLA

06 CLRG

07 MDY

08 DATE

09 IP

10 STO 20 "Mes"

11 YMD

12 DATE

13 STO 21 "Año"

14 DMY

15 DATE

16 STO 23 "Dia"

17 CLA

18 ARCL 23

19 ├" / "

20 ARCL 20 "Mes"

21 ├" / "

22 ARCL 21

23 ├" "

24 FIX 02

25 TIME "Hora"

26 ARCL ST X

27 AVIEW

28 END

Con el mes en Letra

Fecha actual en QB64

30/Julio/2023 16:25:15

Dim TextoI$(30)

Dim T$(30)

NB$ = Date$

LT = Len(NB$)

TextoI$ = Mid$(NB$, 4, 2) Rem dia

dia$ = TextoI$

TextoI$ = Mid$(NB$, 1, 2) Rem mes

mes$ = TextoI$

TextoI$ = Mid$(NB$, 7, 10) Rem ano

ano$ = TextoI$

For I = 1 To 12

If mes$ = "01" Then

A$ = "Enero"

ElseIf mes$ = "02" Then

A$ = "Febrero"

ElseIf mes$ = "03" Then

A$ = "Marzo"

ElseIf mes$ = "04" Then

A$ = "Abril"

ElseIf mes$ = "05" Then

A$ = "Mayo"

ElseIf mes$ = "06" Then

A$ = "Junio"

ElseIf mes$ = "07" Then

A$ = "Julio"

ElseIf mes$ = "08" Then

A$ = "Agosto"

ElseIf mes$ = "09" Then

A$ = "Septiembre"

ElseIf mes$ = "10" Then

A$ = "Octubre"

ElseIf mes$ = "11" Then

A$ = "Noviembre"

ElseIf mes$ = "12" Then

A$ = "Diciembre"

End If

Print dia$; "/"; A$; "/"; ano$, Time$

Programa extraído de https://www.qb64tutorial.com/

'- Variable Declaration Section -
'--------------------------------

DIM MonthName$(12) ' array storing the names of the months
DIM Hours% '         numeric value of hour
DIM Month% '         numeric value of month
DIM Day% '           numeric value of day
DIM Year% '          numeric value of year
DIM Suffix$ '        day suffix
DIM AmPm$ '          AM or PM

'----------------------------
'- Main Program Begins Here -
'----------------------------

MonthName$(1) = "January" '                                                store the month names
MonthName$(2) = "February"
MonthName$(3) = "March"
MonthName$(4) = "April"
MonthName$(5) = "May"
MonthName$(6) = "June"
MonthName$(7) = "July"
MonthName$(8) = "August"
MonthName$(9) = "September"
MonthName$(10) = "October"
MonthName$(11) = "November"
MonthName$(12) = "December"
DO '                                                                       begin main loop
    Month% = VAL(LEFT$(DATE$, 2)) '                                        extract value of month
    Day% = VAL(MID$(DATE$, 4, 2)) '                                        extract value of day
    Year% = VAL(RIGHT$(DATE$, 4)) '                                        extract value of year
    Hours% = VAL(LEFT$(TIME$, 2)) '                                        extract value of hours
    IF Hours% > 12 THEN '                                                  military time?
        Hours% = Hours% - 12 '                                             yes, convert to civilian
        AmPm$ = "PM" '                                                     it's the afternoon
    ELSE '                                                                 no
        AmPm$ = "AM" '                                                     it's the morning
    END IF
    IF Day% = 1 OR Day% = 21 OR Day% = 31 THEN '                           one of these days?
        Suffix$ = "st," '                                                  yes, day ends in st
    ELSEIF Day% = 2 OR Day% = 22 THEN '                                    no, one of these days?
        Suffix$ = "nd," '                                                  yes, day ends in nd
    ELSEIF Day% = 3 OR Day% = 23 THEN '                                    no, one of these days?
        Suffix$ = "rd," '                                                  yes, days ends in rd
    ELSE '                                                                 no
        Suffix$ = "th," '                                                  day must end in th then
    END IF
    LOCATE 2, 2 '                                                          position cursor
    Dt$ = "The current date is " + MonthName$(Month%) '                    build new date string
    Dt$ = Dt$ + STR$(Day%) + Suffix$ + STR$(Year%) + "  "
    PRINT Dt$ '                                                            display date string
    LOCATE 4, 2 '                                                          position cursor
    Tm$ = "The current time is " + RIGHT$("0" + LTRIM$(STR$(Hours%)), 2) ' build new time string
    Tm$ = Tm$ + " Hours, " + MID$(TIME$, 4, 2) + " Minutes and "
    Tm$ = Tm$ + RIGHT$(TIME$, 2) + " Seconds " + AmPm$
    PRINT Tm$ '                                                            display time string
LOOP UNTIL INKEY$ <> "" '                                                  end loop if key pressed
SYSTEM '                                                                   return to Windows

Convertidor de monedas

Emulador Free42 para PC

00 { 244-Byte Prgm }

01▸LBL "CONVER"

02 CLST

03 CLMENU

04 " "

05 AVIEW

06 "$$$$"

07 KEY 1 XEQ "PSTAS"

08 "EUROS"

09 KEY 3 XEQ "EUROS"

10 "VALOR MONEDA>"

11 166,386

12 STO 20

13 RDX,

14▸LBL 20

15 MENU

16 STOP

17 GTO 20

18▸LBL "EUROS"

19 "•EUROS"

20 KEY 3 XEQ "EUROS"

21 "$$$$"

22 KEY 1 XEQ "PSTAS"

23 MENU

24 "EUROS?"

25 PROMPT

26 STO 01

27 RCL 20

28 ×

29 STO 10

30 FIX 02

31 "EUROS>"

32 XEQ 01

33 FIX 00

34 "$$$$="

35 XEQ 10

36 STOP

37▸LBL "PSTAS"

38 "EUROS"

39 KEY 3 XEQ "EUROS"

40 "•$$$$"

41 KEY 1 XEQ "PSTAS"

42 MENU

43 "$$$$?"

44 PROMPT

45 STO 01

46 RCL 20

47 ÷

48 STO 10

49 FIX 00

50 "$$$$>"

51 XEQ 01

52 FIX 02

53 "EUROS="

54 XEQ 10

55 STOP

56▸LBL 01

57 ARCL 01

58 AVIEW

59 RTN

60▸LBL 10

61 ARCL 10

62 AVIEW

63 RTN

64 END

El valor de conversión de la Moneda se cambia en la linea 11.

Inicio Entrada antigua

Calcular el promedio de x Números

Emulador Free 42

La serie termina al pulsar FIN

Pulsar R/S para seguir con otra serie

00 { 94-Byte Prgm }

01▸LBL "MEDIA"

02 CLMENU

03 CLST

04 CLRG

05 "====="

06 AVIEW

07 FIX 02

08▸LBL 01

09 XEQ 10

10 CLST

11 1

12 +

13 STO+ 00. 'Inicia el contador

14 RCL 10

15 PRX

16 STO+ 01

17 GTO 01

18▸LBL 10

19 "FIN" ' Al pulsar FIN da el resultado

20 KEY 1 XEQ 20. ' Prepara el Menu pantalla

21▸LBL 02.

22 MENU

23 "VAL?" 'Introduce los valores

24 PROMPT

25 STO 10

26 RTN

27▸LBL 20

28 CLST

29 "MEDIA="

30 RCL 01.

31 RCL 00

32 ÷ ' Cacula el promedió de los valores

33 ARCL ST X

34 AVIEW

35 STOP

36 "SUMA= "

37 ARCL 01. ' Suma de los valores introducidos

38 AVIEW

39 STOP

40 XEQ "MEDIA"

41 END

Programa promedio realizado con el emulador TI5X (TI-59)

Pulsar la tecla A para restear las memorias

Introducir cada valor pulsando la tecla B, para finalizar pulsar la tecla C para obtener el promedio.

RST (ir a la 1ª línea del programa)

El mismo programa promedio en QBasic (QB64)

valor! = 1

total! = 0.0

count% = 0

Print "Fin=0"

ENTER:

If valor! = 0 Then

GoTo fin

Else

Input "Valor? ", valor!

total! = total! + valor!

count% = count% + 1

GoTo ENTER

End If

fin:

count% = count% - 1

Print "Suma=", total!

Print "La media es= "; total! / count%

End

Modificación para grabar las entradas y resultados, en el fichero "testfile.dat"

y así poderlo conservar o compartir.

Open "testfile.dat" For Output As #1

valor! = 1

total! = 0.0

count% = 0

Print "Fin=0"

ENTER:

If valor! = 0 Then

GoTo fin

Else

Input "Valor? ", valor!

Select Case valor!

Case Is > 0

Print #1, valor!

End Select

total! = total! + valor!

count% = count% + 1

GoTo ENTER

End If

fin:

count% = count% - 1

Print "Suma= ", total!

Print "La media es= "; total! / count%

Print #1, "Suma= "; total!

Print #1, "Media="; total! / count%

Close #

End

Para leer cualquier nombre de archivo 

Cls Input "Archivo? ", file$ dat$ = ".dat" test$ = file$ + dat$

print test$

Open test$ For Input As #1 While Not EOF(1) Line Input #1, linea$ Print línea$ Wend Close #1

Inicio Entrada antigua

Juego de los Numeros

NR? 9

MENOR

MAYOR

CORRECTO=7.

PUNTOS=4.

NR? 7

MAYOR

CORRECTO=10.

PUNTOS=3.

00 { 178-Byte Prgm }

01▸LBL "NRO→"

02 CLST

03 CLMENU

04 MENU

05 RAN

06 10

07 ×

08 1

09 +

10 IP

11 STO "CO"

12 0

13 STO "NR"

14 0

15 STO "PUN"

16▸LBL "EN"

17 FIX 00

18 INPUT "NR"

19 RCL ST X

20 RCL "CO"

21 X=Y?

22 XEQ "BIEN"

23 RCL "PUN"

24 1

25 +

26 STO "PUN"

27 RCL "CO"

28 RCL "NR"

29 X>Y?

30 GTO "ME"

31 GTO "MA"

32▸LBL "ME"

33 CLST

34 "MENOR"

35 AVIEW

36 PSE

37 GTO "EN"

38▸LBL "MA"

39 CLST

40 "MAYOR"

41 AVIEW

42 PSE

43 GTO "EN"

44▸LBL "BIEN"

45 CLST

46 "CORRECTO="

47 ARCL "NR"

48 AVIEW

49 STOP

50 "PUNTOS="

51 RCL "PUN"

52 1

53 +

54 ARCL ST X

55 AVIEW

56 STOP

57 .END.

Reescribo el mismo programa en Quick Basic (QB64)

Randomize Timer

correcto = Int(Rnd * 10) + 1

nro = 0

puntuaje = 0

Do While correcto <> nro

Input "Ingrese Nro:? ", nro

If nro = correcto Then

Print "Bien"

Print puntuaje

Else

puntuaje = puntuaje + 1

If nro > correcto Then

Print " es menor"

Else

Print " Es mayor"

End If

Loop

Inicio Entrada antigua