unit Unit1;
interface
uses
Winapi.Windows,
Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs, AdvGlowButton,
Vcl.StdCtrls, HTMListB,
Vcl.ExtCtrls, mmSystem, WaveUtils, WaveStorage, WaveOut, WavePlayers, WaveIO,
WaveIn, WaveRecorders, IdSocketHandle, IdBaseComponent, IdComponent,
IdUDPBase, IdUDPServer,
Vcl.Menus,
Vcl.ComCtrls, IdGlobal, IdUDPClient,
PictureContainer,
Vcl.ImgList, Unit2;
const
WAVE_FORMAT_GSM610 = $0031;
type
PGSM610WaveFormat = ^TGSM610WaveFormat;
TGSM610WaveFormat =
record
wfx: TWaveFormatEx;
wSamplesPerBlock: Word;
end;
type
TAudioBuffer =
class
private
CS: RTL_CRITICAL_SECTION;
Data: Pointer;
Size: Cardinal;
public
EnterCritial : Boolean;
constructor Create;
destructor Destroy;
override;
procedure Clear;
function BeginUpdate(ExtraSize: Cardinal): Pointer;
procedure EndUpdate;
function Get(
out Buffer: Pointer;
out BufferSize: Cardinal): Boolean;
end;
type
TForm1 =
class(TForm)
micbutton: TAdvGlowButton;
usertype: TMemo;
listusers: THTMListBox;
onmic: THTMListBox;
recorder: TLiveAudioRecorder;
player: TLiveAudioPlayer;
UDPReceiver: TIdUDPServer;
chatboxmsg: TMemo;
Send: TAdvGlowButton;
mictest: TPopupMenu;
estmicrophone1: TMenuItem;
adminsendmenu: TPopupMenu;
SendToall1: TMenuItem;
Sendtoadmins1: TMenuItem;
pbLevel: TProgressBar;
sendtocl: TIdUDPClient;
micstop: TAdvGlowButton;
camerabtn: TAdvGlowButton;
usedimg: TImageList;
Smilebtn: TAdvGlowButton;
fontbtn: TAdvGlowButton;
Panel1: TPanel;
addoabout
: TImage;
Panel2: TPanel;
procedure playerError(Sender: TObject);
procedure recorderData(Sender: TObject;
const Buffer: Pointer; BufferSize: Cardinal;
var FreeIt: Boolean);
procedure estmicrophone1Click(Sender: TObject);
procedure recorderLevel(Sender: TObject; Level: Integer);
procedure SendClick(Sender: TObject);
procedure usertypeKeyPress(Sender: TObject;
var Key: Char);
procedure recorderActivate(Sender: TObject);
procedure recorderDeactivate(Sender: TObject);
procedure micstopClick(Sender: TObject);
procedure addoaboutClick(Sender: TObject);
function playerDataPtr(Sender: TObject;
var Buffer: Pointer;
var NumLoops: Cardinal;
var FreeIt: Boolean): Cardinal;
procedure playerFormat(Sender: TObject;
var pWaveFormat: PWaveFormatEx;
var FreeIt: Boolean);
procedure playerLevel(Sender: TObject; Level: Integer);
procedure UDPReceiverUDPRead(AThread: TIdUDPListenerThread;
const AData: TIdBytes; ABinding: TIdSocketHandle);
procedure micbuttonClick(Sender: TObject);
procedure recorderFormat(Sender: TObject;
var pWaveFormat: PWaveFormatEx;
var FreeIt: Boolean);
private
AudioLevel: Integer;
AudioBuffer : TAudioBuffer;
BlockAlign : Integer;
end;
var
Form1: TForm1;
Section : TRTLCriticalSection;
implementation
{$R *.dfm}
{ TAudioBuffers }
constructor TAudioBuffer.Create;
begin
InitializeCriticalSection(CS);
end;
destructor TAudioBuffer.Destroy;
begin
Clear;
DeleteCriticalSection(CS);
inherited Destroy;
end;
procedure TAudioBuffer.Clear;
begin
EnterCriticalSection(CS);
try
ReallocMem(Data, 0);
Size := 0;
finally
LeaveCriticalSection(CS);
end;
end;
function TAudioBuffer.BeginUpdate(ExtraSize: Cardinal): Pointer;
begin
EnterCriticalSection(CS);
EnterCritial := True;
ReallocMem(Data, Size + ExtraSize);
Result := Pointer(Cardinal(Data) + Size);
Inc(Size, ExtraSize);
end;
procedure TAudioBuffer.EndUpdate;
begin
LeaveCriticalSection(CS);
EnterCritial := False;
end;
function TAudioBuffer.Get(
out Buffer: Pointer;
out BufferSize: Cardinal): Boolean;
begin
EnterCriticalSection(CS);
try
Result := False;
if Assigned(Data)
then
begin
Buffer := Data;
BufferSize := Size;
Data :=
nil;
Size := 0;
Result := True;
end;
finally
LeaveCriticalSection(CS);
end;
end;
procedure TForm1.addoaboutClick(Sender: TObject);
begin
Aboutus.FormStyle := fsStayOnTop;
Aboutus.Show;
end;
procedure TForm1.estmicrophone1Click(Sender: TObject);
begin
estmicrophone1.Checked := True;
end;
procedure TForm1.micbuttonClick(Sender: TObject);
begin
recorder.Active := True;
end;
procedure TForm1.micstopClick(Sender: TObject);
begin
recorder.Active := False;
end;
function TForm1.playerDataPtr(Sender: TObject;
var Buffer: Pointer;
var NumLoops: Cardinal;
var FreeIt: Boolean): Cardinal;
begin
try
if AudioBuffer.Get(Buffer, Result)
then
FreeIt := True
else
begin
Buffer :=
nil;
// When Buffer is nil,
Result := 1000;
// Result will be considered as silence milliseconds.
end
except
Result := 1000;
end;
end;
procedure TForm1.playerError(Sender: TObject);
begin
player.Active := False;
end;
procedure TForm1.playerFormat(Sender: TObject;
var pWaveFormat: PWaveFormatEx;
var FreeIt: Boolean);
var
GSM610: PGSM610WaveFormat;
begin
GetMem(GSM610, SizeOf(TGSM610WaveFormat));
GSM610^.wfx.wFormatTag := WAVE_FORMAT_GSM610;
GSM610^.wfx.nChannels := 1;
GSM610^.wfx.nSamplesPerSec := 44100;
GSM610^.wfx.nAvgBytesPerSec := 8957;
{ 8000 / 320 * 65 }
GSM610^.wfx.nBlockAlign := 65;
GSM610^.wfx.wBitsPerSample := 0;
GSM610^.wfx.cbSize := 2;
GSM610^.wSamplesPerBlock := 320;
pWaveFormat := PWaveFormatEx(GSM610);
BlockAlign := pWaveFormat^.nBlockAlign;
FreeIt := True;
end;
procedure TForm1.playerLevel(Sender: TObject; Level: Integer);
begin
pbLevel.Position := Level;
end;
procedure TForm1.recorderActivate(Sender: TObject);
begin
micstop.Visible := True;
micbutton.Visible := False;
end;
procedure TForm1.recorderData(Sender: TObject;
const Buffer: Pointer;
BufferSize: Cardinal;
var FreeIt: Boolean);
begin
Freeit :=True;
if sendtocl.active
then
sendtocl.SendBuffer('
192.168.1.100',12000, RawToBytes(Buffer^, Buffersize))
else
micstop.Caption := '
You are not connected';
end;
procedure TForm1.recorderDeactivate(Sender: TObject);
begin
micbutton.Visible := True;
micstop.Visible := False;
end;
procedure TForm1.recorderFormat(Sender: TObject;
var pWaveFormat: PWaveFormatEx;
var FreeIt: Boolean);
begin
FreeIt := True;
end;
procedure TForm1.recorderLevel(Sender: TObject; Level: Integer);
begin
AudioLevel := Level;
pbLevel.Position := Level;
end;
procedure TForm1.SendClick(Sender: TObject);
begin
sendtocl.Broadcast(usertype.Text, 12000);
usertype.Clear;
end;
procedure TForm1.UDPReceiverUDPRead(AThread: TIdUDPListenerThread;
const AData: TIdBytes; ABinding: TIdSocketHandle);
var
AudioDataSize: Integer;
AudioData : Pointer;
begin
try
EnterCriticalSection(Section);
try
AudioDataSize := Length(AData);
if AudioDataSize > 10
then
begin
try
if not Player.Active
then
begin
Player.Active := True;
Player.WaitForStart;
end;
except
end;
if BlockAlign > 1
then Dec(AudioDataSize, AudioDataSize
mod BlockAlign);
AudioData := AudioBuffer.BeginUpdate(AudioDataSize);
try
BytesToRaw(AData, AudioData^, AudioDataSize);
finally
AudioBuffer.EndUpdate;
end;
end else
begin
Player.Active := False;
Player.WaitForStop;
end;
finally
LeaveCriticalSection(Section);
end;
except
end;
end;
procedure TForm1.usertypeKeyPress(Sender: TObject;
var Key: Char);
begin
if Key=chr(13)
then SendClick(Self);
if Key = #13
then
Key := #0;
end;
end.