Форум: "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.037 c