⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 avreceive.~pas

📁 音视频控件SunAM-V1.0 音视频控件SunAM-V1.0 音视频控件SunAM-V1.0 音视频控件SunAM-V1.0
💻 ~PAS
字号:
unit AVReceive;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, vfw, math, StdCtrls,  GlobalUnit, ComCtrls, ACMWaveOut, ExtCtrls, bmpToAvi,
  AVCompress, mmsystem;

type
  TReceiverForm = class(TForm)
    FWaveOut: TACMWaveOut;
    procedure FWaveOutDone(Sender: TObject);
  private
     Fbitmap: TBitmap;
     FIsStartRec:boolean;
     FAviWriter:TWriterAvi;
     FUserID: Cardinal; 
     FRecFileName: String;
     FAVDecompressor:TAVDecompressor;
     FOnVideoShow:TOnVideoShowOut;
     FVideoHeaderInfo: TBitmapInfoHeader;
     FIsReceiveVideo:boolean;
     FIsReceiveAudio:boolean;
     FIsAudioInit:boolean;
     AudioSize : Integer;
     AudioData : array of byte;
     AudioDecBuf: array[0..3 * 16000 - 1] of Byte;
     FOnVolumeOut: TOnVolumeOut;
     procedure initAudio();
     procedure SetRecFileName(const Value: String);
     procedure OnVideoOutput(VideoSize:TVideoSize; Adata: Pointer; Asize: Cardinal);
     procedure OnAudioOutput(Adata: Pointer; Asize: Cardinal);
     procedure SetOnVideoShow(const Value: TOnVideoShowOut);
     procedure SetOnVolumeOut(const Value: TOnVolumeOut);
  public
     procedure Init;
     procedure OnReadAudio(Buf: Pointer; Asize: Cardinal);
     procedure OnReadVideo(Buf: Pointer; Asize: Cardinal);
     function StartReceiveVideo: Boolean;
     procedure StopReceiveVideo;
     function StartReceiveAudio: Boolean;
     procedure StopReceiveAudio;
     procedure StartRec;
     procedure StopRec;
     property OnVideoShow: TOnVideoShowOut read FOnVideoShow write SetOnVideoShow;
     property OnVolumeOut: TOnVolumeOut read FOnVolumeOut write SetOnVolumeOut;
  end;

var
  ReceiverForm: TReceiverForm;

implementation

{$R *.dfm}

//取得解压后的视频数据
procedure TReceiverForm.OnVideoOutput(VideoSize: TVideoSize; Adata: Pointer; Asize: Cardinal);
begin
   if Asize<=0 then Exit;
   if Assigned(FOnVideoShow) then begin
       FOnVideoShow(VideoSize, Adata, Asize);
   end;
end;

//取得解压后的音频数据
procedure TReceiverForm.OnAudioOutput(Adata: Pointer; Asize: Cardinal);
var
  PeakL, PeakR: Smallint;
begin
  if ASize <= 0 then exit;
  if not FIsAudioInit then initAudio;
  pcmFindPeak(@PCMFOMAT, Adata, Asize, PeakL, PeakR);
  if Assigned(FOnVolumeOut) then
     FOnVolumeOut(32767-ABS(PeakL));
  if FWaveOut.Tag < 10 then begin
     FWaveOut.PlayBack(Adata, Asize);
     FWaveOut.Tag := FWaveOut.Tag + 1;
  end;
end;

procedure TReceiverForm.initAudio();
begin
  try
    FWaveOut.Open(@PCMFOMAT, 0);
    FWaveOut.Tag := 0;
    AudioSize := 0;
    FIsAudioInit:=true;
  except
    FIsAudioInit:=false;
    Exit;
  end;
end;

procedure TReceiverForm.SetOnVideoShow(const Value: TOnVideoShowOut);
begin
  FOnVideoShow := Value;
end;

procedure TReceiverForm.SetOnVolumeOut(const Value: TOnVolumeOut);
begin
   FOnVolumeOut := Value;
end;

procedure TReceiverForm.OnReadVideo(Buf: Pointer; Asize: Cardinal);
begin
   if not FIsReceiveVideo then Exit;
   if Asize<=0 then Exit;
   if not Assigned(FAVDecompressor) then begin
      FAVDecompressor:=TAVDecompressor.Create;
      FAVDecompressor.OnVideoOut := OnVideoOutput;
      FAVDecompressor.OnAudioOut := OnAudioOutput;
   end;
   FAVDecompressor.VDecompressor(Buf, Asize);
end;

function TReceiverForm.StartReceiveVideo: Boolean;
begin
   FIsReceiveVideo:=true;
end;

procedure TReceiverForm.StopReceiveVideo;
begin
   FIsReceiveVideo:=false;
end;

function TReceiverForm.StartReceiveAudio: Boolean;
begin
  FIsReceiveAudio:=true;
end;

procedure TReceiverForm.StopReceiveAudio;
begin
   FIsReceiveAudio:=false;
end;

procedure TReceiverForm.OnReadAudio(Buf: Pointer; Asize: Cardinal);
begin
   if not FIsReceiveAudio then Exit;
   if Asize<=0 then Exit;
   if not Assigned(FAVDecompressor) then begin
      FAVDecompressor:=TAVDecompressor.Create;
      FAVDecompressor.OnVideoOut := OnVideoOutput;
      FAVDecompressor.OnAudioOut := OnAudioOutput;
   end;
   FAVDecompressor.VDecompressor(Buf, Asize);
end;

procedure TReceiverForm.StartRec;
begin
  with FAviWriter do
  begin
    filename := FRecFileName;
    Width := 176;
    Height := 144;
    FrameTime := 125;
    WavFileName := '';
    Stretch := true;
    OnTheFlyCompression:=true;
  end;
  FAviWriter.SetCompression('XVID');
  FAviWriter.InitVideo;
  FIsStartRec:=true;

end;

procedure TReceiverForm.StopRec;
begin
   FIsStartRec:=false;
   FAviWriter.FinalizeVideo;
   FAviWriter.WriteAvi;
end;

procedure TReceiverForm.SetRecFileName(const Value: String);
begin
   FRecFileName := Value;
end;


procedure TReceiverForm.Init;
begin
   FAVDecompressor:=TAVDecompressor.Create;
   FAVDecompressor.OnVideoOut := OnVideoOutput;
   FAVDecompressor.OnAudioOut := OnAudioOutput;
   FAviWriter:=TWriterAvi.Create;
   FBitmap:=TBitmap.Create;
   FVideoHeaderInfo.biSize := Sizeof(tagBITMAPINFOHEADER);
   FVideoHeaderInfo.biPlanes := 1;
   FVideoHeaderInfo.biWidth := 176;
   FVideoHeaderInfo.biHeight := 144;
   FVideoHeaderInfo.biCompression := BI_RGB;
   FVideoHeaderInfo.biSizeImage := 176 * 144 * 3;
   FVideoHeaderInfo.biBitCount := 24;
   FVideoHeaderInfo.biXPelsPerMeter := 0;
   FVideoHeaderInfo.biYPelsPerMeter := 0;
   FVideoHeaderInfo.biClrUsed := 0;
   FVideoHeaderInfo.biClrImportant := 0;

   try
     FWaveOut.Open(@PCMFOMAT, 0);
     FWaveOut.Tag := 0;
     FIsAudioInit:=true;
   except
     FIsAudioInit:=false;
     Exit;
   end;
end;

procedure TReceiverForm.FWaveOutDone(Sender: TObject);
begin
  if FWaveOut.Tag>0 then
    FWaveOut.Tag := FWaveOut.Tag-1;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -