| Autor |
Beitrag |
Matthias-K
 
Beiträge: 271
Win95, Win98, Win2000, WinXP, Linux
D2, D4 Client/Server, D5 Enterprise, D6 Enterprise, D7 Enterprise, Delphi2005, C/C++ 3.0, C/C ++ 5.0, C/C++ 6.0
|
Verfasst: Mi 19.10.05 14:59
hi leutz,
ich habe jetzt bissle rumgespielt mit wav dateien.
nur habe ich ein problem:
und zwar wie kann ich bei einer bestehenen wav datei die bitrate ändern? weil die datei, die ich erzeugt habe, (mit directss) hat 178 kBit/s aber ich brauche dateien mit 128 kBit/s.
die nachfolgede funktion kann ja sounds aufnehmen und mit der erforderlichen konfiguration abspeichern.
wie kann ich das bei einer bestehenden wav datei machen?
  Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
| procedure TForm1.Button1Click(Sender: TObject); begin
mciSendString('OPEN NEW TYPE WAVEAUDIO ALIAS mysound', nil, 0, handle);
mciSendString('SET mysound TIME FORMAT MS '+ 'BITSPERSAMPLE 8 '+ 'CHANNELS 2 '+ 'SAMPLESPERSEC 8000 '+ 'BYTESPERSEC 8000', nil, 0, handle);
mciSendString('RECORD mysound', nil, 0, handle)
end;
procedure TForm1.Button2Click(Sender: TObject); begin
mciSendString('STOP mysound', nil, 0, handle)
end;
procedure TForm1.Button3Click(Sender: TObject); var verz: string;
begin
GetDir(0, verz);
mciSendString(PChar('SAVE mysound ' + verz + '/test.wav'), nil, 0, handle);
mciSendString('CLOSE mysound', nil, 0, handle)
end; |
Moderiert von  Gausi: Code- durch Delphi-Tags ersetzt_________________ Ein Spezialist ist ein Mensch, der immer mehr von immer weniger weis, bis er alles von nichts weis!
|
|
digi_c
Beiträge: 1905
W98, XP
D7 PE, Lazarus, WinAVR
|
Verfasst: Mi 19.10.05 18:20
Die muss durch auch Streamtechnisch durchlaufen werden und in einen neuen mit dieser Bitrate eingerichteten Stream gespeichert werden, täte ich als Laie mal vermuten 
|
|
Matthias-K 
Beiträge: 271
Win95, Win98, Win2000, WinXP, Linux
D2, D4 Client/Server, D5 Enterprise, D6 Enterprise, D7 Enterprise, Delphi2005, C/C++ 3.0, C/C ++ 5.0, C/C++ 6.0
|
Verfasst: Do 20.10.05 14:15
ja, als laie! *ggg*
aber würde das auch so gehen?
und wenn ja, bleibt noch zu klären, wie!
matthias
_________________ Ein Spezialist ist ein Mensch, der immer mehr von immer weniger weis, bis er alles von nichts weis!
|
|
Sinspin
Beiträge: 1340
Erhaltene Danke: 120
Win 10
RIO, CE, Lazarus
|
Verfasst: Do 20.10.05 14:39
was hältst du davon den sound erst einmal einfach abzuspielen und dabei mit einer anderen samplingrate wieder aufzunehmen?
die lösung ist nicht schön da du den sound in "echtzeit" umwandelst. also ihn anhörst und dabei aufnimmst.
ansonsten müsstest du ihn irgendwie umsampeln, wie es mit einem soundeditor alis goldwave oder wavelab geht.
bedenke aber das eine umwandlung sich immer auf die qualität auswirkt egal wie du das es am ende anstellst.
|
|
Matthias-K
Beiträge: 271
Win95, Win98, Win2000, WinXP, Linux
D2, D4 Client/Server, D5 Enterprise, D6 Enterprise, D7 Enterprise, Delphi2005, C/C++ 3.0, C/C ++ 5.0, C/C++ 6.0
|
Verfasst: Fr 21.10.05 09:06
dabvei ist nur ein kleines problem:
der sound hat eine varaible länge, und das programm ist eine automation!
und ein externes programm kommt also nicht in frage!
gibt es noch andere optionen, die ich habe?
matthias
_________________ Ein Spezialist ist ein Mensch, der immer mehr von immer weniger weis, bis er alles von nichts weis!
|
|
Waldheini
Beiträge: 32
Win 98SE, XP
D5 St., K3 Prof
|
Verfasst: So 30.10.05 17:45
Vieleicht hilft Dir diese Komponente ein wenig weiter (ich hoffe, sie ist nicht zu lang):
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
517:
518:
519:
520:
521:
522:
523:
524:
525:
526:
527:
528:
529:
530:
531:
532:
533:
534:
535:
536:
537:
538:
539:
540:
541:
542:
543:
544:
545:
546:
547:
548:
549:
550:
551:
552:
553:
554:
555:
556:
557:
558:
559:
560:
561:
562:
563:
564:
565:
566:
567:
568:
569:
570:
571:
572:
573:
574:
575:
576:
577:
578:
579:
580:
581:
582:
583:
584:
585:
586:
587:
588:
589:
590:
591:
592:
593:
594:
595:
596:
597:
598:
599:
600:
601:
602:
603:
604:
605:
606:
607:
608:
609:
610:
611:
612:
613:
614:
615:
616:
617:
618:
619:
620:
621:
622:
623:
624:
625:
626:
627:
628:
629:
630:
631:
632:
633:
634:
635:
636:
637:
638:
639:
640:
641:
642:
643:
644:
645:
646:
647:
648:
649:
650:
651:
652:
653:
654:
655:
656:
657:
658:
659:
660:
661:
662:
663:
664:
665:
666:
667:
668:
669:
670:
671:
672:
673:
674:
675:
676:
677:
678:
679:
680:
681:
682:
683:
684:
685:
686:
687:
688:
689:
690:
691:
692:
693:
694:
695:
696:
697:
698:
699:
700:
701:
702:
703:
704:
705:
706:
707:
708:
709:
710:
711:
712:
713:
714:
715:
716:
717:
718:
719:
720:
721:
722:
723:
724:
725:
726:
727:
728:
729:
730:
731:
732:
733:
734:
735:
736:
737:
738:
739:
740:
741:
742:
743:
744:
745:
746:
747:
748:
749:
750:
751:
752:
753:
754:
755:
756:
757:
758:
759:
760:
761:
762:
763:
764:
765:
766:
767:
768:
769:
770:
771:
772:
773:
774:
775:
776:
777:
778:
779:
780:
781:
782:
783:
784:
785:
786:
787:
788:
789:
790:
791:
792:
793:
794:
795:
796:
797:
798:
799:
800:
801:
802:
803:
804:
805:
806:
807:
808:
809:
810:
811:
812:
813:
814:
815:
816:
817:
818:
819:
820:
821:
822:
823:
824:
825:
826:
827:
828:
829:
830:
831:
832:
833:
834:
835:
836:
837:
838:
839:
840:
841:
842:
843:
844:
845:
846:
847:
848:
849:
850:
851:
852:
853:
854:
855:
856:
857:
858:
859:
860:
861:
862:
863:
864:
865:
866:
867:
868:
869:
870:
871:
872:
873:
874:
875:
876:
877:
878:
879:
880:
881:
882:
883:
884:
885:
886:
887:
888:
889:
890:
891:
892:
893:
894:
895:
896:
897:
898:
899:
900:
901:
902:
903:
904:
905:
906:
907:
908:
909:
910:
911:
912:
913:
914:
915:
916:
917:
918:
919:
920:
921:
922:
923:
924:
925:
926:
927:
928:
929:
930:
931:
932:
933:
934:
935:
936:
937:
938:
939:
940:
941:
942:
943:
944:
945:
946:
947:
948:
949:
950:
951:
952:
953:
954:
955:
956:
957:
958:
959:
960:
961:
962:
963:
964:
965:
966:
967:
968:
969:
970:
971:
972:
973:
974:
975:
976:
977:
978:
979:
980:
981:
982:
983:
984:
985:
986:
987:
988:
989:
990:
991:
992:
993:
994:
995:
996:
997:
998:
999:
1000:
1001:
1002:
1003:
1004:
1005:
1006:
1007:
1008:
1009:
1010:
1011:
1012:
1013:
1014:
1015:
1016:
1017:
1018:
1019:
1020:
1021:
1022:
1023:
1024:
1025:
1026:
1027:
1028:
1029:
1030:
1031:
1032:
1033:
1034:
1035:
1036:
1037:
1038:
1039:
1040:
1041:
1042:
1043:
1044:
1045:
1046:
1047:
1048:
1049:
1050:
1051:
1052:
1053:
1054:
1055:
1056:
1057:
1058:
1059:
1060:
1061:
1062:
1063:
1064:
1065:
1066:
1067:
1068:
1069:
1070:
1071:
1072:
1073:
1074:
1075:
1076:
1077:
1078:
1079:
1080:
1081:
1082:
1083:
1084:
1085:
1086:
1087:
1088:
1089:
1090:
1091:
1092:
1093:
1094:
1095:
1096:
1097:
1098:
1099:
1100:
1101:
1102:
1103:
1104:
1105:
1106:
1107:
1108:
1109:
1110:
1111:
1112:
1113:
1114:
1115:
1116:
1117:
1118:
1119:
1120:
1121:
1122:
1123:
1124:
1125:
1126:
1127:
1128:
1129:
1130:
1131:
1132:
1133:
1134:
1135:
1136:
1137:
1138:
1139:
1140:
1141:
1142:
1143:
1144:
1145:
1146:
1147:
1148:
1149:
1150:
1151:
1152:
1153:
1154:
1155:
1156:
1157:
1158:
1159:
1160:
1161:
1162:
1163:
1164:
1165:
1166:
1167:
1168:
1169:
1170:
1171:
1172:
1173:
1174:
1175:
1176:
1177:
1178:
1179:
1180:
1181:
1182:
1183:
1184:
1185:
1186:
1187:
1188:
1189:
1190:
1191:
1192:
1193:
1194:
1195:
1196:
1197:
1198:
1199:
1200:
1201:
1202:
1203:
1204:
1205:
1206:
1207:
1208:
1209:
1210:
1211:
1212:
1213:
1214:
1215:
1216:
1217:
1218:
1219:
1220:
1221:
1222:
1223:
1224:
1225:
1226:
1227:
1228:
1229:
1230:
1231:
1232:
1233:
1234:
1235:
1236:
1237:
1238:
1239:
1240:
1241:
1242:
1243:
1244:
1245:
1246:
1247:
1248:
1249:
1250:
1251:
1252:
1253:
1254:
1255:
1256:
1257:
1258:
1259:
1260:
1261:
1262:
1263:
1264:
1265:
1266:
1267:
1268:
1269:
1270:
1271:
1272:
1273:
1274:
1275:
1276:
1277:
1278:
1279:
1280:
1281:
1282:
1283:
1284:
1285:
1286:
1287:
1288:
1289:
1290:
1291:
1292:
1293:
1294:
1295:
1296:
1297:
1298:
1299:
1300:
1301:
1302:
1303:
1304:
1305:
1306:
1307:
1308:
1309:
1310:
1311:
1312:
1313:
1314:
1315:
1316:
1317:
1318:
1319:
1320:
1321:
1322:
1323:
1324:
1325:
1326:
1327:
1328:
1329:
1330:
1331:
1332:
1333:
1334:
1335:
1336:
1337:
1338:
1339:
1340:
1341:
1342:
1343:
1344:
1345:
1346:
1347:
1348:
1349:
1350:
1351:
1352:
1353:
1354:
1355:
1356:
1357:
1358:
1359:
1360:
1361:
1362:
1363:
1364:
1365:
1366:
1367:
1368:
1369:
1370:
1371:
1372:
1373:
1374:
1375:
1376:
1377:
1378:
1379:
1380:
1381:
1382:
1383:
1384:
1385:
1386:
1387:
1388:
1389:
1390:
1391:
1392:
1393:
1394:
1395:
1396:
1397:
1398:
1399:
1400:
1401:
1402:
1403:
1404:
1405:
1406:
1407:
1408:
1409:
1410:
1411:
1412:
1413:
1414:
1415:
1416:
1417:
1418:
1419:
1420:
1421:
1422:
1423:
1424:
1425:
1426:
1427:
1428:
1429:
1430:
1431:
1432:
1433:
1434:
1435:
1436:
1437:
1438:
1439:
1440:
1441:
1442:
1443:
1444:
1445:
1446:
1447:
1448:
1449:
1450:
1451:
1452:
1453:
1454:
1455:
1456:
1457:
1458:
1459:
1460:
1461:
1462:
1463:
1464:
1465:
1466:
1467:
1468:
1469:
1470:
1471:
1472:
1473:
1474:
1475:
1476:
1477:
1478:
1479:
1480:
1481:
1482:
1483:
1484:
1485:
1486:
1487:
1488:
1489:
1490:
1491:
1492:
1493:
1494:
1495:
1496:
1497:
1498:
1499:
1500:
1501:
1502:
1503:
1504:
1505:
1506:
1507:
1508:
1509:
1510:
1511:
1512:
1513:
1514:
1515:
1516:
1517:
1518:
1519:
1520:
1521:
1522:
1523:
1524:
1525:
1526:
1527:
| unit Wave;
interface
uses SysUtils , classes , dialogs;
const
NoError = 0;
FileNotFound = 1;
FileError = 2;
NoRiffFile = 3;
NoWaveFile = 4;
NoFileData = 5;
Nofmt_ID = 6;
BadFormat = 7;
NoMem = 8;
NoData = 9;
BadIndex = 10;
BadSize = 11;
Errors = 12;
ErrorMessage: Array [0..Errors-1] of String =
('Kein Fehler aufgetreten!',
'Die Datei konnte nicht gefunden werden!',
'Fehlerhafter Dateizugriff!',
'Die Datei enthält keine RIFF-Kennung!',
'Die Datei enthält keine WAVE-Kennung!',
'Die Datei enthält keine data-Kennung!',
'Die Datei enthält keinen Format-Tag!',
'Das Wave-Format ist ungültig!',
'Es ist kein freier Speicher verfügbar!',
'Das Wave-Format enthält keine Daten!',
'Der Index überschreitet die Anzahl der vorhandenen Elemente!',
'Die Puffergröße überschreitet die Anzahl der vorhandenen Elemente!');
RIFF = $46464952;
WAVEID = $45564157;
fmt = $20746D66;
data = $61746164;
type
tPorcedure = procedure of Object;
TWaveFormat = (wfNone,PCM);
tBitPerCannel = (bpcNone,bpc8Bit,bpc16Bit);
tBytePerSample = (bpsNone,bps1Byte,bps2Byte,bps4Byte);
tCannels = (None,Mono,Stereo);
TWaveSample = Record
Left: SmallInt;
Right: SmallInt;
end;
tSampleBuffer = Array[1..1]of TWaveSample;
pSampleBuffer = ^tSampleBuffer;
TWaveFileHead = Packed Record
RIFF_ID: Cardinal; FileSize: Cardinal; WAVE_ID: Cardinal; end;
TWaveFormatTag = Packed Record
fmt_ID: Cardinal; TagSize: Cardinal; WaveFormat: Word; Cannels: Word; SamplePerSec: Cardinal; BufferSize: Cardinal; BytePerSample: Word; BitPerCannel: Word; end;
type TWave = class(tComponent)
private
WaveFileHead: TWaveFileHead;
WaveFormatTag: TWaveFormatTag;
OldWaveFormatTag: TWaveFormatTag;
SampleBuffer: pSampleBuffer;
SampleAdd: Single;
AE: Boolean;
LE: Integer;
CT: Cardinal;
SE: Cardinal;
MX: Boolean;
OC: TNotifyEvent;
OE: TPorcedure;
SR: tObject;
function GetError: String;
procedure OCDummy(Sender: tObject);
procedure OEDummy;
procedure SetAE;
function GeTWaveFormat: TWaveFormat;
procedure SeTWaveFormat(WaveFormat: TWaveFormat);
function GetCannels: tCannels;
procedure SetCannels(Cannels: tCannels);
function GetBytes: tBytePerSample;
procedure SetBytes(BytePerSample: tBytePerSample);
function GetBits: tBitPerCannel;
procedure SetBits(BitPerCannel: tBitPerCannel);
function GetSamples: Cardinal;
procedure SetSamples(SamplesPerSec: Cardinal);
function ReadFormat(var Datei: File; var WaveFileHead: TWaveFileHead;
var WaveFormatTag: TWaveFormatTag;
var DataSize: Cardinal): Boolean;
function ReadData(var Datei: File; WaveFormatTag: TWaveFormatTag;
Size: Cardinal; var SampleBuffer: pSampleBuffer):
Boolean;
function SetNewSampleRate(var Buffer: pSampleBuffer;OldRate: Cardinal;
NewRate: Cardinal):Boolean;
function GetSample(Index: Cardinal): TWaveSample;
procedure SetSample(Index: Cardinal; Sample: TWaveSample);
function MixSample(Sample1,Sample2: TWaveSample): TWaveSample;
public
property LastError: Integer Read LE default 0;
property Error: String Read GetError;
property Count: Cardinal Read CT
default 0;
property Changed: Boolean Read AE
default false;
property Sec: Cardinal Read SE
default 0;
property Sample[Index: Cardinal]: TWaveSample Read GetSample
Write SetSample;
constructor Create(AOwner: tComponent); override;
destructor Destroy; override;
function LoadFromFile(FileName: String): Boolean;
function SaveToFile(FileName: String): Boolean;
function GetSampleBuffer(var Buffer: Array of TWaveSample;Size: Cardinal;
Pos: Cardinal): Boolean;
function SetSampleBuffer(var Buffer: Array of TWaveSample; Size: Cardinal;
Pos: Cardinal): Boolean;
published
property WaveFormat: TWaveFormat Read GeTWaveFormat Write SeTWaveFormat
default PCM;
property Cannals: tCannels Read GetCannels Write SetCannels
default None;
property BytePerSample: tBytePerSample Read GetBytes Write SetBytes
default bpsNone;
property BitPerCannel: tBitPerCannel Read GetBits Write SetBits
default bpcNone;
property SamplesPerSec: Cardinal Read GetSamples Write SetSamples
default 0;
property Mix: Boolean Read MX Write MX
default false;
property OnChange: TNotifyEvent Read OC Write OC;
property OnError: TPorcedure Read OE Write OE;
end;
procedure Register;
implementation
function TWave.GetError: String;
begin
Result:= ErrorMessage[LE];
end;
procedure TWave.OCDummy(Sender: tObject);
begin
exit;
end;
procedure TWave.OEDummy;
begin
exit;
end;
procedure TWave.SetAE;
var Pos: Cardinal;
begin
AE:= true;
If CT > 0 then
begin
If OldWaveFormatTag.Cannels <> WaveFormatTag.Cannels then
begin
Case WaveFormatTag.Cannels of
1: begin
For Pos:= 1 to CT do
begin
SampleBuffer^[Pos].Left:= (SampleBuffer^[Pos].Left +
SampleBuffer^[Pos].Right)
div 2;
SampleBuffer^[Pos].Right:= SampleBuffer^[Pos].Left;
end;
LE:= NoError;
end;
2: begin
For Pos:= 1 to CT do
SampleBuffer^[Pos].Right:= SampleBuffer^[Pos].Left;
LE:= NoError;
end;
else
begin
LE:= BadFormat;
OnError;
end;
end;
end;
If OldWaveFormatTag.BitPerCannel <> WaveFormatTag.BitPerCannel then
begin
Case WaveFormatTag.BitPerCannel of
8: LE:= NoError;
16: LE:= NoError;
else
begin
LE:= BadFormat;
OnError;
end;
end;
end;
If OldWaveFormatTag.SamplePerSec <> WaveFormatTag.SamplePerSec then
begin
If Not SetNewSampleRate(SampleBuffer,
OldWaveFormatTag.SamplePerSec,
WaveFormatTag.SamplePerSec) then
begin
OnError;
exit;
end;
end;
end;
OldWaveFormatTag:= WaveFormatTag;
OnChange(SR);
end;
function TWave.GetWaveFormat: TWaveFormat;
begin
Case WaveFormatTag.WaveFormat of
1: Result:= PCM;
else
Result:= wfNone;
end;
end;
procedure TWave.SetWaveFormat(WaveFormat: TWaveFormat);
begin
OldWaveFormatTag:= WaveFormatTag;
Case WaveFormat of
PCM: WaveFormatTag.WaveFormat:= 1;
else
WaveFormatTag.WaveFormat:= 0;
end;
SetAE;
end;
function TWave.GetCannels: tCannels;
begin
Case WaveFormatTag.Cannels of
1: Result:= Mono;
2: Result:= Stereo;
else
Result:= None;
end;
end;
procedure TWave.SetCannels(Cannels: tCannels);
begin
OldWaveFormatTag:= WaveFormatTag;
Case Cannels of
None: WaveFormatTag.Cannels:= 0;
Mono: WaveFormatTag.Cannels:= 1;
Stereo: WaveFormatTag.Cannels:= 2;
else
WaveFormatTag.Cannels:= 0;
end;
WaveFormatTag.BytePerSample:= WaveFormatTag.Cannels
*(WaveFormatTag.BitPerCannel shr 3);
WaveFormatTag.BufferSize:= WaveFormatTag.BytePerSample
* WaveFormatTag.SamplePerSec;
SetAE;
end;
function TWave.GetBytes: tBytePerSample;
begin
Case WaveFormatTag.BytePerSample of
0: Result:= bpsNone;
1: Result:= bps1Byte;
2: Result:= bps2Byte;
4: Result:= bps4Byte;
else
Result:= bpsNone;
end;
end;
procedure TWave.SetBytes(BytePerSample: tBytePerSample);
begin
OldWaveFormatTag:= WaveFormatTag;
Case BytePerSample of
bpsNone: WaveFormatTag.BytePerSample:= 0;
bps1Byte: WaveFormatTag.BytePerSample:= 1;
bps2Byte: WaveFormatTag.BytePerSample:= 2;
bps4Byte: WaveFormatTag.BytePerSample:= 4;
else
WaveFormatTag.BytePerSample:= 0;
end;
If (WaveFormatTag.BytePerSample = 1) then
begin
WaveFormatTag.BitPerCannel:= 8;
WaveFormatTag.Cannels:= 1;
end
else If (WaveFormatTag.BytePerSample = 2) and (WaveFormatTag.Cannels = 1) then
begin
WaveFormatTag.BitPerCannel:= 16;
end
else If (WaveFormatTag.BytePerSample = 2) and (WaveFormatTag.Cannels = 2) then
begin
WaveFormatTag.BitPerCannel:= 8;
end
else If (WaveFormatTag.BytePerSample = 4) and (WaveFormatTag.Cannels = 2) then
begin
WaveFormatTag.BitPerCannel:= 16;
end
else If (WaveFormatTag.BytePerSample = 4) and (WaveFormatTag.Cannels = 1) then
begin
WaveFormatTag.BitPerCannel:= 16;
WaveFormatTag.Cannels:= 2;
end;
WaveFormatTag.BufferSize:= WaveFormatTag.BytePerSample
* WaveFormatTag.SamplePerSec;
SetAE;
end;
function TWave.GetBits: tBitPerCannel;
begin
Case WaveFormatTag.BitPerCannel of
0: Result:= bpcNone;
8: Result:= bpc8Bit;
16: Result:= bpc16Bit;
else
Result:= bpcNone;
end;
end;
procedure TWave.SetBits(BitPerCannel: tBitPerCannel);
begin
OldWaveFormatTag:= WaveFormatTag;
Case BitPerCannel of
bpcNone: WaveFormatTag.BitPerCannel:= 0;
bpc8Bit: WaveFormatTag.BitPerCannel:= 8;
bpc16Bit: WaveFormatTag.BitPerCannel:= 16;
else
WaveFormatTag.BitPerCannel:= 0;
end;
WaveFormatTag.BytePerSample:= WaveFormatTag.Cannels
*(WaveFormatTag.BitPerCannel shr 3);
WaveFormatTag.BufferSize:= WaveFormatTag.BytePerSample
* WaveFormatTag.SamplePerSec;
SetAE;
end;
function TWave.GetSamples: Cardinal;
begin
Result:= WaveFormatTag.SamplePerSec;
end;
procedure TWave.SetSamples(SamplesPerSec: Cardinal);
begin
OldWaveFormatTag:= WaveFormatTag;
WaveFormatTag.SamplePerSec:= SamplesPerSec;
WaveFormatTag.BufferSize:= SamplesPerSec * WaveFormatTag.BytePerSample;
SampleAdd:= 96000/WaveFormatTag.SamplePerSec;
SetAE;
end;
function TWave.ReadFormat(var Datei: File;
var WaveFileHead: TWaveFileHead;
var WaveFormatTag: TWaveFormatTag;
var DataSize: Cardinal): Boolean;
type tBlockHead = Packed Record
fcc: Cardinal;
Size: Cardinal;
end;
var DateiPos,Anzahl,DateiGroesse: LongInt;
BlockHead: tBlockHead;
Label Wiederholen;
begin
DateiGroesse:= FileSize(Datei);
If DateiGroesse-FilePos(Datei) < SizeOf(WaveFileHead) then
begin
Result:= false;
LE:= FileError;
exit;
end;
BlockRead(Datei,WaveFileHead,SizeOf(WaveFileHead),Anzahl);
If Anzahl <> SizeOf(WaveFileHead) then
begin
Result:= false;
LE:= FileError;
exit;
end;
With WaveFileHead do
begin
If RIFF_ID <> RIFF then
LE:= NoRiffFile
Else If FileSize = 0 then
LE:= NoFileData
Else If WAVE_ID <> WAVEID then
LE:= NoWaveFile;
end;
If LE <> NoError then
begin
Result:= false;
exit;
end;
DateiPos:= FilePos(Datei);
If DateiGroesse-DateiPos < SizeOf(WaveFormatTag) then
begin
Result:= false;
LE:= FileError;
exit;
end;
BlockRead(Datei,WaveFormatTag,SizeOf(WaveFormatTag),Anzahl);
If Anzahl <> SizeOf(WaveFormatTag) then
begin
Result:= false;
LE:= FileError;
exit;
end;
If WaveFormatTag.fmt_ID <> fmt then
LE:= Nofmt_ID;
Seek(Datei,DateiPos+8+LongInt(WaveFormatTag.TagSize));
Wiederholen:
If DateiGroesse-FilePos(Datei) < SizeOf(BlockHead) then
begin
Result:= false;
LE:= FileError;
exit;
end;
BlockRead(Datei,BlockHead,SizeOf(BlockHead),Anzahl);
DateiPos:= FilePos(Datei);
If Anzahl <> SizeOf(BlockHead) then
begin
Result:= false;
LE:= FileError;
exit;
end;
If BlockHead.fcc <> data then
begin
Seek(Datei,DateiPos+LongInt(BlockHead.Size));
If Not EOF(Datei) then
begin
goto Wiederholen;
end
else
begin
Result:= false;
LE:= FileError;
exit;
end;
end;
DataSize:= BlockHead.Size;
Result:= true;
end;
function TWave.ReadData(var Datei: File;
WaveFormatTag: TWaveFormatTag; Size: Cardinal;
var SampleBuffer: pSampleBuffer): Boolean;
type
tSmallIntBuffer = Array[1..1]of SmallInt;
pSmallIntBuffer = ^tSmallIntBuffer;
tShortIntBuffer = Array[1..1]of ShortInt;
pShortIntBuffer = ^tShortIntBuffer;
var
ShortBuffer: pShortIntBuffer;
SmallBuffer: pSmallIntBuffer;
Anzahl: LongInt;
Pos: Cardinal;
begin
If Size = 0 then
begin
Result:= true;
CT:= 0;
exit;
end;
If FileSize(Datei)-FilePos(Datei) < LongInt(Size) then
begin
Result:= false;
LE:= FileError;
exit;
end;
Case WaveFormatTag.BitPerCannel of
8: begin
If (WaveFormatTag.Cannels = 1)
and (WaveFormatTag.BytePerSample = 1) then
begin
Try GetMem(ShortBuffer,Size);
except
Result:= false;
LE:= NoMem;
exit;
end;
BlockRead(Datei,ShortBuffer,Size,Anzahl);
If Anzahl <> LongInt(Size) then
begin
Result:= false;
LE:= FileError;
FreeMem(ShortBuffer);
exit;
end;
CT:= Size;
If SampleBuffer = Nil then
Try GetMem(SampleBuffer,CT*SizeOf(TWaveSample));
except
FreeMem(ShortBuffer);
Result:= false;
LE:= NoMem;
exit;
end
else
Try ReallocMem(SampleBuffer,CT*SizeOf(TWaveSample));
except
FreeMem(ShortBuffer);
Result:= false;
LE:= NoMem;
exit;
end;
For Pos:= 1 to CT do
begin
SampleBuffer^[Pos].Left:= ShortBuffer^[Pos]*256;
SampleBuffer^[Pos].Right:= ShortBuffer^[Pos]*256;
end;
FreeMem(ShortBuffer,Size);
Result:= true;
end
else If (WaveFormatTag.Cannels = 2)
and (WaveFormatTag.BytePerSample = 2) then
begin
Try GetMem(ShortBuffer,Size);
except
Result:= false;
LE:= NoMem;
exit;
end;
BlockRead(Datei,ShortBuffer,Size,Anzahl);
If Anzahl <> LongInt(Size) then
begin
Result:= false;
LE:= FileError;
FreeMem(ShortBuffer);
exit;
end;
CT:= Size div 2;
If SampleBuffer = Nil then
Try GetMem(SampleBuffer,CT*SizeOf(TWaveSample));
except
FreeMem(ShortBuffer);
Result:= false;
LE:= NoMem;
exit;
end
else
Try ReallocMem(SampleBuffer,CT*SizeOf(TWaveSample));
except
FreeMem(ShortBuffer);
Result:= false;
LE:= NoMem;
exit;
end;
For Pos:= 1 to CT do
begin
SampleBuffer^[Pos].Left:= ShortBuffer^[(Pos*2)-1]*256;
SampleBuffer^[Pos].Right:= ShortBuffer^[Pos*2]*256;
end;
FreeMem(ShortBuffer,Size);
Result:= true;
end
else
begin
Result:= false;
LE:= BadFormat;
end;
end;
16: begin
If (WaveFormatTag.Cannels = 1)
and (WaveFormatTag.BytePerSample = 2) then
begin
Try GetMem(SmallBuffer,Size);
except
Result:= false;
LE:= NoMem;
exit;
end;
BlockRead(Datei,SmallBuffer^,Size,Anzahl);
If Anzahl <> LongInt(Size) then
begin
FreeMem(SmallBuffer);
Result:= false;
LE:= FileError;
exit;
end;
CT:= Size div 2;
If SampleBuffer = Nil then
Try GetMem(SampleBuffer,CT*SizeOf(TWaveSample));
except
FreeMem(SmallBuffer);
Result:= false;
LE:= NoMem;
exit;
end
else
Try ReallocMem(SampleBuffer,CT*SizeOf(TWaveSample));
except
FreeMem(SmallBuffer);
Result:= false;
LE:= NoMem;
exit;
end;
For Pos:= 1 to CT do
begin
SampleBuffer^[Pos].Left:= SmallBuffer^[Pos];
SampleBuffer^[Pos].Right:= SmallBuffer^[Pos];
end;
FreeMem(SmallBuffer);
Result:= true;
end
else If (WaveFormatTag.Cannels = 2)
and (WaveFormatTag.BytePerSample = 4) then
begin
Try GetMem(SmallBuffer,Size);
except
Result:= false;
LE:= NoMem;
exit;
end;
BlockRead(Datei,SmallBuffer^,Size,Anzahl);
If Anzahl <> LongInt(Size) then
begin
FreeMem(SmallBuffer);
Result:= false;
LE:= FileError;
exit;
end;
CT:= Size div 4;
If SampleBuffer = Nil then
Try GetMem(SampleBuffer,CT*SizeOf(TWaveSample));
except
FreeMem(SmallBuffer);
Result:= false;
LE:= NoMem;
exit;
end
else
Try ReallocMem(SampleBuffer,CT*SizeOf(TWaveSample));
except
FreeMem(SmallBuffer);
Result:= false;
LE:= NoMem;
exit;
end;
For Pos:= 1 to CT do
begin
SampleBuffer^[Pos].Left:= SmallBuffer^[(Pos*2)-1];
SampleBuffer^[Pos].Right:= SmallBuffer^[Pos*2];
end;
FreeMem(SmallBuffer);
Result:= true;
end
else
begin
Result:= false;
LE:= BadFormat;
exit;
end;
end;
else
begin
Result:= false;
LE:= BadFormat;
end;
end;
end;
function TWave.SetNewSampleRate(var Buffer: pSampleBuffer;
OldRate: Cardinal;
NewRate: Cardinal): Boolean;
var WorkBuffer: pSampleBuffer;
Divider,Komma: Single;
NewPos,NewCount,Pos,ZPos: Cardinal;
Left,Right,LeftAdd,RightAdd: Integer;
begin
If CT = 0 then
begin
Result:= true;
exit;
end;
If (OldRate = 0)
or (NewRate = 0) then
begin
Result:= false;
LE:= BadFormat;
exit;
end;
Divider:= OldRate/NewRate;
NewCount:= Trunc(CT/Divider);
Try GetMem(WorkBuffer,NewCount*SizeOf(TWaveSample));
except
Result:= false;
LE:= NoMem;
exit;
end;
Pos:= 1;
Komma:= 0;
If Divider < 1 then
begin
For NewPos:= 1 to NewCount do
begin
If (Komma = 0)
or (Pos = CT) then
begin
WorkBuffer^[NewPos]:= Buffer^[Pos];
end
else
begin
Left:= Buffer^[Pos+1].Left - Buffer^[Pos].Left;
Right:= Buffer^[Pos+1].Right - Buffer^[Pos].Right;
Left:= Trunc(Left*Komma);
Right:= Trunc(Right*Komma);
WorkBuffer^[NewPos].Left:= Buffer^[Pos].Left+Left;
WorkBuffer^[NewPos].Right:= Buffer^[Pos].Right+Right;
end;
Komma:= Komma+Divider;
Pos:= Pos + Trunc(Komma);
Komma:= Komma-Int(Komma);
If Pos > CT then
Pos:= CT;
end;
end
else
begin
For NewPos:= 1 to NewCount do
begin
If Pos = CT then
begin
WorkBuffer^[NewPos]:= Buffer^[Pos];
end
else
begin
If Komma = 0 then
begin
Left:= 0;
Right:= 0;
end
else
begin
Left:= Buffer^[Pos+1].Left - Buffer^[Pos].Left;
Right:= Buffer^[Pos+1].Right - Buffer^[Pos].Right;
Left:= Trunc(Left*Komma);
Right:= Trunc(Right*Komma);
end;
LeftAdd:= 0;
RightAdd:= 0;
For ZPos:= 1 to Trunc(Divider+Komma) do
begin
If Pos+ZPos > CT then
begin
LeftAdd:= LeftAdd+Buffer^[CT].Left;
RightAdd:= RightAdd+Buffer^[CT].Right;
end
else
begin
LeftAdd:= LeftAdd+Buffer^[Pos+ZPos].Left;
RightAdd:= RightAdd+Buffer^[Pos+ZPos].Right;
end;
end;
LeftAdd:= Trunc(Left+(LeftAdd/Int(Divider+Komma)));
RightAdd:= Trunc(Right+(RightAdd/Int(Divider+Komma)));
LeftAdd:= LeftAdd+Left;
RightAdd:= RightAdd+Right;
If Int(Divider+Komma) < Divider+Komma then
begin
If Int(Divider+Komma)+1+Pos > CT then
begin
Left:= 0;
Right:= 0;
end
else
begin
Left:= Buffer^[Trunc(Divider+Komma)+1+Pos].Left
- Buffer^[Trunc(Divider+Komma)+Pos].Left;
Right:= Buffer^[Trunc(Divider+Komma)+1+Pos].Right
- Buffer^[Trunc(Divider+Komma)+Pos].Right;
Left:= Trunc(Left*((Divider+Komma)
-Int(Divider+Komma)));
Right:= Trunc(Right*((Divider+Komma)
-Int(Divider+Komma)));
end;
end;
LeftAdd:= LeftAdd+Left;
RightAdd:= RightAdd+Right;
If LeftAdd > $7FFF then
LeftAdd:= $7FFF
else If LeftAdd < -$7FFF then
LeftAdd:= -$7FFF;
If RightAdd > $7FFF then
RightAdd:= $7FFF
else If RightAdd < -$7FFF then
RightAdd:= -$7FFF;
WorkBuffer^[NewPos].Left:= LeftAdd;
WorkBuffer^[NewPos].Right:= RightAdd;
end;
Komma:= Komma+Divider;
Pos:= Pos + Trunc(Komma);
Komma:= Komma-Int(Komma);
If Pos > CT then
Pos:= CT;
end;
end;
CT:= NewCount;
ReallocMem(Buffer,CT*SizeOf(TWaveSample));
For NewPos:= 1 to CT do
Buffer^[NewPos]:= WorkBuffer^[NewPos];
FreeMem(WorkBuffer);
Result:= true;
end;
function TWave.GetSample(Index: Cardinal): TWaveSample;
begin
If CT = 0 then
begin
LE:= NoData;
OnError;
end
else If Index > CT-1 then
begin
LE:= BadIndex;
OnError;
end
else
begin
LE:= NoError;
Result:= SampleBuffer^[Index+1];
end;
end;
procedure TWave.SetSample(Index: Cardinal; Sample: TWaveSample);
var Pos: Cardinal;
begin
If Index < CT then
begin
SampleBuffer^[Index]:= Sample;
LE:= NoError;
AE:= true;
OnChange(SR);
end
else
begin
Try ReallocMem(SampleBuffer,(Index+1)*SizeOf(TWaveSample));
except
LE:= NoMem;
OnError;
exit;
end;
If CT+1 > Index+1 then
begin
For Pos:= CT to Index+1 do
begin
SampleBuffer^[Pos].Left:= 0;
SampleBuffer^[Pos].Right:= 0;
end;
end;
CT:= Index+1;
SampleBuffer^[Index+1]:= Sample;
LE:= NoError;
AE:= true;
OnChange(SR);
end;
end;
function TWave.MixSample(Sample1,Sample2: TWaveSample): TWaveSample;
begin
If Sample1.Left + Sample2.Left > $7FFF then
Result.Left:= $7FFF
else if Sample1.Left + Sample2.Left < -$7FFF then
Result.Left:= -$7FFF
else
Result.Left:= Sample1.Left + Sample2.Left;
If Sample1.Right + Sample2.Right > $7FFF then
Result.Right:= $7FFF
else if Sample1.Right + Sample2.Right < -$7FFF then
Result.Right:= -$7FFF
else
Result.Right:= Sample1.Right + Sample2.Right;
end;
constructor TWave.Create(AOwner: tComponent);
begin
inherited Create(AOwner);
SR:= AOwner;
LE:= NoError;
AE:= false;
SampleBuffer:= Nil;
SampleAdd:= 20;
OnChange:= OCDummy;
OnError:= OEDummy;
With WaveFormatTag do
begin
WaveFormat:= 0;
Cannels:= 0;
SamplePerSec:= 0;
BufferSize:= 0;
BytePerSample:= 0;
BitPerCannel:= 0;
end;
end;
destructor TWave.Destroy;
begin
If SampleBuffer <> Nil then
FreeMem(SampleBuffer);
inherited;
end;
function TWave.LoadFromFile(FileName: String): Boolean;
var Datei: File;
DataSize: Cardinal;
begin
LE:= NoError;
If Not FileExists(FileName) then
begin
LE:= FileNotFound;
Result:= false;
OnError;
exit;
end;
AssignFile(Datei,FileName);
Reset(Datei,1);
Result:= ReadFormat(Datei,WaveFileHead,WaveFormatTag,DataSize);
If Result then
Result:= ReadData(Datei,WaveFormatTag,DataSize,SampleBuffer);
If Result then
begin
If WaveFormatTag.SamplePerSec = 0 then
begin
Result:= false;
LE:= BadFormat;
end
else
begin
SE:= CT div WaveFormatTag.SamplePerSec;
SampleAdd:= 96000 / SamplesPerSec;
end
end;
CloseFile(Datei);
AE:= False;
If Not Result then
OnError;
end;
function TWave.SaveToFile(FileName: String): Boolean;
type tBlockHead = Packed Record
fcc: Cardinal;
Size: Cardinal;
end;
tShortIntBuffer = Array[1..1]of ShortInt;
pShortIntBuffer = ^tShortIntBuffer;
tSmallIntBuffer = Array[1..1]of SmallInt;
pSmallIntBuffer = ^tSmallIntBuffer;
var Datei: File;
Anzahl: LongInt;
BlockHead: tBlockHead;
ShortBuffer: pShortIntBuffer;
SmallBuffer: pSmallIntBuffer;
Size,Pos: Cardinal;
begin
If Not (WaveFormatTag.Cannels in [1..2])
or (WaveFormatTag.SamplePerSec = 0)
or Not (WaveFormatTag.BytePerSample in [1..2,4])
or Not (WaveFormatTag.BitPerCannel in [8,16]) then
begin
Result:= false;
LE:= BadFormat;
OnError;
exit;
end;
WaveFileHead.RIFF_ID:= RIFF;
WaveFileHead.FileSize:= ( SizeOf(WaveFileHead)
+ SizeOf(WaveFormatTag)
+ (CT*WaveFormatTag.BytePerSample));
WaveFileHead.WAVE_ID:= WAVEID;
WaveFormatTag.fmt_ID:= fmt;
WaveFormatTag.TagSize:= SizeOf(WaveFormatTag)-8;
WaveFormatTag.WaveFormat:= 1;
WaveFormatTag.BufferSize:= WaveFormatTag.SamplePerSec
* WaveFormatTag.BytePerSample;
BlockHead.fcc:= data;
BlockHead.Size:= CT*WaveFormatTag.BytePerSample;
AssignFile(Datei,FileName);
ReWrite(Datei,1);
BlockWrite(Datei,WaveFileHead,SizeOf(WaveFileHead),Anzahl);
If Anzahl <> SizeOf(WaveFileHead) then
begin
Result:= false;
LE:= FileError;
CloseFile(Datei);
OnError;
exit;
end;
BlockWrite(Datei,WaveFormatTag,SizeOf(WaveFormatTag),Anzahl);
If Anzahl <> SizeOf(WaveFormatTag) then
begin
Result:= false;
LE:= FileError;
CloseFile(Datei);
OnError;
exit;
end;
BlockWrite(Datei,BlockHead,SizeOf(BlockHead),Anzahl);
If Anzahl <>SizeOf(BlockHead) then
begin
Result:= false;
LE:= FileError;
CloseFile(Datei);
OnError;
exit;
end;
If CT > 0 then
begin
Case WaveFormatTag.BitPerCannel of
8: begin
If (WaveFormatTag.Cannels = 1)
and (WaveFormatTag.BytePerSample = 1) then
begin
Size:= CT;
Try GetMem(ShortBuffer,Size);
except
Result:= false;
LE:= NoMem;
CloseFile(Datei);
OnError;
exit;
end;
For Pos:= 1 to CT do
ShortBuffer^[Pos]:= SampleBuffer^[Pos].Left div 256;
BlockWrite(Datei,ShortBuffer^,Size,Anzahl);
If Anzahl <> LongInt(Size) then
begin
Result:= false;
LE:= FileError;
end
else
begin
Result:= true;
LE:= NoError;
end;
FreeMem(ShortBuffer);
end
else If (WaveFormatTag.Cannels = 2)
and (WaveFormatTag.BytePerSample = 2) then
begin
Size:= CT*2;
Try GetMem(ShortBuffer,Size);
except
Result:= false;
LE:= NoMem;
CloseFile(Datei);
OnError;
exit;
end;
For Pos:= 1 to CT do
begin
ShortBuffer^[(Pos*2)-1]:= SampleBuffer^[Pos].Left
div 256;
ShortBuffer^[Pos*2]:= SampleBuffer^[Pos].Right
div 256;
end;
BlockWrite(Datei,ShortBuffer^,Size,Anzahl);
If Anzahl <> LongInt(Size) then
begin
Result:= false;
LE:= FileError;
end
else
begin
Result:= true;
LE:= NoError;
end;
FreeMem(ShortBuffer);
end
else
begin
Result:= false;
LE:= BadFormat;
end;
end;
16: begin
If (WaveFormatTag.Cannels = 1)
and (WaveFormatTag.BytePerSample = 2) then
begin
Size:= CT*2;
Try GetMem(SmallBuffer,Size);
except
Result:= false;
LE:= NoMem;
CloseFile(Datei);
OnError;
exit;
end;
For Pos:= 1 to CT do
SmallBuffer^[Pos]:= SampleBuffer^[Pos].Left;
BlockWrite(Datei,SmallBuffer,Size,Anzahl);
If Anzahl <> LongInt(Size) then
begin
Result:= false;
LE:= FileError;
end
else
begin
Result:= true;
LE:= NoError;
end;
FreeMem(SmallBuffer);
end
else If (WaveFormatTag.Cannels = 2)
and (WaveFormatTag.BytePerSample = 4) then
begin
Size:= CT*4;
Try GetMem(SmallBuffer,Size);
except
Result:= false;
LE:= NoMem;
CloseFile(Datei);
OnError;
exit;
end;
For Pos:= 1 to CT do
begin
SmallBuffer^[(Pos*2)-1]:= SampleBuffer^[Pos].Left;
SmallBuffer^[Pos*2]:= SampleBuffer^[Pos].Right;
end;
BlockWrite(Datei,SmallBuffer^,Size,Anzahl);
If Anzahl <> LongInt(Size) then
begin
Result:= false;
LE:= FileError;
end
else
begin
Result:= true;
LE:= NoError;
end;
end
else
begin
Result:= false;
LE:= BadFormat;
end;
end;
else
begin
Result:= false;
LE:= BadFormat;
end;
end;
end
else
begin
Result:= true;
end;
CloseFile(Datei);
If Not Result then
OnError
else
LE:= NoError;
end;
function TWave.GetSampleBuffer(var Buffer: Array of TWaveSample;
Size: Cardinal; Pos: Cardinal): Boolean;
var BufferPos: Cardinal;
begin
If (Size+Pos) > CT then
begin
Result:= false;
LE:= BadSize;
OnError;
end
else
begin
For BufferPos:= Pos+1 to Pos+Size+1 do
Buffer[BufferPos-(Pos+1)]:= SampleBuffer^[BufferPos];
Result:= true;
LE:= NoError;
end;
end;
function TWave.SetSampleBuffer(var Buffer: Array of TWaveSample; Size: Cardinal;
Pos: Cardinal): Boolean;
var BufferPos,StartSamples,EndSamples,NewCT: Cardinal;
StartLeft,StartRight,StartDivLeft,StartDivRight,EndDivLeft,EndDivRight
: Integer;
LeftAdd,RightAdd: Single;
StartBuffer,EndBuffer: pSampleBuffer;
MXSave: Boolean;
begin
If Size = 0 then
begin
Result:= true;
LE:= NoError;
exit;
end;
If (CT = 0) or (SampleBuffer = Nil) then
begin
Try GetMem(SampleBuffer,SizeOf(TWaveSample));
except
Result:= false;
LE:= NoMem;
OnError;
exit;
end;
CT:= 1;
SampleBuffer^[CT].Left:= 0;
SampleBuffer^[CT].Right:= 0;
end;
MXSave:= MX;
If Pos+1 > CT then
MX:= false;
If MX then
begin
StartDivLeft:= Buffer[0].Left;
StartDivRight:= Buffer[0].Right;
EndDivLeft:= Buffer[Size-1].Left;
EndDivRight:= Buffer[Size-1].Right;
If (StartDivLeft > SampleAdd) or (StartDivLeft < -SampleAdd)
or (StartDivRight > SampleAdd) or (StartDivRight < -SampleAdd) then
begin
If StartDivLeft*StartDivLeft > StartDivRight*StartDivRight then
begin
If StartDivLeft < 0 then
StartSamples:= Trunc(StartDivLeft/-SampleAdd)
else
StartSamples:= Trunc(StartDivLeft/ SampleAdd);
end
else
begin
If StartDivRight < 0 then
StartSamples:= Trunc(StartDivRight/-SampleAdd)
else
StartSamples:= Trunc(StartDivRight/ SampleAdd);
end;
Try GetMem(StartBuffer,StartSamples*SizeOf(TWaveSample));
except
Result:= false;
LE:= NoMem;
MX:= MXSave;
OnError;
exit;
end;
LeftAdd:= Buffer[0].Left/StartSamples;
RightAdd:= Buffer[0].Right/StartSamples;
For BufferPos:= 1 to StartSamples do
begin
StartBuffer^[BufferPos].Left:= Trunc(LeftAdd*BufferPos);
StartBuffer^[BufferPos].Right:= Trunc(RightAdd*BufferPos);
end;
end
else
begin
StartSamples:= 0;
StartBuffer:= Nil;
end;
If (EndDivLeft > SampleAdd) or (EndDivLeft < -SampleAdd)
or (EndDivRight > SampleAdd) or (EndDivRight < -SampleAdd) then
begin
If EndDivLeft*EndDivLeft > EndDivRight*EndDivRight then
begin
If EndDivLeft < 0 then
EndSamples:= Trunc(EndDivLeft/-SampleAdd)
else
EndSamples:= Trunc(EndDivLeft/SampleAdd);
end
else
begin
If EndDivRight < 0 then
EndSamples:= Trunc(EndDivRight/-SampleAdd)
else
EndSamples:= Trunc(EndDivRight/ SampleAdd);
end;
Try GetMem(EndBuffer,EndSamples*SizeOf(TWaveSample));
except
Result:= false;
LE:= NoMem;
If StartBuffer <> Nil then
FreeMem(StartBuffer);
MX:= MXSave;
OnError;
exit;
end;
LeftAdd:= Buffer[Size-1].Left/SampleAdd;
RightAdd:= Buffer[Size-1].Right/SampleAdd;
For BufferPos:= 1 to EndSamples do
begin
EndBuffer^[BufferPos].Left:= Trunc(LeftAdd
* (EndSamples-(BufferPos-1)));
EndBuffer^[BufferPos].Right:= Trunc(RightAdd
* (EndSamples-(BufferPos-1)));
end;
end
else
begin
EndSamples:= 0;
EndBuffer:= Nil;
end;
If Pos+Size+StartSamples+EndSamples > CT then
begin
NewCT:= Pos+Size+StartSamples+EndSamples;
Try ReallocMem(SampleBuffer,NewCT*SizeOf(TWaveSample));
except
Result:= false;
LE:= NoMem;
If StartBuffer <> Nil then
FreeMem(StartBuffer);
If EndBuffer <> Nil then
FreeMem(EndBuffer);
MX:= MXSave;
OnError;
exit;
end;
For BufferPos:= CT to NewCT do
begin
SampleBuffer^[BufferPos].Left:= 0;
SampleBuffer^[BufferPos].Right:= 0;
end;
end
else
begin
NewCT:= CT;
end;
If StartSamples > 0 then
For BufferPos:= 1 to StartSamples do
SampleBuffer^[Pos+BufferPos]:=
MixSample(SampleBuffer^[Pos+BufferPos],StartBuffer^[BufferPos]);
For BufferPos:= 1 to Size do
SampleBuffer^[Pos+StartSamples+BufferPos]:=
MixSample(SampleBuffer^[Pos+StartSamples+BufferPos]
,Buffer[BufferPos-1]);
If EndSamples > 0 then
For BufferPos:= 1 to EndSamples do
SampleBuffer^[Pos+StartSamples+Size+BufferPos]:=
MixSample(SampleBuffer^[Pos+StartSamples+Size+BufferPos]
,EndBuffer^[BufferPos]);
CT:= NewCT;
Result:= true;
LE:= NoError;
end
else
begin
If Pos+1 <= CT then
begin
StartDivLeft:= Buffer[0].Left-SampleBuffer^[Pos+1].Left;
StartDivRight:= Buffer[0].Right-SampleBuffer^[Pos+1].Right;
StartLeft:= SampleBuffer^[Pos+1].Left;
StartRight:= SampleBuffer^[Pos+1].Right;
If Pos+1 < CT then
begin
EndDivLeft:= SampleBuffer^[Pos+2].Left-Buffer[Size-1].Left;
EndDivRight:=SampleBuffer^[Pos+2].Right-Buffer[Size-1].Right;
end
else
begin
EndDivLeft:= Buffer[Size-1].Left;
EndDivRight:= Buffer[Size-1].Right;
end;
end
else
begin
StartDivLeft:= Buffer[0].Left;
StartDivRight:= Buffer[0].Right;
EndDivLeft:= Buffer[Size-1].Left;
EndDivRight:= Buffer[Size-1].Right;
StartLeft:= Buffer[0].Left;
StartRight:= Buffer[0].Right;
end;
If (StartDivLeft > SampleAdd) or (StartDivLeft < -SampleAdd)
or (StartDivRight > SampleAdd) or (StartDivRight < -SampleAdd) then
begin
If StartDivLeft*StartDivLeft > StartDivRight*StartDivRight then
begin
If StartDivLeft < 0 then
StartSamples:= Trunc(StartDivLeft/-SampleAdd)
else
StartSamples:= Trunc(StartDivLeft/ SampleAdd);
end
else
begin
If StartDivRight < 0 then
StartSamples:= Trunc(StartDivRight/-SampleAdd)
else
StartSamples:= Trunc(StartDivRight/ SampleAdd);
end;
Try GetMem(StartBuffer,StartSamples*SizeOf(TWaveSample));
except
Result:= false;
LE:= NoMem;
MX:= MXSave;
OnError;
exit;
end;
LeftAdd:= StartDivLeft/StartSamples;
RightAdd:= StartDivRight/StartSamples;
For BufferPos:= 1 to StartSamples do
begin
StartBuffer^[BufferPos].Left:= StartLeft
+ Trunc(LeftAdd*BufferPos);
StartBuffer^[BufferPos].Right:= StartRight
+ Trunc(RightAdd*BufferPos);
end;
end
else
begin
StartSamples:= 0;
StartBuffer:= Nil;
end;
If (EndDivLeft > SampleAdd) or (EndDivLeft < -SampleAdd)
or (EndDivRight > SampleAdd) or (EndDivRight < -SampleAdd) then
begin
If EndDivLeft*EndDivLeft > EndDivRight*EndDivRight then
begin
If EndDivLeft < 0 then
EndSamples:= Trunc(EndDivLeft/-SampleAdd)
else
EndSamples:= Trunc(EndDivLeft/ SampleAdd);
end
else
begin
If EndDivRight < 0 then
EndSamples:= Trunc(EndDivRight/-SampleAdd)
else
EndSamples:= Trunc(EndDivRight/ SampleAdd);
end;
Try GetMem(EndBuffer,EndSamples*SizeOf(TWaveSample));
except
If StartBuffer <> Nil then
FreeMem(StartBuffer);
Result:= false;
LE:= NoMem;
MX:= MXSave;
OnError;
exit;
end;
LeftAdd:= EndDivLeft/EndSamples;
RightAdd:= EndDivRight/EndSamples;
For BufferPos:= 1 to EndSamples do
begin
EndBuffer^[BufferPos].Left:= Buffer[Size-1].Left
+ Trunc(LeftAdd*(EndSamples
-(BufferPos-1)));
EndBuffer^[BufferPos].Right:= Buffer[Size-1].Right
+ Trunc(RightAdd*(EndSamples
-(BufferPos-1)));
end;
end
else
begin
EndSamples:= 0;
EndBuffer:= Nil;
end;
NewCT:= CT+Size+StartSamples+EndSamples;
Try ReallocMem(SampleBuffer,NewCT * SizeOf(TWaveSample));
except
If StartBuffer <> Nil then
FreeMem(StartBuffer);
If EndBuffer <> Nil then
FreeMem(EndBuffer);
Result:= false;
LE:= NoMem;
MX:= MXSave;
exit;
end;
If Pos+1 < CT then
begin
For BufferPos:= CT Downto Pos+1 do
SampleBuffer^[BufferPos+Size+StartSamples+EndSamples]:=
SampleBuffer^[BufferPos];
end
else If Pos+1 > CT then
begin
For BufferPos:= CT+1 to Pos+1 do
begin
SampleBuffer^[BufferPos].Left:= 0;
SampleBuffer^[BufferPos].Right:= 0;
end;
end;
If StartSamples > 0 then
For BufferPos:= 1 to StartSamples do
SampleBuffer^[Pos+BufferPos]:= StartBuffer^[BufferPos];
For BufferPos:= 0 to Size-1 do
SampleBuffer^[Pos+StartSamples+BufferPos]:= Buffer[BufferPos];
If EndSamples > 0 then
For BufferPos:= 1 to EndSamples do
SampleBuffer^[Pos+StartSamples+Size+BufferPos]:=
EndBuffer^[BufferPos];
CT:= NewCT;
Result:= true;
LE:= NoError;
end;
If StartBuffer <> Nil then
FreeMem(StartBuffer);
If EndBuffer <> Nil then
FreeMem(EndBuffer);
AE:= true;
MX:= MXSave;
OnChange(SR);
end;
procedure Register;
begin
RegisterComponents('System', [TWave]);
end;
end. |
|
|
|
