关于通过摄像头采集证件照的问题——在线等
我需要编一个程序，通过dspack控件捕捉视频拍照，现在视频捕捉和拍照已经实现了，但是拍出的照片尺寸比例失调，我怎样才能队拍出的照片进行裁切呢？ 问题点数：50、回复次数：5Top
1 楼moonling（月亮居士）回复于 2005-11-10 09:55:09 得分 0
我看到过，可以在视频窗口上放置一个固定的区域框，该框可以通过鼠标进行拖动，拍下的照片就是区域框中的内容，不知道怎么实现！希望高手能够指教！Top
2 楼S.F.（chinasf.cnblogs.com）回复于 2005-11-10 10:51:49 得分 0
帮你写一个吧，dspack很简单，vfw也更简单；稍后。Top
3 楼S.F.（chinasf.cnblogs.com）回复于 2005-11-10 14:05:38 得分 50
unit main;
interface
uses
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.comTop
4 楼liuex1235（盲流）回复于 2005-11-10 14:30:55 得分 0
学习Top
5 楼moonling（月亮居士）回复于 2005-11-15 14:16:00 得分 0
拍摄的图像不能正确显示在image上，我的为一片黑！希望继续帮忙！Top
相关问题
关键词
得分解答快速导航
相关链接
广告也精彩
反馈
