关于DSPACK使用拍照片的问题。

[cqnucsmoon]

我想在DSPACK显示的视频中（用的摄像头）加一个红色的框，然后将这个框中的视频保存保存为一个JPG文件。
主要用来拍证件照片。

不知道DSPACK能够实现吗？
请指点下。
如果解决后，再追加100分。
谢谢！

[3cs]

当然可以实现呀,\在DSPACE的例子中就有有,你找找!

[cqnucsmoon]

对了，要求拍出来的照片尺寸为150*200

[cqnucsmoon]

谢谢 neweipeng ：

快成功了，现在有一个问题。
当我这样调用 的时候，视频全部都是白色了的，就是视频不见了，请问是什么原因呀？！
procedure TForm1.MyVideoWindowMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
VMRRect(MyVideoWindow, Rect(x, y, x + 150, y + 200));
end;

解决后立即另开一贴100分相谢。

太感谢您了。

[cqnucsmoon]

我想实现：

当鼠标点下去的时候，画出的红色框 应该以鼠标的位置为中心，最好能够拖动这个红色的框，也是以鼠标所在位置为中心，不知道能不能实现。

[neweipeng]

1.视频全部都是白色
Brush.Color := clSilver;
Brush.Style := bsClear;
或者MyVideoWindow属性没设置好

2.鼠标的位置为中心，最好能够拖动这个红色的框
// 鼠标按下，将照片保存
procedure TForm1.MyVideoWindowMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
CaptureRect(MySampleGrabber, Rect(X-75,y-100,x+75,y+100));
end;

// 框随着鼠标移动，中心重合
procedure TForm1.MyVideoWindowMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
VMRRect(MyVideoWindow, Rect(X-75,y-100,x+75,y+100));
end;

具体功能自己完善一下

[cqnucsmoon]

1.视频全部都是白色
Brush.Color := clSilver;
Brush.Style := bsClear;
或者MyVideoWindow属性没设置好


这个还是问题，没有解决！！！

[cqnucsmoon]

谢谢 3cs
dspack的例子我都看了，没有看到相关的例子。
或者是我没有看明白是哪个例子，麻烦多指点下。

[neweipeng]

我用如上方法做过图像在线识别，并将识别结果直接绘制在视窗上，没有出现你说的情况。
有可能是DSPACK版本或运行环境不一样，你自己去找找原因……

LoadEmptyBitmap(VideoWindow.Width, VideoWindow.Height, pf24bit, ColorKey);
Options := VMRBitmap.Options + [vmrbSrcColorKey];
Source := VMRBitmap.Canvas.ClipRect;

Brush.Color := ColorKey;
Brush.Style := bsClear;

[success000]

ding

[dlschan]

ding

[neweipeng]

DSPACK控件
MyFilterGraph: TFilterGraph;
MyVideoWindow: TVideoWindow;
MyFilter: TFilter;
MySampleGrabber: TSampleGrabber;

一、加一个红色的框
{在属性中设定}
MyVideoWindow.Mode := vmVMR; // 关键设置
MyVideoWindow.FilterGraphi := MyFilterGraph;

procedure VMRRect(VideoWindow: TVideoWindow; Rt: TRect);
var
VMRBitmap: TVMRBitmap;
begin
if VideoWindow = nil then Exit;

VMRBitmap := TVMRBitmap.Create(VideoWindow);

with VMRBitmap, Canvas do
begin
LoadEmptyBitmap(VideoWindow.Width, VideoWindow.Height, pf24bit, clSilver);
Source := VMRBitmap.Canvas.ClipRect;
Options := VMRBitmap.Options + [vmrbSrcColorKey];
ColorKey := clSilver;

Brush.Style := bsClear;
//Brush.Color := clSilver;
Pen.Color := clRed;
//Pen.width := 2;
Rectangle(Rt);
DrawTo(0, 0, 1, 1, 1);
end;

VMRBitmap.Free;
end;

比如调用
VMRRect(MyVideoWindow, Rect(10, 10, 10+150, 10+200));
将在视窗上(10, 10)位置画出 150 x 200 红线框。

二、将这个框中的视频保存保存为一个JPG文件
{在属性中设定}
MySampleGrabber.FilterGraphi := MyFilterGraph;

procedure CaptureRect(SampleGrabber: TSampleGrabber; Rt: TRect; PicName: string='c:\photo.jpg');
var
srcBMP, rtBmp : TBitmap;
JPG : TJPEGImage;
begin
srcBMP := TBitmap.Create;
rtBmp := TBitmap.Create;
JPG := TJPEGImage.Create;
try
SampleGrabber.GetBitmap(srcBMP);
with rtBmp,Canvas do
begin
Width := Rt.Right - Rt.Left;
Height := Rt.Bottom - Rt.Top;
CopyRect(ClipRect, srcBMP.Canvas, Rt);
end;
JPG.Assign(rtBmp);
JPG.SaveToFile(PicName);
finally
rtBmp.Free;
JPG.Free;
srcBMP.Free;
end;
end;

比如调用
CaptureRect(MySampleGrabber, Rect(10, 10, 10+150, 10+200));
将照片保存为c:\photo.jpg

[ou630j]

delphi园地那里有个代码，我刚好借用了 ， 去看看

[cqnucsmoon]

[Quote=引用 14 楼 ou630j 的回复:]
delphi园地那里有个代码，我刚好借用了 ， 去看看
[/Quote]

哪个代码？？？

[cqnucsmoon]

谢谢 neweipeng ：

白屏的解决了，但又出现了其他两个问题：

1、换台机器的时候，CaptureRect执行拍照结果是照片为空白，什么东西都没有，估计是不是机器direcX的问题，不知道有什么要求？

2、这个问题比较严重。用以下代码保存图片（当在能保存的机器上测试的时候），发现照出来的照片，并不是完全是红线框内的图片，有偏移。而且会随着TVideoWindow控件的大小改变而改变的，不知道这个问题如何解决。
procedure TForm1.MyVideoWindowMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
CaptureRect(MySampleGrabber, Rect(X-75,y-100,x+75,y+100));
end;

[cqnucsmoon]

补充一点：
我使用ShowPinPropertyPage调出视频对话窗查看时，发现里面的输出大小为640*480，而想设置成其他，比如320*240的时候，竟然设置不了，提示说“当前没有这种格式”（而用TVideoCap的时候却可以设置的）。
我在想是不是和这个有关系？！

[cqnucsmoon]

请neweipeng 到这里领分，我说了要另开一贴100分感谢的。

https://forum.csdn.net/PointForum/Forum/PostTopic.aspx?forumID=2d8a999f-b552-4bf1-81b2-da785bdc082a