Oppure

Loading
08/03/10 21:33
Poggi Marco
Scusa Giarados, sono stato troppo critico, e non ho capito subito il metodo di registrazione del suono.

Ho provato il tuo programma e stranamente con Dev Pascal non funziona, mentre con il Turbo Pascal 7.0 funziona.

Ovviamente delay non è affidabile, ma ho creato una funzione per le pause a tempo.

Ecco il programma:

program riproduttore_multimediale;
uses crt, dos;
type textfile=text;

var flag,stop:boolean;

function tempo(var giorno:word):real;
var h,m,s,s100:word;
    anno, mese, GiornoDellaSettimana:word;
begin
 GetTime(h, m, s, s100);
 GetDate(anno, mese, giorno, GiornoDellaSettimana);
 tempo:=(h + 0.0)*3600 + 60*m + s + s100/100;
end;

procedure pausa(t:real);
var t0,te:real;
    g,g0:word;
begin
 t0:=tempo(g0);
 repeat
  te:=tempo(g);
  if g<>g0 then te:=te+86400;
 until (te-t0)>t;
end;

{Procedura per riprodurre il suono}
procedure riproduci_suono(input:longint);
var
    intensita,durata:longint;
begin
intensita:=input mod 1000;
durata:=input-intensita;
sound(intensita);
pausa(durata / 1000);
nosound;
end; 

{Procedura per registrare il suono} 
procedure registra; 
var 
    lunghezza,frequenza,codificato:integer; 
    percorso:string[30]; 
    nota:string[3]; 
    uscita:boolean; 
    file_output:textfile; 
    tasto:char; 

begin 
CLRSCR; 
uscita:=false; 

write('Percorso in cui salvare il file audio : '); readln(percorso); 
    assign(file_output,percorso); 
    rewrite(file_output); 
repeat 
repeat 
    clrscr; 
    textcolor(black); 
    gotoxy(1,1); 
    writeln('Premi ESC per uscire (uscirà dopo aver digitato la nota da salvare)'); 
    gotoxy(20,6); 
    write('Nota (DO/RE/MI/FA/SOL/LA/SI) : '); 
    tasto:=readkey; 
    if tasto=#27 then uscita:=true; 
        textcolor(red); 
        readln(nota); 

until (nota='DO') or (nota='RE') or (nota='MI') or (nota='FA') or (nota='SOL') or (nota='LA') or (nota='SI') or uscita; 
    textcolor(black); 
    write('Durata (in secondi) : '); readln(lunghezza); 



if nota='DO' then frequenza:=262 
else if nota='RE' then frequenza:=294 
else if nota='MI' then frequenza:=330 
else if nota='FA' then frequenza:=349 
else if nota='SOL' then frequenza:=392 
else if nota='LA' then frequenza:=440 
else if nota='SI' then frequenza:=494; 


    codificato:=frequenza+lunghezza*1000; 
    append(file_output); 
    write(file_output,codificato); 
    write(file_output,' '); 

until uscita; 

 close(file_output); (* Ho spostato il comando close fuori dal ciclo *)
end; 


{procedura per la riproduzione} 
procedure riproduzione; 

var 
    c:longint;
    percorso:string[80];
    file_input:textfile; 

begin 
write('Percorso file da riprodurre : '); readln(percorso); 
assign(file_input,percorso); 
reset(file_input); 

while not eof(file_input) do 
begin 
  read(file_input, c);
  riproduci_suono(c); (* non salvo più i dati su un' array, ma *)
                      (* li passo direttamente alla funzione   *)
end;                  (* riproduci_suono                       *)

close(file_input);

end; 

{Menu} 
procedure menu; 


var 
    tasto:char; 
    move:boolean; 
    cont:integer; 


begin 
cont:=0; 
flag:=false; 
move:=false; 

    clrscr; 
    textbackground(white); 
    textcolor(white); 
    gotoxy(1,1); writeln('Cosa vuoi fare?'); 
    gotoxy(30,15); writeln('Ascoltare musica'); 
    gotoxy(30,17); writeln('Registrare musica'); 
    gotoxy(30,19); writeln('Uscire'); 

repeat 

stop:=false; 

if move=false then 
begin 
repeat 
tasto:=readkey; 
until (tasto=#80) or (tasto=#72); 
if (tasto=#80) then begin tasto:=' '; cont:=cont+1 end; 
if (tasto=#72) then begin tasto:=' '; cont:=cont-1 end; 
end; 

if cont=4 then cont:=1; 
if cont=-1 then cont:=3; 
move:=false; 

case cont of 
1:    begin 
    clrscr; 
    textcolor(white); 
    gotoxy(1,1); writeln('Cosa vuoi fare?'); 
    textcolor(red); 
    gotoxy(30,15); writeln('Ascoltare musica'); 
    textcolor(white); 
    gotoxy(30,17); writeln('Registrare musica'); 
    gotoxy(30,19); writeln('Uscire'); 
    repeat 
    begin 
    tasto:=readkey; 
    if tasto=#13 then 
    begin 
    riproduzione; 
    stop:=true 
    end; 
    if tasto=#80 then begin cont:=cont+1; move:=true end; 
    if tasto=#72 then begin cont:=cont-1; move:=true end; 
    end; 
    until (tasto=#13) or (tasto=#80) or (tasto=#72) or stop; 

    end; 

2:    begin 
    clrscr; 
    textcolor(white); 
    gotoxy(1,1); writeln('Cosa vuoi fare?'); 
    gotoxy(30,15); writeln('Ascoltare musica ');
    textcolor(red); 
    gotoxy(30,17); writeln('Registrare musica');
    textcolor(white); 
    gotoxy(30,19); writeln('Uscire ');
    repeat 
    begin 
    tasto:=readkey; 
    if tasto=#13 then begin 
    registra; 
    stop:=true 
    end; 
    if tasto=#80 then begin cont:=cont+1; move:=true end; 
    if tasto=#72 then begin cont:=cont-1; move:=true end; 
    end; 
    until (tasto=#13) or (tasto=#80) or (tasto=#72) or stop; 
    end; 

3:    begin 
    clrscr; 
    gotoxy(1,1); writeln('Cosa vuoi fare?'); 
    gotoxy(30,15); writeln('Ascoltare musica'); 
    gotoxy(30,17); writeln('Registrare musica'); 
    textcolor(red); 
    gotoxy(30,19); writeln('Uscire'); 
    repeat 
    begin 
        tasto:=readkey; 
        if tasto=#13 then 
            begin 
            writeln('Bye bye '); delay(3000);     
            flag:=true 
            end; 
        if tasto=#80 then begin cont:=cont+1; move:=true end; 
        if tasto=#72 then begin cont:=cont-1; move:=true end; 
    end; 
    until (tasto=#13) or (tasto=#80) or (tasto=#72); 
    end; 
end; 

until flag OR stop; 
end; 



{Programma} 
begin 

repeat 
menu 
until flag; 

end.

Ultima modifica effettuata da Poggi Marco 09/03/10 17:42
aaa