Prehraje zvuk vo formáte wav na speakery PC

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Kategórie: KMP (Programy mladých programátorů)
speaker.pngAutor: Aleš Kucik
web: www.webpark.cz/prog-pascal

Program: Speaker.pas,  Mouse.pas,  Textscr.pas
Soubor exe: Speaker.exe
Potřebné: A.wav,  B.wav,  Mouse.tpu,  Textscr.tpu

Tento program spouštějte z DOSu (WINxx restartujte do DOSu)! Přehraje všechny soubory, ale hudbu uslyšíte jen u 8bit zvukových souborů bez komprese a musí být nahrány mono. Předem upozorňuji, že na některých SPEAKERECH zvuk asi nepůjde přehrát vůbec. Pokud si nevíte rady s nastavením "OVERSAMPLE", "MUTE" a "FREQUENCE" přečtěte si prosím příslušnou kapitolu v GDM3 (sekce překlady) a nebo je zkoušejte.

mouse.tpu, mouse.pas - použitá jednotka na ovládání myši. textscr.tpu, textscr.pas - jednotky pro ovládání výstupu na obrazovku.

Aby jste měli na čem testovat, tady jsou nějaké soubory:

a.wav - frekvence 8000Hz, 8bit (když pustíte zvuk na této frekvenci, je slyšet nepříjemné pištění - proto nastavte frekvenci na 32000Hz a oversample na 8 a mute vyzkoušejte mute 2,3,4 uslyšíte, co bude asi nejlepší.

b.wav - tady je druhý soubor tentokrát na 16000Hz (typ: frekvenci nastav na 16000, mute na 2 a oversample na 1) Pokud si budete chtít vytvořit nějaký vlastní soubory: Spusťte "Záznam zvuku" (od Microsoftu) a nějaký WAV uložte s libovolnou frekvencí, musíte, ale nastavit formát:PCM, 8bit mono. 
{ TEXTSCR.PAS                              Copyright (c) Ales Kucik }
{ Unit pre pracu s obrazovkou v textovom mode.                      }
{                                                                   }
{ Datum:29.11.2002                             http://www.trsek.com }
 
unit TextScr;
interface
uses Crt;
const
  page0= $0000;
  page1= $1000;
  page2= $2000;
  page3= $3000;
 
  page_size=$FA0;
 
 
var
  ActivePage:byte;
  VideoSeg:word;
 
procedure SetCursor(h,d:byte); {Cisla v intervalu 0..7}
procedure CursorOn;
procedure CursorOff;
procedure GetChar(var character:char; var attr:byte);
procedure SetActivePage(number:byte);
procedure WriteXY(x,y:byte; s:string);
procedure HWriteXY(x,y,z,c:byte; s:string);
procedure NormalWin(x1,y1,x2,y2:byte);
procedure ErrorMes(s:string);
 
{Prvni vraci znak a potom atribut}
 
function GetKey:word;
function GetTextMode:byte; {Vraci cislo textoveho modu}
function GetActivePage:byte;
 
 
implementation
 
 
procedure SetCursor; assembler;
asm
        mov        ah, 01b
        mov        cl, d
        mov        ch, h
        int        10h
end;
 
procedure CursorOn; assembler;
asm
        mov        ah, 01h
        mov        cl, 07h
        mov        ch, 06h
        int        10h
end;
 
procedure CursorOff; assembler;
asm
        mov        ah, 01h
        mov        cl, 20h
        mov        ch, 20h
        int        10h
end;
 
procedure GetChar(var character:char; var attr:Byte);
var l,h:byte;
begin
  asm
        mov     bh, 0h
        mov     ah, 8h
        int     $10
        mov     l, al
        mov     h, ah
  end;
  character:=chr(l);
  attr:=h;
end;
 
function GetTextMode;
var b:byte absolute 0:$0449;
begin
  GetTextMode:=b;
end;
 
procedure SetActivePage;
begin
  asm
        mov     ah, 05h
        mov     al, number
        int     10h
  end;
  ActivePage:=number;
end;
 
 
function GetActivePage:byte;
begin
   GetActivePage:=ActivePage;
end;
 
function GetKey:word;
var a:word;
begin
  a:=ord(readkey);
  if a=0 then a:=256+ord(readkey);
  getKey:=a;
end;
 
procedure WriteXY;
begin
  gotoxy(x,y);
  write(s);
end;
 
procedure HWriteXY;
var attr:byte;
begin
  gotoxy(x,y);
  attr:=textattr;
  write(s);
  textcolor(c);
  gotoxy(x+z-1,y);
  write(s[z]);
  textattr:=attr;
end;
 
procedure NormalWin;
var
  i,j:byte;
 
begin
  window(x1,y1,x2,y2);
  clrscr;
  gotoxy(2,1);
  write(#201);
  for i:=1 to x2-x1-3 do write(#205);
  write(#187);
  for i:=2 to y2-y1 do
    begin
      gotoxy(2,i);
      write(#186);
      gotoxy(x2-x1,i);
      write(#186);
    end;
  gotoxy(2,y2-y1+1);
  write(#200);
  for i:=1 to x2-x1-3 do write(#205);
  write(#188);
  window(1,1,80,25);
end;
 
procedure ErrorMes;
var
  x,l:byte;
  attr:byte;
begin
  attr:=TextAttr;
  textcolor(yellow);
  textbackground(red);
  l:=length(s);
  if l<28 then l:=28;
  x:=(80-l)div 2 -2;
  NormalWin(x,11,x+l+4,14);
  writeXY(x+2,12,s);
  l:=(l-28)div 2;
  writeXY(x+l+2,13,'Neco stiskni/Press something');
  TextAttr:=attr;
end;
 
begin
   ActivePage:=0;
   if GetTextMode=7 then VideoSeg:=$B000
   else VideoSeg:=$B800;
end.