WebSVN – spacemission – Blame – /VCL_DELPHIX_D6/Wave.pas

Rev	Author	Line No.	Line
1	daniel-mar	1	unit Wave;
		2
		3	interface
		4
		5	{$INCLUDE DelphiXcfg.inc}
		6
		7	uses
		8	Windows, SysUtils, Classes, MMSystem;
		9
		10	type
		11
		12	{ EWaveError }
		13
		14	EWaveError = class(Exception);
		15
		16	{ TWave }
		17
		18	TWave = class(TPersistent)
		19	private
		20	FData: Pointer;
		21	FFormat: PWaveFormatEx;
		22	FFormatSize: Integer;
		23	FSize: Integer;
		24	procedure SetFormatSize(Value: Integer);
		25	procedure SetSize(Value: Integer);
		26	protected
		27	procedure DefineProperties(Filer: TFiler); override;
		28	procedure ReadData(Stream: TStream); virtual;
		29	procedure WriteData(Stream: TStream); virtual;
		30	public
		31	destructor Destroy; override;
		32	procedure Assign(Source: TPersistent); override;
		33	procedure Clear;
		34	procedure LoadFromFile(const FileName : string);
		35	procedure LoadFromStream(Stream: TStream);
		36	procedure SaveToFile(const FileName : string);
		37	procedure SaveToStream(Stream: TStream);
		38	procedure SetPCMFormat(SamplesPerSec, BitsPerSample, Channels: Integer);
		39	property Data: Pointer read FData;
		40	property Format: PWaveFormatEx read FFormat;
		41	property FormatSize: Integer read FFormatSize write SetFormatSize;
		42	property Size: Integer read FSize write SetSize;
		43	end;
		44
		45	{ TCustomDXWave }
		46
		47	TCustomDXWave = class(TComponent)
		48	private
		49	FWave: TWave;
		50	procedure SetWave(Value: TWave);
		51	public
		52	constructor Create(AOnwer: TComponent); override;
		53	destructor Destroy; override;
		54	property Wave: TWave read FWave write SetWave;
		55	end;
		56
		57	{ TDXWave }
		58
		59	TDXWave = class(TCustomDXWave)
		60	published
		61	property Wave;
		62	end;
		63
		64	{ EWaveStreamError }
		65
		66	EWaveStreamError = class(Exception);
		67
		68	{ TCustomWaveStream }
		69
		70	TCustomWaveStream = class(TStream)
		71	private
		72	FPosition: Integer;
		73	protected
		74	function GetFilledSize: Integer; virtual;
		75	function GetFormat: PWaveFormatEx; virtual; abstract;
		76	function GetFormatSize: Integer; virtual;
		77	function GetSize: Integer; virtual;
		78	function ReadWave(var Buffer; Count: Integer): Integer; virtual;
		79	procedure SetFormatSize(Value: Integer); virtual; abstract;
		80	procedure SetSize(Value: Integer); override;
		81	function WriteWave(const Buffer; Count: Integer): Integer; virtual;
		82	public
		83	function Read(var Buffer; Count: Longint): Longint; override;
		84	function Seek(Offset: Longint; Origin: Word): Longint; override;
		85	function Write(const Buffer; Count: Longint): Longint; override;
		86	procedure SetPCMFormat(SamplesPerSec, BitsPerSample, Channels: Integer);
		87	property FilledSize: Integer read GetFilledSize;
		88	property Format: PWaveFormatEx read GetFormat;
		89	property FormatSize: Integer read GetFormatSize write SetFormatSize;
		90	property Size: Integer read GetSize write SetSize;
		91	end;
		92
		93	{ TCustomWaveStream2 }
		94
		95	TCustomWaveStream2 = class(TCustomWaveStream)
		96	private
		97	FFormat: PWaveFormatEx;
		98	FFormatSize: Integer;
		99	protected
		100	function GetFormat: PWaveFormatEx; override;
		101	function GetFormatSize: Integer; override;
		102	procedure SetFormatSize(Value: Integer); override;
		103	public
		104	destructor Destroy; override;
		105	end;
		106
		107	{ TWaveObjectStream }
		108
		109	TWaveObjectStream = class(TCustomWaveStream)
		110	private
		111	FWave: TWave;
		112	protected
		113	function GetFormat: PWaveFormatEx; override;
		114	function GetFormatSize: Integer; override;
		115	function GetSize: Integer; override;
		116	function ReadWave(var Buffer; Count: Integer): Integer; override;
		117	procedure SetFormatSize(Value: Integer); override;
		118	procedure SetSize(Value: Integer); override;
		119	function WriteWave(const Buffer; Count: Integer): Integer; override;
		120	public
		121	constructor Create(AWave: TWave);
		122	end;
		123
		124	{ TWaveStream }
		125
		126	TWaveStream = class(TCustomWaveStream2)
		127	private
		128	FDataPosition: Integer;
		129	FDataHeaderPosition: Integer;
		130	FOpened: Boolean;
		131	FOriPosition: Integer;
		132	FReadMode: Boolean;
		133	FSize: Integer;
		134	FStream: TStream;
		135	procedure CloseWriteMode;
		136	procedure OpenReadMode;
		137	procedure OpenWriteMode;
		138	protected
		139	function GetSize: Integer; override;
		140	function ReadWave(var Buffer; Count: Integer): Integer; override;
		141	function WriteWave(const Buffer; Count: Integer): Integer; override;
		142	public
		143	constructor Create(AStream: TStream);
		144	destructor Destroy; override;
		145	procedure Open(WriteMode: Boolean);
		146	end;
		147
		148	{ TWaveFileStream }
		149
		150	TWaveFileStream = class(TWaveStream)
		151	private
		152	FFileStream: TFileStream;
		153	public
		154	constructor Create(const FileName: string; FileMode: Integer);
		155	destructor Destroy; override;
		156	end;
		157
		158	procedure MakePCMWaveFormatEx(var Format: TWaveFormatEx;
		159	SamplesPerSec, BitsPerSample, Channels: Integer);
		160
		161	implementation
		162
		163	uses DXConsts;
		164
		165	procedure MakePCMWaveFormatEx(var Format: TWaveFormatEx;
		166	SamplesPerSec, BitsPerSample, Channels: Integer);
		167	begin
		168	with Format do
		169	begin
		170	wFormatTag := WAVE_FORMAT_PCM;
		171	nChannels := Channels;
		172	nSamplesPerSec := SamplesPerSec;
		173	wBitsPerSample := BitsPerSample;
		174	nBlockAlign := nChannels*(wBitsPerSample div 8);
		175	nAvgBytesPerSec := nBlockAlign*nSamplesPerSec;
		176	cbSize := 0;
		177	end;
		178	end;
		179
		180	{ TWave }
		181
		182	const
		183	WavePoolSize = 8096;
		184
		185	destructor TWave.Destroy;
		186	begin
		187	Clear;
		188	inherited Destroy;
		189	end;
		190
		191	procedure TWave.Assign(Source: TPersistent);
		192	var
		193	AWave: TWave;
		194	begin
		195	if Source=nil then
		196	begin
		197	Clear;
		198	end else if Source is TWave then
		199	begin
		200	if Source<>Self then
		201	begin
		202	AWave := TWave(Source);
		203	Size := AWave.Size;
		204	FormatSize := AWave.FormatSize;
		205	Move(AWave.Data^, FData^, FSize);
		206	Move(AWave.Format^, FFormat^, FFormatSize);
		207	end;
		208	end else
		209	inherited Assign(Source);
		210	end;
		211
		212	procedure TWave.Clear;
		213	begin
		214	FreeMem(FData, 0); FData := nil;
		215	FreeMem(FFormat, 0); FFormat := nil;
		216
		217	FSize := 0;
		218	FFormatSize := 0;
		219	end;
		220
		221	procedure TWave.DefineProperties(Filer: TFiler);
		222	begin
		223	inherited DefineProperties(Filer);
		224	Filer.DefineBinaryProperty('WAVE', ReadData, WriteData, True);
		225	end;
		226
		227	procedure TWave.LoadFromFile(const FileName : string);
		228	var
		229	Stream: TFileStream;
		230	begin
		231	Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
		232	try
		233	LoadFromStream(Stream);
		234	finally
		235	Stream.Free;
		236	end;
		237	end;
		238
		239	procedure TWave.LoadFromStream(Stream: TStream);
		240	var
		241	WaveStream: TWaveStream;
		242	begin
		243	Clear;
		244
		245	WaveStream := TWaveStream.Create(Stream);
		246	try
		247	WaveStream.Open(False);
		248
		249	FormatSize := WaveStream.FormatSize;
		250	Move(WaveStream.Format^, Format^, FormatSize);
		251	Size := WaveStream.Size;
		252	WaveStream.ReadBuffer(FData^, Size);
		253	finally
		254	WaveStream.Free;
		255	end;
		256	end;
		257
		258	procedure TWave.ReadData(Stream: TStream);
		259	begin
		260	LoadFromStream(Stream);
		261	end;
		262
		263	procedure TWave.SaveToFile(const FileName : string);
		264	var
		265	Stream: TFileStream;
		266	begin
		267	Stream := TFileStream.Create(FileName, fmCreate);
		268	try
		269	SaveToStream(Stream);
		270	finally
		271	Stream.Free;
		272	end;
		273	end;
		274
		275	procedure TWave.SaveToStream(Stream: TStream);
		276	var
		277	WaveStream: TWaveStream;
		278	begin
		279	if (FFormatSize<=0) or (FSize<=0) then Exit;
		280
		281	WaveStream := TWaveStream.Create(Stream);
		282	try
		283	WaveStream.FormatSize := FormatSize;
		284	Move(Format^, WaveStream.Format^, FormatSize);
		285
		286	WaveStream.Open(True);
		287	WaveStream.WriteBuffer(FData^, Size);
		288	finally
		289	WaveStream.Free;
		290	end;
		291	end;
		292
		293	procedure TWave.SetFormatSize(Value: Integer);
		294	begin
		295	if Value<=0 then Value := 0;
		296	ReAllocMem(FFormat, Value);
		297	FFormatSize := Value;
		298	end;
		299
		300	procedure TWave.SetPCMFormat(SamplesPerSec, BitsPerSample, Channels: Integer);
		301	begin
		302	FormatSize := SizeOf(TWaveFormatEx);
		303	MakePCMWaveFormatEx(Format^, SamplesPerSec, BitsPerSample, Channels);
		304	end;
		305
		306	procedure TWave.SetSize(Value: Integer);
		307	var
		308	i: Integer;
		309	begin
		310	if Value<=0 then Value := 0;
		311
		312	i := (Value+WavePoolSize-1) div WavePoolSize;
		313	if i<>(FSize+WavePoolSize-1) div WavePoolSize then
		314	ReAllocMem(FData, i*WavePoolSize);
		315
		316	FSize := Value;
		317	end;
		318
		319	procedure TWave.WriteData(Stream: TStream);
		320	begin
		321	SaveToStream(Stream);
		322	end;
		323
		324	{ TCustomDXWave }
		325
		326	constructor TCustomDXWave.Create(AOnwer: TComponent);
		327	begin
		328	inherited Create(AOnwer);
		329	FWave := TWave.Create;
		330	end;
		331
		332	destructor TCustomDXWave.Destroy;
		333	begin
		334	FWave.Free;
		335	inherited Destroy;
		336	end;
		337
		338	procedure TCustomDXWave.SetWave(Value: TWave);
		339	begin
		340	FWave.Assign(Value);
		341	end;
		342
		343	{ TCustomWaveStream }
		344
		345	function TCustomWaveStream.GetFilledSize: Longint;
		346	begin
		347	Result := -1;
		348	end;
		349
		350	function TCustomWaveStream.GetFormatSize: Integer;
		351	begin
		352	Result := 0;
		353	end;
		354
		355	function TCustomWaveStream.GetSize: Integer;
		356	begin
		357	Result := -1;
		358	end;
		359
		360	function TCustomWaveStream.Read(var Buffer; Count: Longint): Longint;
		361	begin
		362	if GetSize<0 then
		363	Result := ReadWave(Buffer, Count)
		364	else
		365	begin
		366	if FPosition>Size then
		367	FPosition := Size;
		368	if FPosition+Count>Size then
		369	Result := Size-FPosition
		370	else
		371	Result := Count;
		372
		373	Result := ReadWave(Buffer, Result);
		374	end;
		375
		376	Inc(FPosition, Result);
		377	end;
		378
		379	function TCustomWaveStream.ReadWave(var Buffer; Count: Integer): Integer;
		380	begin
		381	Result := 0;
		382	end;
		383
		384	function TCustomWaveStream.Seek(Offset: Longint; Origin: Word): Longint;
		385	begin
		386	case Origin of
		387	soFromBeginning: FPosition := Offset;
		388	soFromCurrent : FPosition := FPosition + Offset;
		389	soFromEnd : FPosition := GetSize + Offset;
		390	end;
		391	if FPosition<0 then FPosition := 0;
		392	if FPosition>GetSize then FPosition := GetSize;
		393
		394	Result := FPosition;
		395	end;
		396
		397	procedure TCustomWaveStream.SetPCMFormat(SamplesPerSec, BitsPerSample, Channels: Integer);
		398	begin
		399	FormatSize := SizeOf(TWaveFormatEx);
		400	MakePCMWaveFormatEx(Format^, SamplesPerSec, BitsPerSample, Channels);
		401	end;
		402
		403	procedure TCustomWaveStream.SetSize(Value: Integer);
		404	begin
		405	end;
		406
		407	function TCustomWaveStream.Write(const Buffer; Count: Longint): Longint;
		408	begin
		409	if FPosition>Size then
		410	FPosition := Size;
		411	Result := WriteWave(Buffer, Count);
		412	Inc(FPosition, Result);
		413	end;
		414
		415	function TCustomWaveStream.WriteWave(const Buffer; Count: Integer): Integer;
		416	begin
		417	Result := 0;
		418	end;
		419
		420	{ TCustomWaveStream2 }
		421
		422	destructor TCustomWaveStream2.Destroy;
		423	begin
		424	FormatSize := 0;
		425	inherited Destroy;
		426	end;
		427
		428	function TCustomWaveStream2.GetFormat: PWaveFormatEx;
		429	begin
		430	Result := FFormat;
		431	end;
		432
		433	function TCustomWaveStream2.GetFormatSize: Integer;
		434	begin
		435	Result := FFormatSize;
		436	end;
		437
		438	procedure TCustomWaveStream2.SetFormatSize(Value: Integer);
		439	begin
		440	ReAllocMem(FFormat, Value);
		441	FFormatSize := Value;
		442	end;
		443
		444	{ TWaveObjectStream }
		445
		446	constructor TWaveObjectStream.Create(AWave: TWave);
		447	begin
		448	inherited Create;
		449	FWave := AWave;
		450
		451	FormatSize := FWave.FormatSize;
		452	Move(FWave.Format^, Format^, FormatSize);
		453	end;
		454
		455	function TWaveObjectStream.GetFormat: PWaveFormatEx;
		456	begin
		457	Result := FWave.Format;
		458	end;
		459
		460	function TWaveObjectStream.GetFormatSize: Integer;
		461	begin
		462	Result := FWave.FormatSize;
		463	end;
		464
		465	function TWaveObjectStream.GetSize: Integer;
		466	begin
		467	Result := FWave.Size;
		468	end;
		469
		470	function TWaveObjectStream.ReadWave(var Buffer; Count: Integer): Integer;
		471	begin
		472	Result := Count;
		473	Move(Pointer(Integer(FWave.Data)+Position)^, Buffer, Count);
		474	end;
		475
		476	procedure TWaveObjectStream.SetFormatSize(Value: Integer);
		477	begin
		478	FWave.FormatSize := Value;
		479	end;
		480
		481	procedure TWaveObjectStream.SetSize(Value: Integer);
		482	begin
		483	FWave.Size := Value;
		484	end;
		485
		486	function TWaveObjectStream.WriteWave(const Buffer; Count: Integer): Integer;
		487	begin
		488	Result := Count;
		489	if Position+Count>Size then
		490	SetSize(Size+(Position+Count+Size));
		491	Move(Buffer, Pointer(Integer(FWave.Data)+Position)^, Count);
		492	end;
		493
		494	{ TWaveStream }
		495
		496	const
		497	ID_RIFF = Ord('R') + Ord('I')$100 + Ord('F')$10000 + Ord('F')*$1000000;
		498	ID_WAVE = Ord('W') + Ord('A')$100 + Ord('V')$10000 + Ord('E')*$1000000;
		499	ID_FMT = Ord('f') + Ord('m')$100 + Ord('t')$10000 + Ord(' ')*$1000000;
		500	ID_FACT = Ord('f') + Ord('a')$100 + Ord('c')$10000 + Ord('t')*$1000000;
		501	ID_DATA = Ord('d') + Ord('a')$100 + Ord('t')$10000 + Ord('a')*$1000000;
		502
		503	type
		504	TWaveFileHeader = packed record
		505	FType: Integer;
		506	Size: Longint;
		507	RType: Integer;
		508	end;
		509
		510	TWaveChunkHeader = packed record
		511	CType: Longint;
		512	Size: Longint;
		513	end;
		514
		515	constructor TWaveStream.Create(AStream: TStream);
		516	begin
		517	inherited Create;
		518	FStream := AStream;
		519
		520	FOriPosition := FStream.Position;
		521	end;
		522
		523	destructor TWaveStream.Destroy;
		524	begin
		525	if FOpened and (not FReadMode) then
		526	CloseWriteMode;
		527	inherited Destroy;
		528	end;
		529
		530	function TWaveStream.GetSize: Integer;
		531	begin
		532	if FOpened then
		533	begin
		534	if not FReadMode then
		535	Result := FStream.Size-FDataPosition
		536	else
		537	Result := FSize;
		538	end else
		539	Result := 0;
		540	end;
		541
		542	function TWaveStream.ReadWave(var Buffer; Count: Integer): Integer;
		543	begin
		544	if not FOpened then
		545	raise EWaveStreamError.Create(SStreamNotOpend);
		546
		547	FStream.Position := FDataPosition+Position;
		548	Result := FStream.Read(Buffer, Count);
		549	end;
		550
		551	function TWaveStream.WriteWave(const Buffer; Count: Integer): Integer;
		552	begin
		553	if not FOpened then
		554	raise EWaveStreamError.Create(SStreamNotOpend);
		555
		556	if FReadMode then
		557	begin
		558	if Position+Count>FSize then
		559	Count := FSize-Position;
		560	end;
		561
		562	FStream.Position := FDataPosition+Position;
		563	Result := FStream.Write(Buffer, Count);
		564	end;
		565
		566	procedure TWaveStream.Open(WriteMode: Boolean);
		567	begin
		568	if WriteMode then
		569	OpenWriteMode
		570	else
		571	OpenReadMode;
		572	end;
		573
		574	procedure TWaveStream.OpenReadMode;
		575	var
		576	WF: TWaveFileHeader;
		577	WC: TWaveChunkHeader;
		578
		579	procedure Readfmt; { fmt }
		580	begin
		581	FormatSize := WC.Size;
		582	FStream.ReadBuffer(Format^, WC.Size);
		583	end;
		584
		585	procedure Readdata; { data }
		586	begin
		587	FSize := WC.Size;
		588	FDataPosition := FStream.Position;
		589	FStream.Seek(FSize, 1);
		590	end;
		591
		592	begin
		593	if FOpened then
		594	raise EWaveStreamError.Create(SStreamOpend);
		595
		596	FOpened := True;
		597	FReadMode := True;
		598
		599	FStream.Position := FOriPosition;
		600
		601	//if FStream.Size-FStream.Position<=0 then Exit;
		602
		603	{ File header reading. }
		604	FStream.ReadBuffer(WF, SizeOf(TWaveFileHeader));
		605
		606	{ Is it Wave file of the file? }
		607	if (WF.FType<>ID_RIFF) or (WF.RType<>ID_WAVE) then
		608	raise EWaveStreamError.Create(SInvalidWave);
		609
		610	{ Chunk reading. }
		611	FillChar(WC, SizeOf(WC), 0);
		612	FStream.Read(WC, SizeOf(TWaveChunkHeader));
		613	while WC.CType<>0 do
		614	begin
		615	case WC.CType of
		616	ID_FMT : Readfmt;
		617	ID_DATA: Readdata;
		618	else
		619	{ Chunk which does not correspond is disregarded. }
		620	FStream.Seek(WC.Size, 1);
		621	end;
		622
		623	FillChar(WC, SizeOf(WC), 0);
		624	FStream.Read(WC, SizeOf(TWaveChunkHeader));
		625	end;
		626	end;
		627
		628	procedure TWaveStream.OpenWriteMode;
		629
		630	procedure WriteFmt; { fmt }
		631	var
		632	WC: TWaveChunkHeader;
		633	begin
		634	with WC do
		635	begin
		636	CType := ID_FMT;
		637	Size := FFormatSize;
		638	end;
		639
		640	FStream.WriteBuffer(WC, SizeOf(WC));
		641	FStream.WriteBuffer(FFormat^, FFormatSize);
		642	end;
		643
		644	procedure WriteData; { data }
		645	var
		646	WC: TWaveChunkHeader;
		647	begin
		648	FDataHeaderPosition := FStream.Position;
		649
		650	with WC do
		651	begin
		652	CType := ID_DATA;
		653	Size := 0;
		654	end;
		655
		656	FStream.WriteBuffer(WC, SizeOf(WC));
		657
		658	FDataPosition := FStream.Position;
		659	end;
		660
		661	var
		662	WF: TWaveFileHeader;
		663	begin
		664	if FOpened then
		665	raise EWaveStreamError.Create(SStreamOpend);
		666
		667	if FormatSize=0 then
		668	raise EWaveStreamError.Create(SInvalidWaveFormat);
		669
		670	FOpened := True;
		671	FStream.Position := FOriPosition;
		672
		673	FStream.WriteBuffer(WF, SizeOf(TWaveFileHeader));
		674
		675	{ Chunk writing. }
		676	WriteFmt;
		677	WriteData;
		678	end;
		679
		680	procedure TWaveStream.CloseWriteMode;
		681
		682	procedure WriteDataHeader; { data }
		683	var
		684	WC: TWaveChunkHeader;
		685	begin
		686	FStream.Position := FDataHeaderPosition;
		687
		688	with WC do
		689	begin
		690	CType := ID_DATA;
		691	Size := Self.Size;
		692	end;
		693
		694	FStream.WriteBuffer(WC, SizeOf(WC));
		695	end;
		696
		697	var
		698	WF: TWaveFileHeader;
		699	begin
		700	with WF do
		701	begin
		702	FType := ID_RIFF;
		703	Size := (FStream.Size-FOriPosition)-SizeOf(TWaveChunkHeader);
		704	RType := ID_WAVE;
		705	end;
		706	FStream.Position := FOriPosition;
		707	FStream.WriteBuffer(WF, SizeOf(TWaveFileHeader));
		708	WriteDataHeader;
		709	FStream.Position := FStream.Size;
		710	end;
		711
		712	{ TWaveFileStream }
		713
		714	constructor TWaveFileStream.Create(const FileName: string; FileMode: Integer);
		715	begin
		716	FFileStream := TFileStream.Create(FileName, FileMode);
		717	inherited Create(FFileStream);
		718	end;
		719
		720	destructor TWaveFileStream.Destroy;
		721	begin
		722	inherited Destroy;
		723	FFileStream.Free;
		724	end;
		725
		726	end.

Subversion Repositories spacemission

spacemission/VCL_DELPHIX_D6/Wave.pas – Rev 3