2

实际上,我在下面有这段代码可以很好地通过套接字(ClientSocket> ServerSocket)发送网络摄像头图像,在发送之前,我将图像保存到文件中。然后我想知道是否存在一些解决方案来将捕获插入其中MemoryStream而无需之前保存到文件。

任何建议都将受到欢迎。

提前致谢。

相机.pas

unit Camera;

interface

uses
  Windows, Messages, SysUtils, Graphics, Controls, Dialogs, ExtCtrls,
  Jpeg;

type
  TCamera = class(TObject)
  private
    Parent: TPanel;
    VideoHwnd: HWND;
    procedure Resize(Sender: TObject);
  public
    constructor Create(Owner: TPanel);
    destructor Destroy; override;
    function TakePicture(FileName: string): boolean;
    procedure SetSize;
    procedure SetSource;
  end;

implementation

const
  WM_CAP_START = WM_USER;
  WM_CAP_STOP = WM_CAP_START + 68;
  WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
  WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;
  WM_CAP_SAVEDIB = WM_CAP_START + 25;
  WM_CAP_DLG_VIDEOFORMAT = WM_CAP_START + 41;
  WM_CAP_DLG_VIDEOSOURCE = WM_CAP_START + 42;
  WM_CAP_SET_PREVIEW = WM_CAP_START + 50;
  WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52;
  WM_CAP_SET_SCALE = WM_CAP_START + 53;
  WM_CAP_GRAB_FRAME = WM_CAP_START + 60;
  WM_CAP_SEQUENCE = WM_CAP_START + 62;
  WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20;

function capCreateCaptureWindowA(lpszWindowName: PCHAR; dwStyle: longint; x: integer; y: integer; nWidth: integer; nHeight: integer; ParentWin: HWND; nId: integer): HWND; stdcall; external 'AVICAP32.DLL';

constructor TCamera.Create(Owner: TPanel);
begin
  try
    VideoHwnd := capCreateCaptureWindowA('Camera', WS_CHILD or WS_VISIBLE, 0, 0, Owner.Width, Owner.Height, Owner.Handle, 0);
    if (SendMessage(VideoHwnd, WM_CAP_DRIVER_CONNECT, 0, 0) <> 0) then
    begin
      SendMessage(VideoHwnd, WM_CAP_SET_PREVIEW, -1, 0);
      SendMessage(VideoHwnd, WM_CAP_SET_PREVIEWRATE, 100, 0);
      SendMessage(VideoHwnd, WM_CAP_SET_SCALE, -1, 0);
      Parent := Owner;
      Owner.OnResize := Resize;
    end;
  except
    exit;
  end;
end;

destructor TCamera.Destroy;
begin
  if (VideoHwnd <> 0) then
  begin
    SendMessage(VideoHwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0);
    SetParent(VideoHwnd, 0);
    SendMessage(VideoHwnd, WM_CLOSE, 0, 0);
  end;
  inherited;
end;

procedure TCamera.Resize(Sender: TObject);
begin
  inherited;
  if (VideoHwnd <> 0) then
  begin
    SetWindowPos(VideoHwnd, HWND_BOTTOM, 0, 0, Parent.Width, Parent.Height, SWP_NOMOVE or SWP_NOACTIVATE);
  end;
end;

procedure TCamera.SetSize;
begin
  SendMessage(VideoHwnd, WM_CAP_DLG_VIDEOFORMAT, 0, 0);
end;

procedure TCamera.SetSource;
begin
  SendMessage(VideoHwnd, WM_CAP_DLG_VIDEOSOURCE, 0, 0);
end;

function StringToPAnsiChar(stringVar: string): PAnsiChar;
var
  AnsString: AnsiString;
begin
  Result := '';
  try
    if stringVar <> '' then
    begin
      AnsString := AnsiString(stringVar);
      Result := PAnsiChar(PAnsiString(AnsString));
    end;
  except
  end;
end;

function TCamera.TakePicture(FileName: string): boolean;
var
  p: TPicture;
  j: TJpegImage;
  Q, k: integer;
begin
  if (SendMessage(VideoHwnd, WM_CAP_GRAB_FRAME, 0, 0) <> 0) and (SendMessage(VideoHwnd, WM_CAP_SAVEDIB, wparam(0), lparam(StringToPAnsiChar(FileName))) <> 0) then
  begin
    SendMessage(VideoHwnd, WM_CAP_SET_PREVIEW, -1, 0);
    p := TPicture.Create;
    p.Bitmap.LoadFromFile(FileName);
    j := TJpegImage.Create;
    j.Assign(p.Bitmap);
    val('100', Q, k);
    j.CompressionQuality := Q;
    j.SaveToFile(FileName);
    p.Free;
    j.Free;
    result := true;
  end
  else
    result := false;
end;

end.

Form1.pas

uses
 Camera;

// ...

procedure TForm1.ClientSocketCamConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
  Camera := TCamera.Create(Form1.Panel1);
end;

procedure TForm1.ClientSocketCamDisconnected(Sender: TObject; Socket: TCustomWinSocket);
begin
  Camera.Destroy;
end;

procedure TForm1.ClientSocketCamError(Sender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
  ErrorCode := 0;
end;

procedure TForm1.ClientSocketCamRead(Sender: TObject; Socket: TCustomWinSocket);
var
  s, FileName: string;
  Stream: TMemoryStream;
begin
  s := Socket.ReceiveText;

  FileName := ExtractFilePath(Application.ExeName) + 'webcam.jpg';

  if s = 'camoff' then
  begin
    Camera.Destroy;
    Socket.SendText('endcam');
  end;

  if s = 'cam' then
  begin
    try
      Camera.TakePicture(FileName);
      Sleep(200);
      Stream := TMemoryStream.Create;
      if FileExists(FileName)
      then
      begin
        Stream.LoadFromFile(FileName);
        Stream.Position := 0;
        Socket.SendText(inttostr(Stream.Size) + #0);
        Socket.SendStream(Stream);
      end;
    finally
      Stream.Free;
      Exit;
    end;
  end;
end;
4

0 回答 0