Programa musical en FoxPro
290 views
Skip to first unread message
Juan Carlos Ocampo de la Cruz
Jul 11, 2023, 11:24:31 AM7/11/23
to Comunidad de Visual Foxpro en Español
integral
Jul 11, 2023, 6:11:39 PM7/11/23
to Comunidad de Visual Foxpro en Español
Buenas Tardes
Gracias por Compartirlo. El programa original esta escrito en GWBASIC. Que lo estudie haya por el año 1990...
Saludos,
Integral
(Lima-Perú)
Juan Carlos Ocampo de la Cruz
Jul 12, 2023, 12:35:08 PM7/12/23
to publice...@googlegroups.com
De nada Integral, de hecho el programa es de 1981, venía en los demos de la primera PC IBM.
La primera traducción la hice en Clipper en 1993, en ese entonces solo había usado FoxBase+
y este no tenía una manera de cambiar la frecuencia de las notas y duración de tonos como FoxPro.
FoxPro tampoco tiene una función específica para emitir sonidos como TONE, SOUND, PLAY...
Pero se puede emular con los comandos SET BELL TO y ??CHR(7)
Saludos.
--
Blog de la Comunidad Visual FoxPro en Español: http://comunidadvfp.blogspot.com
---
Has recibido este mensaje porque estás suscrito a un tema del grupo "Comunidad de Visual Foxpro en Español" de Grupos de Google.
Para cancelar la suscripción a este tema, visita https://groups.google.com/d/topic/publicesvfoxpro/D0Di8D9cAh8/unsubscribe.
Para cancelar la suscripción a este grupo y a todos sus temas, envía un correo electrónico a publicesvfoxp...@googlegroups.com.
Para ver esta conversación en el sitio web, visita https://groups.google.com/d/msgid/publicesvfoxpro/25f08640-577f-4539-9724-961cb4419c31n%40googlegroups.com.
Victor Espina
Jul 12, 2023, 2:02:33 PM7/12/23
to Comunidad de Visual Foxpro en Español
Hace mas años de los que me gustaria recordar, hice algo muy similar en GW-Basic para MS/DOS. Esa version de Basic venia con un modo grafico y el comando PLAY que recibia un string donde tu podias indicar nota, octava y duracion. Mi programa te permitia poner las notas en un pentagrama con clave de sol, reproducir la melodia, guardarla y recuperarla.
Buenos tiempos esos :)
Buenos tiempos esos :)
Saludos
Victor Espina
Juan Carlos Ocampo de la Cruz
Jul 12, 2023, 2:22:50 PM7/12/23
to publice...@googlegroups.com
Muy interesante Victor, si aun conservas el código, se podría probar compilarlo con QB64.
Es un compilador BASIC multiplataforma, compatible con QuickBasic y gwbasic.
Saludos.
Para ver esta conversación en el sitio web, visita https://groups.google.com/d/msgid/publicesvfoxpro/1158ed16-a09a-43df-b43d-f147b174fe89n%40googlegroups.com.
Walter Valle
Jul 12, 2023, 3:10:41 PM7/12/23
to Comunidad de Visual Foxpro en Español
Ten envío el "Happy Bday", tuve que desempolvar unos antiguos backups de un viejo sistema de ventas que le "cantaba" a los usuarios el dia de su cumple al loguear. Ahí están las frecuencias que necesitas para agregarlas a tu tabla "Tone.DBF".
Perdón por la forma de programar, pero en ese tiempo era "nuevo" jejeje. Lo probé en DOXBox y corre perfecto, saludos, ojala lo sumes a tu programa.
SET TALK OFF
SET ESCAPE OFF
SET DATE ITALIAN
*
DO WHILE .T.
LL = CANTA('WALTER')
IF LL
LOOP
ENDIF
EXIT
ENDDO
PROCEDURE CANTA
PARAMETERS MNAME, MDATE, MCOLOR
*
PRIVATE ALL
IF SET("TALK") == "ON"
SET TALK OFF
MTALK = "ON"
ELSE
MTALK = "OFF"
ENDIF
MESCAPE = SET("ESCAPE")
SET ESCAPE OFF
MCURSOR = SET("CURSOR")
SET CURSOR OFF
IF TYPE("mdate") == "D" && See if today is the birthday
IF RIGHT(DTOS(MDATE),4) # RIGHT(DTOS(DATE()),4)
DO REST_ENV
RETURN .F.
ENDIF
ENDIF
MCOLOR = IIF(TYPE("mcolor")="N" .AND. BETWEEN(MCOLOR, 1, 24), MCOLOR, 7)
IF TYPE("mname") == "C" .AND. ! EMPTY(MNAME)
MNAME = ALLTRIM(MNAME)+" "
IF "-" $ MNAME
FIRST_SYL = " "+SUBSTR(MNAME, 1, AT("-", MNAME) -1)
SECON_SYL = TRIM(SUBSTR(MNAME, AT("-", MNAME) +1))+"!"
ELSE
FIRST_SYL = " "+TRIM(MNAME)
SECON_SYL = "!"
ENDIF
ELSE
FIRST_SYL = " _____"
SECON_SYL = "____!"
ENDIF
FOR I = 1 TO 3
FOR F = 900 TO 1100 STEP 25
SET BELL TO F,1
?? CHR(7)
ENDFOR
ENDFOR
WAIT WIND 'Pulse cualquier tecla...'
DEFINE WINDOW _YER_BDAY_ ;
FROM (SROWS()/2)-4, (SCOLS()/2)-25 TO (SROWS()/2)+4, ;
(SCOLS()/2)+25 PANEL COLOR SCHEME (MCOLOR) SHADOWS
DUR = 4
=NOWAIT('Felicidades '+ALLT(MNAME)+' en el DIA de t£ Cumplea¤os!')
ACTIVATE WINDOW _YER_BDAY_
SET BELL TO 392, DUR && G4
? " Hap"+CHR(7)
?? "py"+CHR(7)
SET BELL TO 440, DUR*2 && A5
?? " Birth"+CHR(7)
SET BELL TO 392, DUR*2 && G4
?? "day"+CHR(7)
SET BELL TO 523, DUR*2 && C5
?? " to"+CHR(7)
SET BELL TO 494, DUR*4 && B5
?? " You..."+CHR(7)
SET BELL TO 392, DUR && G4
? SPACE(7)+"Hap"+CHR(7)
?? "py"+CHR(7)
SET BELL TO 440, DUR*2 && A5
?? " Birth"+CHR(7)
SET BELL TO 392, DUR*2 && G4
?? "day"+CHR(7)
SET BELL TO 587, DUR*2 && D5
?? " to"+CHR(7)
SET BELL TO 523, DUR*4 && C5
?? " You..."+CHR(7)
SET BELL TO 392, DUR && G4
? SPACE(12)+"Hap"+CHR(7)
?? "py"+CHR(7)
SET BELL TO 784, DUR*2 && G5
?? " Birth"+CHR(7)
SET BELL TO 659, DUR*2 && E5
?? "day,"+CHR(7)
SET BELL TO 523, DUR*2 && C5
? SPACE(17)+"Dear"+CHR(7)
SET BELL TO 494, DUR*2 && B5
?? FIRST_SYL+CHR(7)
SET BELL TO 440, DUR*4 && A5
?? SECON_SYL+CHR(7)
SET BELL TO 699, DUR && F5
? SPACE(22)+"Hap"+CHR(7)
?? "py"+CHR(7)
SET BELL TO 659, DUR*2 && E5
?? " Birth"+CHR(7)
SET BELL TO 523, DUR*2 && C5
?? "day"+CHR(7)
SET BELL TO 587, DUR*2 && D5
?? " to"+CHR(7)
SET BELL TO 523, DUR*4 && C5
?? " You!"+CHR(7)
? ""
=NOWAIT()
CLEAR TYPEAHEAD
SET CURSOR OFF
WAIT WINDOW '¨Quieres que te cante de nuevo '+MNAME+'? S/N' TO RESP
_RET = .F.
IF UPPER(RESP) # 'N'
_RET = .T.
ENDIF
SET CURSOR ON
RELEASE WINDOW _YER_BDAY_
SET BELL TO
RETURN _RET
FUNCTION NOWAIT
PARAMETERS STRING
PRIVATE ALL
IF TYPE("string") = "L"
IF WEXIST("_no_wait_")
RELEASE WINDOW _NO_WAIT_
ENDIF
RETURN ""
ENDIF
WAS_OUTPUT = WOUTPUT()
STRING = LEFT(STRING, SCOLS()-8)
DEFINE WINDOW _NO_WAIT_ ;
FROM 1, SCOLS()-7-LEN(STRING) TO 3, SCOLS()-4;
COLOR SCHEME 5 SHADOWS
ACTIVATE WINDOW _NO_WAIT_
?? " "+STRING
IF EMPTY(WAS_OUTPUT)
ACTIVATE SCREEN
ELSE
ACTIVATE WINDOW &WAS_OUTPUT
ENDIF
RETURN ""
PROCEDURE REST_ENV
IF MESCAPE == "ON"
SET ESCAPE ON
ENDIF
IF MTALK == "ON"
SET TALK ON
ENDIF
IF MCURSOR == "ON"
SET CURSOR ON
ENDIF
SET ESCAPE OFF
SET DATE ITALIAN
*
DO WHILE .T.
LL = CANTA('WALTER')
IF LL
LOOP
ENDIF
EXIT
ENDDO
PROCEDURE CANTA
PARAMETERS MNAME, MDATE, MCOLOR
*
PRIVATE ALL
IF SET("TALK") == "ON"
SET TALK OFF
MTALK = "ON"
ELSE
MTALK = "OFF"
ENDIF
MESCAPE = SET("ESCAPE")
SET ESCAPE OFF
MCURSOR = SET("CURSOR")
SET CURSOR OFF
IF TYPE("mdate") == "D" && See if today is the birthday
IF RIGHT(DTOS(MDATE),4) # RIGHT(DTOS(DATE()),4)
DO REST_ENV
RETURN .F.
ENDIF
ENDIF
MCOLOR = IIF(TYPE("mcolor")="N" .AND. BETWEEN(MCOLOR, 1, 24), MCOLOR, 7)
IF TYPE("mname") == "C" .AND. ! EMPTY(MNAME)
MNAME = ALLTRIM(MNAME)+" "
IF "-" $ MNAME
FIRST_SYL = " "+SUBSTR(MNAME, 1, AT("-", MNAME) -1)
SECON_SYL = TRIM(SUBSTR(MNAME, AT("-", MNAME) +1))+"!"
ELSE
FIRST_SYL = " "+TRIM(MNAME)
SECON_SYL = "!"
ENDIF
ELSE
FIRST_SYL = " _____"
SECON_SYL = "____!"
ENDIF
FOR I = 1 TO 3
FOR F = 900 TO 1100 STEP 25
SET BELL TO F,1
?? CHR(7)
ENDFOR
ENDFOR
WAIT WIND 'Pulse cualquier tecla...'
DEFINE WINDOW _YER_BDAY_ ;
FROM (SROWS()/2)-4, (SCOLS()/2)-25 TO (SROWS()/2)+4, ;
(SCOLS()/2)+25 PANEL COLOR SCHEME (MCOLOR) SHADOWS
DUR = 4
=NOWAIT('Felicidades '+ALLT(MNAME)+' en el DIA de t£ Cumplea¤os!')
ACTIVATE WINDOW _YER_BDAY_
SET BELL TO 392, DUR && G4
? " Hap"+CHR(7)
?? "py"+CHR(7)
SET BELL TO 440, DUR*2 && A5
?? " Birth"+CHR(7)
SET BELL TO 392, DUR*2 && G4
?? "day"+CHR(7)
SET BELL TO 523, DUR*2 && C5
?? " to"+CHR(7)
SET BELL TO 494, DUR*4 && B5
?? " You..."+CHR(7)
SET BELL TO 392, DUR && G4
? SPACE(7)+"Hap"+CHR(7)
?? "py"+CHR(7)
SET BELL TO 440, DUR*2 && A5
?? " Birth"+CHR(7)
SET BELL TO 392, DUR*2 && G4
?? "day"+CHR(7)
SET BELL TO 587, DUR*2 && D5
?? " to"+CHR(7)
SET BELL TO 523, DUR*4 && C5
?? " You..."+CHR(7)
SET BELL TO 392, DUR && G4
? SPACE(12)+"Hap"+CHR(7)
?? "py"+CHR(7)
SET BELL TO 784, DUR*2 && G5
?? " Birth"+CHR(7)
SET BELL TO 659, DUR*2 && E5
?? "day,"+CHR(7)
SET BELL TO 523, DUR*2 && C5
? SPACE(17)+"Dear"+CHR(7)
SET BELL TO 494, DUR*2 && B5
?? FIRST_SYL+CHR(7)
SET BELL TO 440, DUR*4 && A5
?? SECON_SYL+CHR(7)
SET BELL TO 699, DUR && F5
? SPACE(22)+"Hap"+CHR(7)
?? "py"+CHR(7)
SET BELL TO 659, DUR*2 && E5
?? " Birth"+CHR(7)
SET BELL TO 523, DUR*2 && C5
?? "day"+CHR(7)
SET BELL TO 587, DUR*2 && D5
?? " to"+CHR(7)
SET BELL TO 523, DUR*4 && C5
?? " You!"+CHR(7)
? ""
=NOWAIT()
CLEAR TYPEAHEAD
SET CURSOR OFF
WAIT WINDOW '¨Quieres que te cante de nuevo '+MNAME+'? S/N' TO RESP
_RET = .F.
IF UPPER(RESP) # 'N'
_RET = .T.
ENDIF
SET CURSOR ON
RELEASE WINDOW _YER_BDAY_
SET BELL TO
RETURN _RET
FUNCTION NOWAIT
PARAMETERS STRING
PRIVATE ALL
IF TYPE("string") = "L"
IF WEXIST("_no_wait_")
RELEASE WINDOW _NO_WAIT_
ENDIF
RETURN ""
ENDIF
WAS_OUTPUT = WOUTPUT()
STRING = LEFT(STRING, SCOLS()-8)
DEFINE WINDOW _NO_WAIT_ ;
FROM 1, SCOLS()-7-LEN(STRING) TO 3, SCOLS()-4;
COLOR SCHEME 5 SHADOWS
ACTIVATE WINDOW _NO_WAIT_
?? " "+STRING
IF EMPTY(WAS_OUTPUT)
ACTIVATE SCREEN
ELSE
ACTIVATE WINDOW &WAS_OUTPUT
ENDIF
RETURN ""
PROCEDURE REST_ENV
IF MESCAPE == "ON"
SET ESCAPE ON
ENDIF
IF MTALK == "ON"
SET TALK ON
ENDIF
IF MCURSOR == "ON"
SET CURSOR ON
ENDIF
Juan Carlos Ocampo de la Cruz
Jul 12, 2023, 3:40:13 PM7/12/23
to publice...@googlegroups.com
Muchas gracias Walter
Ya tengo varias melodías sueltas, voy hacer una versión 2 del programa.
Saludos.
--
Blog de la Comunidad Visual FoxPro en Español: http://comunidadvfp.blogspot.com
---
Has recibido este mensaje porque estás suscrito a un tema del grupo "Comunidad de Visual Foxpro en Español" de Grupos de Google.
Para cancelar la suscripción a este tema, visita https://groups.google.com/d/topic/publicesvfoxpro/D0Di8D9cAh8/unsubscribe.
Para cancelar la suscripción a este grupo y a todos sus temas, envía un correo electrónico a publicesvfoxp...@googlegroups.com.
Para ver esta conversación en el sitio web, visita https://groups.google.com/d/msgid/publicesvfoxpro/a279db20-07c1-45cc-adcc-96cd3521cf03n%40googlegroups.com.
integral
Jul 12, 2023, 7:50:58 PM7/12/23
to Comunidad de Visual Foxpro en Español
Efectivamente se puede emular con los comandos SET BELL TO y ??CHR(7).
Adjunto un programa de ejemplo que muestra lo que mencionas
Ejecutan el programa y presionan la tecla ESC
PD : Probe el programa en Foxpro 2.6 para D.O.S. y funciona perfectamente bien tan solo suena mas suave, el original hacia un ruido mas fuerte como las maquinaa de juego...
Deben descargar el DOSBOX
Saludos,
Integral
(Lima_Perú)
Juan Carlos Ocampo de la Cruz
Jul 13, 2023, 3:08:57 PM7/13/23
to publice...@googlegroups.com
Gracias Integral.
Interesante efecto de las pantallas y sonido parecido al de los videojuegos.
Los efectos de sonido funcionan en las versiones FoxPro 1.01 hasta la 2.6 en MS-DOS
Por ejemplo este hace el sonidito que se escucha en los estadios de béisbol:
SET BELL ON
DO CHARGE
SET BELL OFF
RETURN .T.
PROCEDURE CHARGE
DO tone WITH 523, 2
DO tone WITH 698, 2
DO tone WITH 880, 2
DO tone WITH 1046, 4
DO tone WITH 880, 2
DO tone WITH 1046, 8
RETURN
PROCEDURE TONE
PARAMETER nFrec,nDurac
SET BELL TO nFrec,nDurac
??CHR(7)
RETURN
DO CHARGE
SET BELL OFF
RETURN .T.
PROCEDURE CHARGE
DO tone WITH 523, 2
DO tone WITH 698, 2
DO tone WITH 880, 2
DO tone WITH 1046, 4
DO tone WITH 880, 2
DO tone WITH 1046, 8
RETURN
PROCEDURE TONE
PARAMETER nFrec,nDurac
SET BELL TO nFrec,nDurac
??CHR(7)
RETURN
Lástima que quitaron esta forma de hacer sonidos en las versiones VISUAL.
Saludos.
Para ver esta conversación en el sitio web, visita https://groups.google.com/d/msgid/publicesvfoxpro/3eff10d4-cf2f-4de0-a09f-d9def23f5d53n%40googlegroups.com.
Zarlu
Jul 13, 2023, 8:49:06 PM7/13/23
to Comunidad de Visual Foxpro en Español
Buenas noches Foxeros!
Algunas vez estuve en VFP9 jugando con los sonidos y con martinillo....
DECLARE Beep IN WIN32API INTEGER nFrequency, INTEGER nDuration
*"MARTINILLO''
mOct=7
*Sol La Si Sol
*Sol La Si Sol
FOR a=1 TO 2
Beep(392*mOct,350)
Beep(440*mOct,400)
Beep(494*mOct,400)
Beep(392*mOct,400)
EndFor
*Si Do* Re*
*Si Do* Re*
FOR a=1 TO 2
Beep(494*mOct,400)
Beep(523*mOct,400)
Beep(588*mOct,400)
WAIT "" TIMEOUT .3
ENDFOR
*Re* Mi* Re*Do* Si Sol
*Re* Mi* Re* Do* Si Sol
FOR a=1 TO 2
Beep(588*mOct,380)
Beep(660*mOct,380)
Beep(588*mOct,380)
Beep(523*mOct,380)
Beep(494*mOct,380)
Beep(392*mOct,500)
WAIT "" TIMEOUT .5
ENDFOR
*La Re Sol
Beep(440*mOct,600)
Beep(588*mOct,600)
Beep(392*mOct,600)
WAIT "" TIMEOUT .5
*La Re Sol
Beep(440*mOct,600)
Beep(588*mOct,600)
Beep(392*mOct,900)
RETURN
mOct=7
*Sol La Si Sol
*Sol La Si Sol
FOR a=1 TO 2
Beep(392*mOct,350)
Beep(440*mOct,400)
Beep(494*mOct,400)
Beep(392*mOct,400)
EndFor
*Si Do* Re*
*Si Do* Re*
FOR a=1 TO 2
Beep(494*mOct,400)
Beep(523*mOct,400)
Beep(588*mOct,400)
WAIT "" TIMEOUT .3
ENDFOR
*Re* Mi* Re*Do* Si Sol
*Re* Mi* Re* Do* Si Sol
FOR a=1 TO 2
Beep(588*mOct,380)
Beep(660*mOct,380)
Beep(588*mOct,380)
Beep(523*mOct,380)
Beep(494*mOct,380)
Beep(392*mOct,500)
WAIT "" TIMEOUT .5
ENDFOR
*La Re Sol
Beep(440*mOct,600)
Beep(588*mOct,600)
Beep(392*mOct,600)
WAIT "" TIMEOUT .5
*La Re Sol
Beep(440*mOct,600)
Beep(588*mOct,600)
Beep(392*mOct,900)
RETURN
*-*-*-
y aquí las notas del colega
sodastereano
lnFrec=1.5
FOR a=1 TO 2
Beep(523*lnFrec,200)
Beep(698*lnFrec,200)
Beep(880*lnFrec,200)
Beep(1046*lnFrec,400)
Beep(880*lnFrec,200)
Beep(1046*lnFrec,800)
ENDFOR
CLEAR DLLS
RETURN
FOR a=1 TO 2
Beep(523*lnFrec,200)
Beep(698*lnFrec,200)
Beep(880*lnFrec,200)
Beep(1046*lnFrec,400)
Beep(880*lnFrec,200)
Beep(1046*lnFrec,800)
ENDFOR
CLEAR DLLS
RETURN
Saludos
zarlu
Chetumal, Quintana Roo, México
Juan Carlos Ocampo de la Cruz
Jul 14, 2023, 12:13:07 PM7/14/23
to publice...@googlegroups.com
Hola Zarlu:
Que buen tip para generar sonidos desde Visual Foxpro, hace tiempo vi un ejemplo pero solo tocaba 2 notas y no hice pruebas con una melodía completa.
Me encontre este demo de martinillo en Turbo C++, no cuento con el ejecutable, pero en la pantalla salen las notas:
En mi canal hay varios temas más:
Saludos desde Acapulco, Gro, México
Para ver esta conversación en el sitio web, visita https://groups.google.com/d/msgid/publicesvfoxpro/ba3638f3-c3f0-4698-b303-9fdcc33f9e2cn%40googlegroups.com.
Reply all
Reply to author
Forward
0 new messages