Форум: "Media";
Текущий архив: 2004.04.11;
Скачать: [xml.tar.bz2];
Вниз
Звуковая карта Найти похожие ветки
← →
Dio (2004-02-14 10:04) [0]Подскажите, как снимать сигнал со звуковухи?
← →
Dio (2004-02-14 10:04) [0]Подскажите, как снимать сигнал со звуковухи?
← →
Rouse_ © (2004-02-14 10:38) [1]
{==========================================|
| |
| WaveIn Beispiel von Jйrфme Thormann |
| |
| am 18.07.2002 |
{==========================================|
Copyright :
Ich habe das Programm geschrieben um anderen Leuten etwas mit dem WaveIn von
der mmsystem.pas zu helfen, daher darf der Source Code auch in anderen Programmen
frei verwendet und verцffentlich werden.
Wдhre aber nett mich zu erwдhnen ;-)
Probleme mit dem Code :
Ich habe den Code in Delphi 6 geschrieben, aber eigendlich mpsste er in allen
Versionen funktionieren.
________________________________
Kontakt :
Fragen Tipps o.д. zu
E-Mail : SendAMail2Me@Freenet.de
ICQ : 162210742
________________________________}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes,graphics, Forms,
Dialogs,mmsystem, StdCtrls,shellapi, Controls;
type
TArrayBuf = array[0..1023]of byte;//1 KByte
PArrayBuf = ^TArrayBuf;
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
ComboBox1: TComboBox;
ComboBox2: TComboBox;
ComboBox3: TComboBox;
ComboBox4: TComboBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormCreate(Sender: TObject);
procedure Label5MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
WaveFormat:TWaveFormatEx;
WaveIn:PHWaveIn;
IsOn:boolean;
Procedure WNDPROC(var msg:TMessage);override;
Procedure InitWaveIn(einschaltenausschalten:boolean);
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses Unit2;
{$R *.dfm}
Procedure Tform1.WNDPROC(var msg:TMessage);
var Hdr:PWaveHdr;
i:integeR;
r:real;
begin
INHERITED;
case msg.Msg of
MM_WIM_OPEN:
begin
Button1.Enabled:=false;
Button2.Enabled:=true;
Combobox2.Enabled:=false;
Combobox3.Enabled:=false;
form2.Show;
end;
MM_WIM_CLOSE:
begin
Button1.Enabled:=true;
Button2.Enabled:=false;
Combobox2.Enabled:=true;
Combobox3.Enabled:=true;
form2.Hide;
end;
MM_WIM_DATA:
begin
Hdr:=PWaveHdr(msg.LParam);
if hdr^.dwBytesRecorded>0 then //Sonst Teilen durch null
r:=form2.clientWidth/hdr^.dwBytesRecorded
else r:=0;
Form2.DoubleBuffered := True;
PatBlt(form2.Canvas.Handle,0,0,form2.ClientWidth,form2.ClientHeight,PATCOPY);//WHITENESS DSTINVERT DSTCOPY ...
(*
oder
form2.canvas.fillrect(form2.canvas.cliprect);
*)
form2.Canvas.Pen.Color:=clRed;
form2.Canvas.MoveTo(0,127);
form2.Canvas.LineTo(form2.ClientWidth,127);
//alle 100 bytes einen dunkelroten Strich
form2.Canvas.Pen.Color:=clMaroon;
Form2.Canvas.MoveTo(round(r*100),0);
Form2.Canvas.LineTo(round(r*100),255);
Form2.Canvas.MoveTo(round(r*200),0);
Form2.Canvas.LineTo(round(r*200),255);
Form2.Canvas.MoveTo(round(r*300),0);
Form2.Canvas.LineTo(round(r*300),255);
Form2.Canvas.MoveTo(round(r*400),0);
Form2.Canvas.LineTo(round(r*400),255);
Form2.Canvas.MoveTo(round(r*500),0);
Form2.Canvas.LineTo(round(r*500),255);
Form2.Canvas.MoveTo(round(r*600),0);
Form2.Canvas.LineTo(round(r*600),255);
Form2.Canvas.MoveTo(round(r*700),0);
Form2.Canvas.LineTo(round(r*700),255);
Form2.Canvas.MoveTo(round(r*800),0);
Form2.Canvas.LineTo(round(r*800),255);
Form2.Canvas.MoveTo(round(r*900),0);
Form2.Canvas.LineTo(round(r*900),255);
Form2.Canvas.MoveTo(round(r*1000),0);
Form2.Canvas.LineTo(round(r*1000),255);
Form2.Canvas.MoveTo(round(r*1100),0);
Form2.Canvas.LineTo(round(r*1100),255);
Form2.Canvas.MoveTo(round(r*1200),0);
Form2.Canvas.LineTo(round(r*1200),255);
form2.Canvas.Pen.Color:=clLime;
form2.Canvas.MoveTo(0,PArrayBuf(hdr.lpData)^[0]);
for i:=0 to hdr^.dwBytesRecorded-1 do begin
form2.Canvas.lineTo(round(r*i),PArrayBuf(hdr.lpData)^[i]);
end;
WaveInUnprepareHeader(WaveIn^,hdr,Sizeof(TWaveHdr));
Dispose(hdr.lpData); //Den Speicher vom ArrayBuf befreien
DisPose(hdr); //Den Speicher vom WaveHeader befreien
if isOn=false then EXIT;//wenn es ausgeschaltet wird keine neuen Buffer den Umlauf schicken
Hdr:=new(PWaveHdr);
Hdr^.lpData:=pointer(new(PArrayBuf));
Hdr^.dwBufferLength:=1024;
Hdr^.dwBytesRecorded:=0;
Hdr^.dwUser:=0;
Hdr^.dwFlags:=0;
Hdr^.dwLoops:=0;
WaveInPrepareHeader(WaveIn^,Hdr,Sizeof(TWaveHdr));
WaveInAddBuffer(WaveIn^,hdr,Sizeof(TWaveHdr));
end;
end;
end;
Procedure Tform1.InitWaveIn(einschaltenausschalten:boolean);
var i:integer;
WaveHdr:PWaveHdr;
DaBuffer:PArrayBuf;
openError,PrepareError,BufferAddError,StartError:integer;
begin
if einschaltenausschalten then
begin
WaveFormat.wFormatTag:=WAVE_FORMAT_PCM;
WaveFormat.nChannels:=1; //MONO
WaveFormat.nSamplesPerSec:=strtoint(Combobox2.Text);
WaveFormat.nAvgBytesPerSec:=strtoint(Combobox2.Text);
WaveFormat.nBlockAlign:=strtoint(Combobox3.Text);
WaveFormat.wBitsPerSample:=8;
WaveIn:=new(PHWaveIn);//Wichtig
openError:=WaveInOpen(WaveIn,0,@WaveFormat,handle,0,CALLBACK_WINDOW);
for i:=1 to 8 do//Schickt acht Buffer in den Umlauf
begin
DaBuffer:=new(PArrayBuf);//Wichtig
WaveHdr:=new(PWaveHdr);//Wichtig
with WaveHdr^ do
begin
lpData:=pointer(DaBuffer);
dwBufferLength:=sizeof(DaBuffer);//1024 = 1 KByte
dwBytesRecorded:=0;
dwUser:=0;
dwFlags:=0;
dwLoops:=0;
end;
PrepareError:=WaveInPrepareHeader(WaveIn^,WaveHdr,sizeOf(TWaveHdr));
BufferAddError:=WaveInAddBuffer(WaveIn^,WaveHdr,Sizeof(TWaveHdr));//Schreibt die Header in die "zu Verarbeiten Liste"
end;
StartError:=WaveInStart(WaveIn^);//Startet das "Verarbeiten"
if (openError<>0)or(PrepareError<>0)or(BufferAddError<>0)or(StartError<>0)then
Showmessage(
"WaveInOpen :"+inttostr(openError)(*Error 32 = Falsches Format*)+#13+//#13 = Zeilenumbruch
"WaveInPrepareHeader :"+inttostr(PrepareError)(*Error 5 = Nicht Geцffnet*)+#13+
"WaveInAddBuffer :"+inttostr(BufferAddError)(*Error 5 = Nicht Geцffnet*)+#13+
"StartError :"+inttostr(StartError)(*Error 5 = Nicht Geцffnet*)+#13);
//Die Fehlercodes stehen in der mmsystem.pas
end else
begin
WaveInStop(WaveIn^);//Stoppt das "Verarbeiten"
if WaveIn<>nil then WaveInReset(WaveIn^);
if WaveIn<>nil then WaveInClose(WaveIn^); //Schliesst den WavePort
Dispose(WaveIn);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
IsOn:=true;
InitWaveIn(true);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
IsOn:=false;
InitWaveIn(false);
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if Button2.Enabled then Button2.Click;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
application.HintColor:=clGreen;
label5.Caption:="CopyRight by"#13"Jйrфme Thormann"#13"ICQ #162210742";
end;
procedure TForm1.Label5MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShellExecute( Application.Handle,"open",pchar("mailto:SendAMeil2Me@freenet.de?subject=Hab""ne Frage&body="),nil,nil,sw_ShowNormal);
end;
end.
← →
Rouse_ © (2004-02-14 10:38) [1]
{==========================================|
| |
| WaveIn Beispiel von Jйrфme Thormann |
| |
| am 18.07.2002 |
{==========================================|
Copyright :
Ich habe das Programm geschrieben um anderen Leuten etwas mit dem WaveIn von
der mmsystem.pas zu helfen, daher darf der Source Code auch in anderen Programmen
frei verwendet und verцffentlich werden.
Wдhre aber nett mich zu erwдhnen ;-)
Probleme mit dem Code :
Ich habe den Code in Delphi 6 geschrieben, aber eigendlich mpsste er in allen
Versionen funktionieren.
________________________________
Kontakt :
Fragen Tipps o.д. zu
E-Mail : SendAMail2Me@Freenet.de
ICQ : 162210742
________________________________}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes,graphics, Forms,
Dialogs,mmsystem, StdCtrls,shellapi, Controls;
type
TArrayBuf = array[0..1023]of byte;//1 KByte
PArrayBuf = ^TArrayBuf;
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
ComboBox1: TComboBox;
ComboBox2: TComboBox;
ComboBox3: TComboBox;
ComboBox4: TComboBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormCreate(Sender: TObject);
procedure Label5MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
WaveFormat:TWaveFormatEx;
WaveIn:PHWaveIn;
IsOn:boolean;
Procedure WNDPROC(var msg:TMessage);override;
Procedure InitWaveIn(einschaltenausschalten:boolean);
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses Unit2;
{$R *.dfm}
Procedure Tform1.WNDPROC(var msg:TMessage);
var Hdr:PWaveHdr;
i:integeR;
r:real;
begin
INHERITED;
case msg.Msg of
MM_WIM_OPEN:
begin
Button1.Enabled:=false;
Button2.Enabled:=true;
Combobox2.Enabled:=false;
Combobox3.Enabled:=false;
form2.Show;
end;
MM_WIM_CLOSE:
begin
Button1.Enabled:=true;
Button2.Enabled:=false;
Combobox2.Enabled:=true;
Combobox3.Enabled:=true;
form2.Hide;
end;
MM_WIM_DATA:
begin
Hdr:=PWaveHdr(msg.LParam);
if hdr^.dwBytesRecorded>0 then //Sonst Teilen durch null
r:=form2.clientWidth/hdr^.dwBytesRecorded
else r:=0;
Form2.DoubleBuffered := True;
PatBlt(form2.Canvas.Handle,0,0,form2.ClientWidth,form2.ClientHeight,PATCOPY);//WHITENESS DSTINVERT DSTCOPY ...
(*
oder
form2.canvas.fillrect(form2.canvas.cliprect);
*)
form2.Canvas.Pen.Color:=clRed;
form2.Canvas.MoveTo(0,127);
form2.Canvas.LineTo(form2.ClientWidth,127);
//alle 100 bytes einen dunkelroten Strich
form2.Canvas.Pen.Color:=clMaroon;
Form2.Canvas.MoveTo(round(r*100),0);
Form2.Canvas.LineTo(round(r*100),255);
Form2.Canvas.MoveTo(round(r*200),0);
Form2.Canvas.LineTo(round(r*200),255);
Form2.Canvas.MoveTo(round(r*300),0);
Form2.Canvas.LineTo(round(r*300),255);
Form2.Canvas.MoveTo(round(r*400),0);
Form2.Canvas.LineTo(round(r*400),255);
Form2.Canvas.MoveTo(round(r*500),0);
Form2.Canvas.LineTo(round(r*500),255);
Form2.Canvas.MoveTo(round(r*600),0);
Form2.Canvas.LineTo(round(r*600),255);
Form2.Canvas.MoveTo(round(r*700),0);
Form2.Canvas.LineTo(round(r*700),255);
Form2.Canvas.MoveTo(round(r*800),0);
Form2.Canvas.LineTo(round(r*800),255);
Form2.Canvas.MoveTo(round(r*900),0);
Form2.Canvas.LineTo(round(r*900),255);
Form2.Canvas.MoveTo(round(r*1000),0);
Form2.Canvas.LineTo(round(r*1000),255);
Form2.Canvas.MoveTo(round(r*1100),0);
Form2.Canvas.LineTo(round(r*1100),255);
Form2.Canvas.MoveTo(round(r*1200),0);
Form2.Canvas.LineTo(round(r*1200),255);
form2.Canvas.Pen.Color:=clLime;
form2.Canvas.MoveTo(0,PArrayBuf(hdr.lpData)^[0]);
for i:=0 to hdr^.dwBytesRecorded-1 do begin
form2.Canvas.lineTo(round(r*i),PArrayBuf(hdr.lpData)^[i]);
end;
WaveInUnprepareHeader(WaveIn^,hdr,Sizeof(TWaveHdr));
Dispose(hdr.lpData); //Den Speicher vom ArrayBuf befreien
DisPose(hdr); //Den Speicher vom WaveHeader befreien
if isOn=false then EXIT;//wenn es ausgeschaltet wird keine neuen Buffer den Umlauf schicken
Hdr:=new(PWaveHdr);
Hdr^.lpData:=pointer(new(PArrayBuf));
Hdr^.dwBufferLength:=1024;
Hdr^.dwBytesRecorded:=0;
Hdr^.dwUser:=0;
Hdr^.dwFlags:=0;
Hdr^.dwLoops:=0;
WaveInPrepareHeader(WaveIn^,Hdr,Sizeof(TWaveHdr));
WaveInAddBuffer(WaveIn^,hdr,Sizeof(TWaveHdr));
end;
end;
end;
Procedure Tform1.InitWaveIn(einschaltenausschalten:boolean);
var i:integer;
WaveHdr:PWaveHdr;
DaBuffer:PArrayBuf;
openError,PrepareError,BufferAddError,StartError:integer;
begin
if einschaltenausschalten then
begin
WaveFormat.wFormatTag:=WAVE_FORMAT_PCM;
WaveFormat.nChannels:=1; //MONO
WaveFormat.nSamplesPerSec:=strtoint(Combobox2.Text);
WaveFormat.nAvgBytesPerSec:=strtoint(Combobox2.Text);
WaveFormat.nBlockAlign:=strtoint(Combobox3.Text);
WaveFormat.wBitsPerSample:=8;
WaveIn:=new(PHWaveIn);//Wichtig
openError:=WaveInOpen(WaveIn,0,@WaveFormat,handle,0,CALLBACK_WINDOW);
for i:=1 to 8 do//Schickt acht Buffer in den Umlauf
begin
DaBuffer:=new(PArrayBuf);//Wichtig
WaveHdr:=new(PWaveHdr);//Wichtig
with WaveHdr^ do
begin
lpData:=pointer(DaBuffer);
dwBufferLength:=sizeof(DaBuffer);//1024 = 1 KByte
dwBytesRecorded:=0;
dwUser:=0;
dwFlags:=0;
dwLoops:=0;
end;
PrepareError:=WaveInPrepareHeader(WaveIn^,WaveHdr,sizeOf(TWaveHdr));
BufferAddError:=WaveInAddBuffer(WaveIn^,WaveHdr,Sizeof(TWaveHdr));//Schreibt die Header in die "zu Verarbeiten Liste"
end;
StartError:=WaveInStart(WaveIn^);//Startet das "Verarbeiten"
if (openError<>0)or(PrepareError<>0)or(BufferAddError<>0)or(StartError<>0)then
Showmessage(
"WaveInOpen :"+inttostr(openError)(*Error 32 = Falsches Format*)+#13+//#13 = Zeilenumbruch
"WaveInPrepareHeader :"+inttostr(PrepareError)(*Error 5 = Nicht Geцffnet*)+#13+
"WaveInAddBuffer :"+inttostr(BufferAddError)(*Error 5 = Nicht Geцffnet*)+#13+
"StartError :"+inttostr(StartError)(*Error 5 = Nicht Geцffnet*)+#13);
//Die Fehlercodes stehen in der mmsystem.pas
end else
begin
WaveInStop(WaveIn^);//Stoppt das "Verarbeiten"
if WaveIn<>nil then WaveInReset(WaveIn^);
if WaveIn<>nil then WaveInClose(WaveIn^); //Schliesst den WavePort
Dispose(WaveIn);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
IsOn:=true;
InitWaveIn(true);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
IsOn:=false;
InitWaveIn(false);
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if Button2.Enabled then Button2.Click;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
application.HintColor:=clGreen;
label5.Caption:="CopyRight by"#13"Jйrфme Thormann"#13"ICQ #162210742";
end;
procedure TForm1.Label5MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShellExecute( Application.Handle,"open",pchar("mailto:SendAMeil2Me@freenet.de?subject=Hab""ne Frage&body="),nil,nil,sw_ShowNormal);
end;
end.
Страницы: 1 вся ветка
Форум: "Media";
Текущий архив: 2004.04.11;
Скачать: [xml.tar.bz2];
Память: 0.5 MB
Время: 0.057 c
