unit1.pas

可旋转90度浏览的视频浏览源码

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls,vfw;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    SaveDialog1: TSaveDialog;
    Panel2: TPanel;
    OpenVideo: TButton;
    CloseVideo: TButton;
    capView: TPanel;
    FinderView: TImage;
    procedure FormCreate(Sender: TObject);
    procedure OpenVideoClick(Sender: TObject);
    procedure CloseVideoClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);

  private
  hWndC : THandle;
  CapWnd: THandle;
  CapturingAVI : bool;
    { Private declarations }
  public

    { Public declarations }
  end;

var
  Form1: TForm1;
  capView: TPanel;//临时的，用于旋转获取的视频
  FinderView: TImage;//图象控件
  function FrameCallBack(hWnd: hWnd; lpVHdr: PVIDEOHDR): DWORD; stdcall;//这是个回调函数，图象获取和旋转在这处理

implementation

{$R *.dfm}


function FrameCallBack(hWnd: hWnd; lpVHdr: PVIDEOHDR): DWORD; stdcall;//这是个回调函数，图象获取和旋转在这处理
var
  MemoryStream: TMemoryStream;
  BitmapHead: TBITMAPINFOHEADER;
  BitmapInfo: TBITMAPINFO;
  BitmapFileHead: TBITMAPFILEHEADER;
  Status: TCAPSTATUS;
  BIHSize: int64;
  StreamSize: int64;
  R, G, B: Char;
  Buf: PChar;

  Bmp, TmpBmp: TBitmap;
  pSource, pDest: PByteArray;
  nIdx, nOfs,
    x, y, i, nMultiplier: integer;
  nMemWidth, nMemHeight, nMemSize, nScanLineSize: LongInt;
  aScnLnBuffer: PChar;
  aScanLine: PByteArray;
begin
  // 取得CAP信息
  capGetStatus(hWnd, @Status, SizeOf(Status));
  // 取得图片格式容量大小
  BIHSize := capGetVideoFormatSize(hWnd);
  // 取得圖片格式 代入 bitmapinfohead 內
  capGetVideoFormat(hWnd, @BitmapHead, BIHSize);
  // 设置 BITMAPINFO
  BitmapInfo.bmiHeader := BitmapHead;

  StreamSize := SizeOf(BitmapFileHead) + SizeOf(BitmapHead) + BitmapHead.biSizeImage;

  // 设置 BITMAPFILEHEAD
  BitmapFileHead.bfType := $4D42; //BM
  BitmapFileHead.bfSize := StreamSize; //该图片总大小
  BitmapFileHead.bfOffBits := SizeOf(BitmapFileHead) + SizeOf(BitmapHead);

  MemoryStream := TMemoryStream.Create;
  MemoryStream.Size := StreamSize;
  MemoryStream.Position := 0;

  MemoryStream.Write(BitmapFileHead, SizeOf(TBITMAPFILEHEADER));
  MemoryStream.Write(BitmapInfo, SizeOf(TBITMAPINFO));

  MemoryStream.Write((PChar(lpVHdr.lpData) + 4)^, lpVHdr.dwBufferLength);

  MemoryStream.Position := 0;
  Application.ProcessMessages;
  //if Form1.Timer1.Tag = 1 then
  begin
    Bmp := TBitmap.Create;
    Bmp.LoadFromStream(MemoryStream);

//******************************************************************************
//消耗时间
    nMultiplier := 3;
    nMemWidth := Bmp.Height;
    nMemHeight := Bmp.Width;
  //实际需要内存大小
    nMemSize := nMemWidth * nMemHeight * nMultiplier;
  //开辟内存
    GetMem(aScnLnBuffer, nMemSize);
    try
    //Scanline的长度
      nScanLineSize := Bmp.Width * nMultiplier;
    //为ScanLine分配内存
      GetMem(aScanLine, nScanLineSize);
      try
        for y := 0 to Bmp.Height - 1 do
        begin
        //进行数据块的移动
          Move(Bmp.ScanLine[y]^, aScanLine^, nScanLineSize);
          for x := 0 to Bmp.Width - 1 do
          begin
            nIdx := ((Bmp.Width - 1) - x) * nMultiplier;
            nOfs := (x * nMemWidth * nMultiplier) + (y * nMultiplier);
            for i := 0 to nMultiplier - 1 do
            Byte(aScnLnBuffer[nOfs + i]) := aScanLine[nIdx + i];
          end;
        end;
      //宽和高交换开始，逆时针旋转
        TmpBmp := TBitmap.Create;
        TmpBmp.PixelFormat := pf24bit;

        TmpBmp.Height := nMemHeight;
        TmpBmp.Width := nMemWidth;
        for y := 0 to nMemHeight - 1 do
        begin
        //数据移动
          nOfs := y * nMemWidth * nMultiplier;
          Move((@(aScnLnBuffer[nOfs]))^, TmpBmp.ScanLine[y]^, nMemWidth *
          nMultiplier);
        end;
        Bmp.Free;
      finally
      //释放内存aScanLine
        FreeMem(aScanLine, nScanLineSize);
      end;
    finally
    //释放内存aScnLnBuffer
      FreeMem(aScnLnBuffer, nMemSize);
    end;
    form1.FinderView.Picture.Bitmap.Assign(TmpBmp);
   TmpBmp.Free;

  end;
  MemoryStream.Free;
  Result := 0;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
CapturingAVI := false;
hWndC := 0;
SaveDialog1.Options :=
[ofHideReadOnly, ofNoChangeDir, ofPathMustExist]

end;





procedure TForm1.OpenVideoClick(Sender: TObject);
var
bErr: LongBool;

begin

  FinderView.AutoSize:=false;
  Finderview.Visible:=true;
  Finderview.Stretch:=true;
  FinderView.Picture.Bitmap.PixelFormat := pf24bit;
  FinderView.Picture.Bitmap.Width := Panel1.Width-9 ;
  FinderView.Picture.Bitmap.Height := Panel1.Height-9 ;
  FinderView.Width := Panel1.Width ;
  FinderView.Height := Panel1.Height ;
//  FinderView.Left := (GbxShoot.Width - FinderView.Width) div 2;
//  FinderView.Top := ((GbxShoot.Height - 20 - FinderView.Height) div 2) + 19;
  FinderView.Left := 0;
  FinderView.Top := 0 ;
        CapWnd := capCreateCaptureWindow('预览窗口', WS_VISIBLE or WS_CHILD,
        Panel1.Left,
        Panel1.Top,
        Panel1.Width,
        Panel1.Height,
        capview.Handle, 1);
        bErr := capDriverConnect(CapWnd, 0); //连接摄像头设备
        if not bErr then
        begin
         Dialogs.MessageDlg('连接相机失败？           ', mtInformation, [mbYes], 0);
           Exit;
        end;
 
        capPreviewScale(CapWnd, true);
        capPreview(CapWnd, False);
        capPreviewRate(CapWnd, 66); //设置预览视频的频率，33代表第秒30帧。
        capOverlay( CapWnd, True);
        capPreview(CapWnd, True);
        capSetCallbackOnFrame(CapWnd, FrameCallBack);//这是个回调函数，图象获取和旋转在这处理
        OpenVideo.Enabled :=false;

end;

procedure TForm1.CloseVideoClick(Sender: TObject);
begin
if capwnd <> 0 then begin
SendMessage(CapWnd, WM_CAP_DRIVER_DISCONNECT, 0, 0);
CapWnd := 0;
OpenVideo.Enabled :=true;
end;
end;



procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
CloseVideoClick(Sender);
end;


end.