home *** CD-ROM | disk | FTP | other *** search
/ PC Musician 2000 / PC_Musician_2000.iso / PCMUSIC / MISC / VOX2WAV / VOXDEC.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-11-27  |  8.3 KB  |  300 lines
  1. unit Voxdec;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, ExtCtrls, Buttons;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Panel1: TPanel;
  12.     OpenDialog1: TOpenDialog;
  13.     BitBtn2: TBitBtn;
  14.     BitBtn3: TBitBtn;
  15.     Panel2: TPanel;
  16.     ComboBox1: TComboBox;
  17.     Label3: TLabel;
  18.     BitBtn1: TBitBtn;
  19.     GroupBox1: TGroupBox;
  20.     Panel3: TPanel;
  21.     Label2: TLabel;
  22.     Label1: TLabel;
  23.     procedure Button1Click(Sender: TObject);
  24.     procedure Button2Click(Sender: TObject);
  25.     procedure BitBtn3Click(Sender: TObject);
  26.   private
  27.     { Private declarations }
  28.   public
  29.     { Public declarations }
  30.   end;
  31. type wavefile = record
  32.      wavehdr : array[0..39] of byte;
  33.      wavelenght : longint;
  34.      end;
  35. const
  36. MLN : array[0..7] of integer = (-1,-1,-1,-1,+2,+4,+6,+8);
  37. SS : array[0..48] of word =    (16,17,19,21,23,25,28,31,34,37,41,45,50,55,
  38.                                 60,66,73,80,88,97,107,118,130,143,157,173,190,
  39.                                 209,230,253,279,307,337,371,408,449,494,544,
  40.                                 598,658,724,796,876,963,1060,1166,1282,1411,1552);
  41.  
  42.  
  43. var
  44.   Form1: TForm1;
  45.   head:wavefile;
  46.   inbuffer:array[0..1028] of byte;
  47.   outbuffer:array[0..1028] of byte;
  48.   SSpointer: integer;
  49.   Xp: integer;
  50.   X: integer;
  51.  
  52. implementation
  53.  
  54. uses voxdec2;
  55.  
  56.  
  57.  
  58. {$R *.DFM}
  59. {
  60. WELCOME TO VOX2WAV a freeware utility copyright 1996 Genialogic Team
  61. Coded by Giovanni Tummarello
  62.  
  63. Dialogic gives a nice DOC about how to go from wox to wav and vice versa BUT
  64. they forget to mention 2-3 IMPORTANT details :-)  without those i think its
  65. impossible to write a converter..
  66. After bugging them for a month they finally sent me some better examples and i
  67. could finish them.
  68.  
  69. Vox format its their copyright, so check with them if you need to do
  70. anything that involves this format..
  71.  
  72. This source code can be include in your programs as long as creadits to
  73. us and a mention to our homepage is in your about screen
  74. please e mail me at tummarel@ascu.unian.it for more information
  75. WE ARE THE MAKERS OF *VOCOM* a complete dialogic toolkit.. so please look for
  76. vocom on the web and visit our homepage!
  77.  
  78. This is not optimized or good looking code.. but it works.. :)
  79. }
  80.  
  81.  
  82.  
  83. procedure TForm1.Button1Click(Sender: TObject);
  84. {/* standard wave file header */
  85. /****************************************************************
  86. * 'RIFF'
  87. * length in bytes of all that follows(long)
  88. * 'WAVE'
  89. * 'fmt '
  90. * length in bytes of the format block = 16(long)
  91. * format = 1(int)
  92. * number of channels = 1(int) - mono
  93. * sample rate(long)
  94. * bytes per second during play(long)
  95. * bytes per sample = 2(int)
  96. * bits per sample = 16(int)
  97. * 'data'
  98. * length in bytes of the data block(long)
  99. ****************************************************************/}
  100. const
  101. wavehdr: array [0..10] of longint = ($46464952,$ffffffdb,$45564157,$20746d66,16,$10001,6000,
  102.                    6000,$80001,$61746164,-1);
  103.  
  104. var
  105. fi,fo:file;
  106. a,b,c: integer;
  107. letti: integer;
  108. counter: integer;
  109. dn: integer;
  110. sample: word;
  111. ssvalue:integer;
  112. lettitot:longint;
  113. cippo,cippo2,cippo3 : integer;
  114. begin
  115. opendialog1.filterindex:=2;
  116. if opendialog1.execute then
  117.   begin
  118.   wavehdr[6]:=strtoint(combobox1.text);
  119.   wavehdr[7]:=strtoint(combobox1.text);
  120.   dn:=0;
  121.   counter:=0;
  122.   sspointer:=0;
  123.   xp:=2048;
  124.   cippo2:=2048;
  125.   cippo3:=2048;
  126.   ssvalue:=16;
  127.   assignfile(fi,opendialog1.filename);
  128.   reset(fi,1);
  129.   assignfile(fo,changefileext(opendialog1.filename,'.wav'));
  130.   rewrite(fo,1);
  131.   lettitot:=0;
  132.   blockwrite(fo,wavehdr,sizeof(wavehdr)); { scrivo header wav }
  133.     repeat
  134.     blockread(fi,inbuffer,200,letti);
  135.     inc(lettitot,letti*2);
  136.     for counter:=0 to ((letti*2)-1)  do
  137.       begin
  138.       if (counter mod 2) = 0 then
  139.         sample:=inbuffer[counter div 2] and $f0 div 16
  140.                              else
  141.         sample:=inbuffer[counter div 2] and $f;
  142.  
  143.       dn := (ssvalue*((sample and $4) div 4))+((ssvalue div 2)*((sample and $2) div 2))
  144.              +((ssvalue div 4)*(sample and $1))+ (ssvalue div 8);
  145.  
  146.       inc(sspointer,MLN[sample and $7]);
  147.       if sspointer<0 then sspointer:=0;
  148.       if sspointer>48 then sspointer:=48;
  149.       ssvalue:=ss[sspointer];
  150.  
  151.       if (sample and $8) = 8 then dn:=-dn;
  152.       cippo:=xp+dn;
  153.       if cippo>4095 then cippo:=4095;
  154.       if cippo<0 then cippo:=0;
  155.       if cippo2<cippo then cippo2:=cippo;
  156.       if cippo3>cippo then cippo3:=cippo;
  157.  
  158.       outbuffer[counter]:=byte(cippo div 16);
  159.       xp:=cippo {xp+dn};
  160.       end;
  161.       blockwrite(fo,outbuffer,letti*2); { scrivo header wav }
  162.     until letti<>200;
  163.   label1.caption:='Max value :'+inttostr(cippo2);
  164.   label2.caption:='Min value :'+inttostr(cippo3);
  165.   seek(fo,0);
  166.   wavehdr[1]:=lettitot+36;
  167.   wavehdr[10]:=lettitot;
  168.   blockwrite(fo,wavehdr,sizeof(wavehdr)); { scrivo header wav }
  169.   closefile(fi);
  170.   closefile(fo);
  171.   Showmessage(changefileext(opendialog1.filename,'.wav')+' was succesfully written!');
  172.   end;
  173. end;
  174.  
  175. procedure TForm1.Button2Click(Sender: TObject);
  176.  
  177. function adpcm( csig : integer) : byte;
  178. var
  179. diff,step: integer;
  180. encodedato : byte;
  181. begin
  182. step:=ss[sspointer];
  183. if (csig>4095) then csig:=4095;
  184. if (csig<0) then csig:=0;
  185. diff:=csig-Xp;
  186. if diff<0 then
  187.   begin
  188.   encodedato:=8;
  189.   diff:=-diff;
  190.   end     else encodedato:=0;
  191. if diff>=step then
  192.   begin
  193.   inc(encodedato,4);
  194.   dec(diff,step)
  195.   end;
  196. step:=step div 2;
  197. if diff>=step then
  198.   begin
  199.   inc(encodedato,2);
  200.   dec(diff,step)
  201.   end;
  202. step:=step div 2;
  203. if diff>=step then
  204.   inc(encodedato,1);
  205. step:=ss[sspointer];
  206. diff := ((step)*((encodedato and $4) div 4))+((step div 2)*((encodedato and $2) div 2))
  207.             +((step div 4)*(encodedato and $1))+ (step div 8);
  208. if (encodedato and $8) = 8 then diff:=-diff;
  209. inc(sspointer,MLN[encodedato and $7]);
  210. if sspointer<0 then sspointer:=0;
  211. if sspointer>48 then sspointer:=48;
  212. xp:=xp+diff;
  213. adpcm:=encodedato;
  214. end;
  215.  
  216.  
  217.  
  218. var
  219. fi: file;
  220. fo: file;
  221. datolong,length: longint;
  222. datoword: word;
  223. valid: boolean;
  224. formato: integer;
  225. offset: integer;
  226. encoded : byte;
  227. begin
  228. opendialog1.filterindex:=1;
  229. sspointer:=0;
  230. xp:=2048;
  231. if opendialog1.execute then
  232.   begin
  233.   assignfile(fi,opendialog1.filename);
  234.   reset(fi,1);
  235.   if ioresult=0 then
  236.     begin
  237.     valid:=true;
  238.     blockread(fi,datolong,4);
  239.     if datolong<>$46464952 then valid:=false;  { 'RIFF'}
  240.     blockread(fi,datolong,4);
  241.     blockread(fi,datolong,4);
  242.     if datolong<>$45564157 then valid:=false;   {'WAVE'}
  243.     blockread(fi,datolong,4);
  244.     if datolong<>$20746d66 then valid:=false;   {'fmt '}
  245.  
  246.     blockread(fi,datolong,4);
  247.     blockread(fi,datoword,2);
  248.     formato:=datoword;
  249.     length:=datolong;
  250.     if not (((length=16) and (formato=1))  or
  251.             ((length=20) and (formato=16)) or
  252.             ((length=18) and (formato=6))  or
  253.             ((length=18) and (formato=7))) then valid:=false;
  254.     if not ((formato=16) or (formato=1)) then valid:=false;
  255.  
  256.     blockread(fi,datoword,2);
  257.     if datoword<>1 then valid:=false;
  258.     blockread(fi,datolong,4);
  259.     if (datolong<>6000) and (datolong<>8000) then
  260.       if MessageDlg('Sample rate in .wav file is not 6000 or 8000 should i convert anyway?',
  261.            mtconfirmation, [mbYes, mbNo], 0) = mrno then valid:=false;
  262.     blockread(fi,inbuffer,word(length-8));
  263.     blockread(fi,datolong,4);
  264.     if datolong<>$61746164 then valid:=false;   {'data'}
  265.     blockread(fi,datolong,4);
  266.     if valid then
  267.       begin
  268.       assignfile(fo,changefileext(opendialog1.filename,'.vox'));
  269.       rewrite(fo,1);
  270.       if ioresult=0 then
  271.         begin
  272.         length:=1000;
  273.         while length=1000 do
  274.           begin
  275.           blockread(fi,inbuffer,1000,integer(length));
  276.           for offset:=0 to ((length div 2)-1) do
  277.             begin
  278.             encoded:=byte(adpcm(inbuffer[offset*2]*16))*16;
  279.             inc(encoded,byte(adpcm(inbuffer[offset*2+1]*16)));
  280.             outbuffer[offset]:=encoded;
  281.             end;
  282.           blockwrite(fo,outbuffer,length div 2);
  283.           end;
  284.         closefile(fo);
  285.         Showmessage(changefileext(opendialog1.filename,'.vox')+' was succesfully written!');
  286.         end;
  287.       end else showmessage('File is not valid for conversion (must be PCM 8 bit mono to be converted)');
  288.     closefile(fi);
  289.     end;
  290.   end;
  291. end;
  292.  
  293.  
  294. procedure TForm1.BitBtn3Click(Sender: TObject);
  295. begin
  296. form2.show;
  297. end;
  298.  
  299. end.
  300.