{Mira trabaja con archivos de extensión *.wav de 8 bit a ver si esto te vale pon el sonido en el mismodirectorio del programa.
Carga de Internet el archivo nombre AHA.WAV y prueba lo solo en alarma }
program relog;
uses
crt, dos;
type
regmusica = record
frecu : longint;
tama : longint;
misi : pointer;
end;
cavewave = record
riff : array[0..3] of char;
tama : longint;
wave : array[0..7] of char;
for1 : longint;
for2 : integer;
mono : integer;
frec : longint;
bseg : longint;
bcat : integer;
bmut : integer;
dato : array[0..3] of char;
bmst : longint;
end;
string4 = string[4];
var
hor1, min1, seg1, milseg1 : word;
tomado, pbase : word;
mimusi : regmusica;
cwave : cavewave;
f : file;
mayor, menor : byte;
nombre : string;
blaster, memtoma : boolean;
memcarga : word;
nombmusi : string[20];
procedure elreloj;
begin
repeat
gettime(hor1,min1,seg1,milseg1);
gotoxy(3,2);write(' Hora Minut Segun'); gotoxy(3,3);write('ÚÄÄÄÄÂÄÄÄÄÂÄÄÄÄ¿ '); gotoxy(3,4);write('³ ³ ³ ³Û'); gotoxy(3,5);write('ÀÄÄÄÄÁÄÄÄÄÁÄÄÄÄÙÛ'); gotoxy(3,6);write(' ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ'); gotoxy(5,4);write(hor1);
gotoxy(10,4);write(min1);
gotoxy(15,4);write(seg1);
gotoxy(1,1);
until keypressed;
end;
procedure crono;
var
tc, tecla : char;
hora, minut, segun, deci: byte;
begin
clrscr;
hora := 0;
minut := 0;
segun := 0;
gotoxy(20,6);write(' ***** Conometro *****'); gotoxy(10,8);write('Teclas [P]=Parada [M]=Segir [I]=Reinicia [S]=Salir'); repeat
delay(960);
deci := 60;
if deci = 60 then
begin
segun := segun + 1;
if segun = 60 then
begin
segun := 0;
minut := minut + 1;
if minut = 60 then
begin
minut := 0;
hora := hora + 1;
if hora = 24 then
hora := 0;
end;
end;
deci := 0;
end;
gotoxy(20,10);write(' '); gotoxy(20,10);write(hora,':',minut,':',segun);
if keypressed then
begin
tecla := upcase(readkey);
if tecla = 'P' then
repeat
gotoxy(20,10);write(' '); gotoxy(20,10);write(hora,':',minut,':',segun);
repeat
tc := upcase(readkey);
until tc = 'M';
tecla := ' ';
until tc = 'M';
if tecla = 'I' then
begin
hora := 0;
minut := 0;
segun := 0;
deci := 0;
gotoxy(20,10);write(' '); gotoxy(20,10);write(hora,':',minut,':',segun);
end;
end;
until tecla = 'S';
end;
procedure puertobase;
var
datos : string;
bas : string[4];
tb : word;
erro : integer;
begin
datos := getenv('blaster'); if datos[1] in ['a','A'] then
bas := copy(datos,2,5);
for erro := 1 to length(bas) do
if bas[erro] = ' ' then
delete(bas,erro,1);
val('$' + bas,tb,erro); if erro = 0 then
begin
pbase := tb;
blaster := true;
end;
end;
procedure escribe_dsp(d : byte);
begin
while Port[pbase + $c] And $80 <> 0 do;
port[pbase + $c] := d;
end;
function lee_dsp : byte;
begin
while Port[pbase + $c] and $80 = 0 do;
lee_dsp := Port[pbase + $a];
end;
function altavoz_encendido : byte;
begin
escribe_dsp($d1);
end;
function altavoz_apagado: byte;
begin
escribe_dsp($d3);
end;
procedure activa_misica(soud : Pointer; long : word; frec : longint);
var
tiempo : longint;
pagina, despla : word;
begin
altavoz_encendido;
long := long - 1;
despla := seg(soud^) shl 4 + ofs(soud^);
pagina := (seg(soud^) + ofs(soud^) shr 4) shr 12;
port[$0a] := 5;
port[$0c] := 0;
port[$0b] := $49;
port[$02] := lo(despla);
port[$02] := hi(despla);
port[$83] := pagina;
port[$03] := lo(long);
port[$03] := hi(long);
port[$0a] := 1;
if (cwave.bmut = 8) and (cwave.mono = 1) and (cwave.bcat = 1) then {8 bit} begin
tiempo := (65536 - (256000000 div (1 * frec))) shr 8;
escribe_dsp($40);
escribe_dsp(tiempo);
escribe_dsp($14);
escribe_dsp(lo(long));
escribe_dsp(hi(long));
end;
end;
procedure tomawave(nom : string);
begin
memtoma := false;
assign(f,nom);
{$I-} reset(f,1); {$I+} if ioresult <> 0 then
begin
clrscr;
writeln(' Error El Archivo No Se Encontro Pulse [Enter]'); readln;
exit;
end
else
begin
seek(f,0);
blockread(f,cwave,sizeof(cavewave),tomado);
if cwave.bmst < 32563 then
begin
getmem(mimusi.misi,cwave.bmst);
blockread(f,mimusi.misi^,cwave.bmst);
memtoma := true;
mimusi.tama := cwave.bmst;
mimusi.frecu := cwave.frec;
memcarga := cwave.bmst;
end
else
begin
getmem(mimusi.misi,32563);
blockread(f,mimusi.misi^,32563);
memtoma := true;
mimusi.tama := 32563;
mimusi.frecu := cwave.frec;
memcarga := 32563;
end;
close(f);
end;
end;
procedure jeneramusica;
begin
blaster := false;
puertobase;
if blaster = true then
begin
nombre := 'aha.wav';
tomawave(nombre);
activa_misica(mimusi.misi, mimusi.tama, mimusi.frecu);
port[pbase + $c] := $D0;
if memtoma = true then
freemem(mimusi.misi,memcarga);
end;
end;
procedure reloalarma;
var
alarmahor, alarmamin : word;
h, m, s, d : word;
begin
clrscr;
gettime(h,m,s,d);
gotoxy(35,12);write(h,':',m,':',s);
gotoxy(35,14);write('Entre Hora : '); gotoxy(48,14);readln(alarmahor);
gotoxy(35,15);write('Entre Minutos : '); gotoxy(51,15);readln(alarmamin);
clrscr;
repeat
gettime(h,m,s,d);
gotoxy(35,12);write(h,':',m,':',s);
until keypressed or ((h = alarmahor) and (m = alarmamin));
if (h = alarmahor) and (m = alarmamin) then
begin
repeat
jeneramusica;
delay(1620); {Tiempo de espera dependiendo del tamaño del Archivo de música} until keypressed;
end;
end;
procedure menu;
var
sal : boolean;
opcion : char;
begin
sal := false;
repeat
clrscr;
writeln(' ******* Menu Jeneral *******'); writeln;
writeln(' [R] Reloj'); writeln(' [C] Conometro'); writeln(' [A] Alarma'); writeln(' [S] Salir'); writeln;
writeln(' <<<<<< Elije Opcion >>>>>'); repeat
opcion := upcase(readkey);
until opcion in['R','C','A','S'];
clrscr;
case opcion of
'R' : elreloj;
'C' : crono;
'A' : reloalarma;
'S' : sal := true;
end;
until sal = true;
end;
begin
menu;
end.
Crear cuenta