u_capture.pas

一个简单的学籍管理软件

unit U_Capture;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, DispPanel, U_AviCap, U_AviCapture, ExtCtrls;

type
  TFm_Capture = class(TForm)
    Pan_Btn: TPanel;
    Btn_CapSingle: TButton;
    Pan_CapBase: TPanel;
    Disp_Cap: TDispPanel;
    Btn_Exit: TButton;
    Btn_Pause: TButton;
    procedure Btn_SourceClick(Sender: TObject);
    procedure Btn_PauseClick(Sender: TObject);
    procedure Btn_CapSingleClick(Sender: TObject);
    procedure Disp_CapResize(Sender: TObject);
    procedure Btn_ExitClick(Sender: TObject);
  private
    procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
  public
    IsInit: boolean; //  初始化
    IsScreenCap: boolean; //  从屏幕抓取
    IsStop: Boolean; //  停止标志
    ResetFlag: Boolean;

    BmpInfo: BITMAPINFO;
    lConfig: TConfigRec;
    lParams: TCAPTUREPARMS;
    lCapDriverCaps: TCAPDRIVERCAPS;
    lCapStatus: TCapStatus;
    hwndCap: HWND;
    SaveFileName: string;
    //tmp: integer;

    procedure CalBitMap;
  end;

var
  Fm_Capture: TFm_Capture;
  hAvCapLib: integer;

function Show_Capture(stFileName: string): boolean;

implementation

{$R *.DFM}

function Show_Capture(stFileName: string): Boolean;
begin
  Result := False;
  Fm_Capture := TFm_Capture.Create(Application);

  hAvCapLib := 0;
  with Fm_Capture do
  try
    hAvCapLib := LoadLibrary(PChar(AVICAP32));
    if hAvCaplib = 0 then
      Exit;
    capGetDriverDescription := GetProcAddress(hAvCapLib, 'capGetDriverDescriptionA');
    capCreateCaptureWindow := GetProcAddress(hAvCapLib, 'capCreateCaptureWindowA');

    hwndCap := capCreateCaptureWindow(
      '',
      WS_CHILD + WS_VISIBLE,
      0, 0, 160, 120,
      Disp_Cap.Handle, 1);
    if hwndCap = 0 then
      Exit;
    if not vidcapInitHardware(hwndCap, 0, IsScreenCap) then
      Exit;
    capCaptureGetSetup(hwndCap, UINT(@lParams), sizeof(TCAPTUREPARMS));
    lParams.dwRequestMicroSecPerFrame := 25;
    capCaptureSetSetup(hWndcap, LongInt(@lParams), Sizeof(TCAPTUREPARMS));
    capDriverGetCaps(hwndCap, UINT(@lCapDriverCaps), sizeof(TCAPDRIVERCAPS));
    capGetStatus(hwndCap, UINT(@lCapStatus), sizeof(TCapStatus));

    IsInit := True;
    ResetFlag := True;
    Disp_CapResize(nil);
    SaveFileName := stFileName;
    if Showmodal = mrOk then
      Result := True;
  finally
    Fm_Capture.Free;
    if hAvCaplib <> 0 then
      FreeLibrary(hAvCapLib);
  end;
end;

procedure TFm_Capture.WMSysCommand(var Message: TWMSysCommand);
begin
  if Message.CmdType = SC_CLOSE then
  begin
    Btn_ExitClick(nil);
    Exit;
  end;
  inherited;
end;

procedure TFm_Capture.CalBitMap;
var
  BytesPerLine: LongInt;
  aSize: integer;
  pBitHead: PBITMAPINFO;
begin
  aSize := capGetVideoFormatSize(hwndCap);
  pBitHead := @BmpInfo;
  capGetVideoFormat(hwndCap, LongInt(pBitHead), aSize);

  BmpInfo.bmiHeader.biSize := sizeof(BmpInfo.bmiHeader);
  BmpInfo.bmiHeader.biPlanes := 1;
  BmpInfo.bmiHeader.biCompression := BI_RGB;
  BmpInfo.bmiHeader.biXPelsPerMeter := 0;
  BmpInfo.bmiHeader.biYPelsPerMeter := 0;
  BmpInfo.bmiHeader.biClrUsed := 0;
  BmpInfo.bmiHeader.biClrImportant := 0;
  BmpInfo.bmiHeader.biBitCount := 24;
  BmpInfo.bmiHeader.biWidth := 160;
  BmpInfo.bmiHeader.biHeight := 120;
  BytesPerLine := BmpInfo.bmiHeader.biWidth * BmpInfo.bmiHeader.biBitCount div 8;
  while (BytesPerLine mod 4) <> 0 do
    Inc(BytesPerLine);
  BmpInfo.bmiHeader.biSizeImage := BytesPerLine * BmpInfo.bmiHeader.biHeight;
end;

procedure TFm_Capture.Btn_SourceClick(Sender: TObject);
begin
  capDlgVideoSource(hWndCap);
end;

procedure TFm_Capture.Btn_PauseClick(Sender: TObject);
begin //
  if IsStop then
  begin
    capPreview(hWndCap, 1);
    Btn_Pause.Caption := '暂停(&P)';
    Btn_CapSingle.Enabled := False;
  end
  else
  begin
    capGrabFrame(hWndCap);
    Btn_Pause.Caption := '继续(&P)';
    Btn_CapSingle.Enabled := True;
    Btn_CapSingle.SetFocus;
  end;
  IsStop := not IsStop;
end;

procedure TFm_Capture.Btn_CapSingleClick(Sender: TObject);
var
  i: integer;
begin
  if Application.MessageBox('真的取当前照片吗?', '信息',
    MB_YESNO + MB_ICONWARNING) = idYes then
  begin
    i := capFileSaveDIB(hWndCap, Integer(PChar(SaveFileName)));
    ModalResult := mrOk;
    IsStop := not IsStop;
  end;
end;

procedure TFm_Capture.Disp_CapResize(Sender: TObject);
var
  pBitHead: PBITMAPINFO;
begin
  if IsInit and lCapDriverCaps.fHasDlgVideoFormat and ResetFlag then
  begin
    CalBitmap;
    pBitHead := @BmpInfo;
    capSetVideoFormat(hwndCap, LongInt(pBitHead), Sizeof(BmpInfo));
    MoveWindow(hwndCap,
      (Disp_Cap.ClientWidth - pBitHead^.bmiHeader.biWidth) div 2,
      (Disp_Cap.ClientHeight - pBitHead^.bmiHeader.biHeight) div 2,
      pBitHead^.bmiHeader.biWidth,
      pBitHead^.bmiHeader.biHeight,
      TRUE);
  end;
end;

procedure TFm_Capture.Btn_ExitClick(Sender: TObject);
begin
  ModalResult := mrCancel;
end;

end.