关于通过摄像头采集证件照的问题——在线等

Question

我需要编一个程序，通过dspack控件捕捉视频拍照，现在视频捕捉和拍照已经实现了，但是拍出的照片尺寸比例失调，我怎样才能队拍出的照片进行裁切呢？

Answer 1

帮你写一个吧，dspack很简单，vfw也更简单；稍后。

Answer 2

unit main;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DSUtil, StdCtrls, DSPack, DirectShow9, Menus, ExtCtrls, Math;type
  TVideoForm = class(TForm)
    FilterGraph: TFilterGraph;
    VideoWindow: TVideoWindow;
    MainMenu1: TMainMenu;
    Devices: TMenuItem;
    Filter: TFilter;
    SampleGrabber: TSampleGrabber;
    CallBack: TCheckBox;
    Panel: TPanel;
    btnCopyScr: TButton;
    ScrollBox1: TScrollBox;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure SampleGrabberBuffer(sender: TObject; SampleTime: Double;
      pBuffer: Pointer; BufferLen: Integer);
    procedure FormDestroy(Sender: TObject);
    procedure btnCopyScrClick(Sender: TObject);
  private  public    procedure PreviewFormOnMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure OnSelectDevice(sender: TObject);
  end;var
  VideoForm                   : TVideoForm;
  SysDev                      : TSysDevEnum;
  PreviewForm                 : TForm; //拍照区域
  Bmp                         : TBitmap; //缓存图象
implementation{$R *.dfm}procedure TVideoForm.FormCreate(Sender: TObject);
var
  i                           : integer;
  Device                      : TMenuItem;
  nP, P                       : TPoint;
begin
  SysDev := TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);
  if SysDev.CountFilters > 0 then
    for i := 0 to SysDev.CountFilters - 1 do
    begin
      Device := TMenuItem.Create(Devices);
      Device.Caption := SysDev.Filters[i].FriendlyName;
      Device.Tag := i;
      Device.OnClick := OnSelectDevice;
      Devices.Add(Device);
    end;  //创建拍照区域
  PreviewForm := TForm.Create(SELF);
  PreviewForm.BorderStyle := bsNone;
  PreviewForm.Width := Panel.Width div 2;
  PreviewForm.Height := Panel.Height div 2;
  PreviewForm.Left := 0;
  PreviewForm.Top := 0;
  PreviewForm.FormStyle := fsStayOnTop;
  PreviewForm.Color := ClBlue;
  PreviewForm.AlphaBlendValue := 127;
  PreviewForm.AlphaBlend := TRUE;
  PreviewForm.OnMouseMove := PreviewFormOnMouseMove;
  //确定位置
  P.X := Panel.Left;
  P.Y := Panel.Top;
  nP := ClientToScreen(p);  PreviewForm.Left := nP.X;
  PreviewForm.Top := nP.Y;
  PreviewForm.Show;  Bmp := TBitmap.Create;
end;procedure TVideoForm.OnSelectDevice(sender: TObject);
begin
  FilterGraph.ClearGraph;
  FilterGraph.Active := false;
  Filter.BaseFilter.Moniker := SysDev.GetMoniker(TMenuItem(Sender).tag);
  FilterGraph.Active := true;
  with FilterGraph as ICaptureGraphBuilder2 do
    RenderStream(@PIN_CATEGORY_PREVIEW, nil, Filter as IBaseFilter, SampleGrabber
      as IBaseFilter, VideoWindow as IbaseFilter);
  FilterGraph.Play;
end;procedure TVideoForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CallBack.Checked := False;
  SysDev.Free;
  FilterGraph.ClearGraph;
  FilterGraph.Active := false;
end;procedure TVideoForm.SampleGrabberBuffer(sender: TObject;
  SampleTime: Double; pBuffer: Pointer; BufferLen: Integer);
var
  MyCanvas                    : TCanvas;
begin
  if CallBack.Checked then
  begin
    MyCanvas := TCanvas.Create;
    MyCanvas.Handle := GetDc(Panel.Handle);
    MyCanvas.Lock;
    try
      SampleGrabber.GetBitmap(Bmp, pBuffer, BufferLen);
      MyCanvas.Draw(0, 0, Bmp);
    finally
      MyCanvas.Unlock;
    end;
  end;
end;//控件（拖动、放大、缩小）procedure ManipulateControl(Control: TControl; Shift: TShiftState; X, Y,
  Precision: integer);
var
  SC_MANIPULATE               : Word;
begin
  if (X <= Precision) and (Y > Precision) and (Y < Control.Height - Precision)
    then
  begin
    SC_MANIPULATE := $F001;
    Control.Cursor := crSizeWE;
  end
  else if (X >= Control.Width - Precision) and (Y > Precision) and (Y <
    Control.Height - Precision) then
  begin
    SC_MANIPULATE := $F002;
    Control.Cursor := crSizeWE;
  end
  else if (X > Precision) and (X < Control.Width - Precision) and (Y <=
    Precision) then
  begin
    SC_MANIPULATE := $F003;
    Control.Cursor := crSizeNS;
  end
  else if (X <= Precision) and (Y <= Precision) then
  begin
    SC_MANIPULATE := $F004;
    Control.Cursor := crSizeNWSE;
  end
  else if (X >= Control.Width - Precision) and (Y <= Precision) then
  begin
    SC_MANIPULATE := $F005;
    Control.Cursor := crSizeNESW;
  end
  else if (X > Precision) and (X < Control.Width - Precision) and (Y >=
    Control.Height - Precision) then
  begin
    SC_MANIPULATE := $F006;
    Control.Cursor := crSizeNS;
  end
  else if (X <= Precision) and (Y >= Control.Height - Precision) then
  begin
    SC_MANIPULATE := $F007;
    Control.Cursor := crSizeNESW;
  end
  else if (X >= Control.Width - Precision) and (Y >= Control.Height - Precision)
    then
  begin
    SC_MANIPULATE := $F008;
    Control.Cursor := crSizeNWSE;
  end
  else if (X > 5) and (Y > 5) and (X < Control.Width - 5) and (Y < Control.Height
    - 5) then
  begin
    SC_MANIPULATE := $F009;
    Control.Cursor := crSizeAll;
  end
  else
  begin
    SC_MANIPULATE := $F000;
    Control.Cursor := crDefault;
  end;
  if Shift = [ssLeft] then
  begin
    ReleaseCapture;
    Control.Perform(WM_SYSCOMMAND, SC_MANIPULATE, 0);
  end;
end;procedure TVideoForm.PreviewFormOnMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  ManipulateControl((Sender as TControl), Shift, X, Y, 10);
end;procedure TVideoForm.FormDestroy(Sender: TObject);
begin
  Bmp.Free;
  PreviewForm.Free;
end;procedure TVideoForm.btnCopyScrClick(Sender: TObject);
var
  R                           : TRect;
  P, CP                       : TPoint;
  SaveBmp                     : TBitmap;
begin
  P.X := PreviewForm.Left;
  P.Y := PreviewForm.Top;
  CP := ScreenToClient(P);  CP.X := CP.X - Panel.Left;
  CP.Y := CP.Y - Panel.Top;  R.Left := CP.X;
  R.Top := CP.Y;
  R.Right := CP.X + PreviewForm.Width;
  R.Bottom := CP.Y + PreviewForm.Height;
  Caption := Format('%d/%d, %d/%d/%d/%d', [cp.x, cp.y, R.left, r.top, r.right,
    r.bottom]);  if (R.Right > R.Left) and (R.Bottom > R.Top) then
  begin
    SaveBmp := TBitmap.Create;
    SaveBmp.Width := R.Right - R.Left;
    SaveBmp.Height := R.Bottom - R.Top;
    SaveBmp.PixelFormat := pf24Bit;    SaveBmp.Canvas.Brush.Color := clBlack;
    SaveBmp.Canvas.FillRect(SaveBmp.Canvas.ClipRect);
    try
     //获得区域内的局部图象
      SaveBmp.Canvas.CopyRect(SaveBmp.Canvas.ClipRect, Bmp.Canvas, R);
    except
    end;    Image1.Picture.Bitmap.Assign(SaveBmp); //显示到新图象框内。
    SaveBmp.Free;
  end;end;end.
需要完整的工程可以给我来信；
chinasf at hotmail.com

Answer 3

拍摄的图像不能正确显示在image上，我的为一片黑！希望继续帮忙！