如何在动态图象上实现象镜头里取景框的效果？ (100分)

我用IMAGE1来显示从摄像头传来的动态影像，然后CLICK后显示在IMAGE2中
（已经截取为中间部分），为提高成象准确性，想在IMAGE1的中间显示一个
象照相机镜头里的取景框一样的提示框，不知如何实现？

准备一张源图贴到image1上
白色背景的图象
设置Image1.Transparent:=True;,实现对图象的白色部分扣图.

无论我怎样设置，动态图象都把其他图片覆盖掉了！
能否详细指教？

在 Image1 前面再放一个 Image，画成白色并设为透明，
取景时在上面那个 Image 上画取景框

随便放什么都没有用啊

你把源码贴出来大家看看啊

你用什么样的采集卡？采集卡会直接把显示内容显示在你给定的区域里，
所以你放什么都不行。
如果可能，不用采集卡的现实，而是把数据取出来自己显示，这样就可以控制了。

我用的是INTEL CS430 USB摄像头，使用VideoCap, VideoMci

别的控件不可能覆盖住图像，我也为此烦着呢！

每人知道吗？

我的方法没用吗？我都是这样用的呀

////////////////////////////////////////
// DFM 文件
///////////////////////////////////////
object Form1: TForm1
Left = 192
Top = 107
Width = 696
Height = 480
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object Image1: TImage
Left = 296
Top = 160
Width = 384
Height = 288
end
object Image2: TImage
Left = 296
Top = 160
Width = 384
Height = 288
Transparent = True
OnMouseDown = Image2MouseDown
OnMouseMove = Image2MouseMove
OnMouseUp = Image2MouseUp
end
end

///////////////////////////////////////////////
// Pas 文件
///////////////////////////////////////////////
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Image1: TImage;
Image2: TImage; // 一定要放到 Image1 前面，并设其 TransParent 为 True;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Image2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image2MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

uses VFW;

var
wndCap: HWND;
info: TBitmapInfo;
bmpCap: TBitmap;

canProc: Boolean;
x0, x1, y0, y1: integer;

procedure FrameToBitmap(Bitmap: TBitmap; FrameBuffer: pointer; BitmapInfo: TBitmapInfo);
begin
if bitmapInfo.bmiHeader.BiCompression = bi_RGB then
with Bitmap do
setDiBits(canvas.handle, handle, 0, BitmapInfo.bmiHeader.biheight,
FrameBuffer, BitmapInfo, DIB_RGB_COLORS);
end;

function myProc(hWnd:HWND; lpVHdrVIDEOHDR):LongInt; stdcall;
begin
result := 0;
FrameToBitmap(bmpCap, lpvhdr^.lpData, info);
Form1.Image1.Picture.Bitmap := bmpCap;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
DoubleBuffered := true;
canProc := False;

bmpCap := TBitmap.Create;
with bmpCap do
begin
Width := 384;
Height := 288;
PixelFormat := pf24bit;
end;

with Image2.Picture.Bitmap do
begin
Width := Image2.Width;
Height := Image2.Height;
PixelFormat := pf24bit;
Canvas.Pen.Style := psDot;
Canvas.Brush.Style := bsClear;
end;

wndCap := capCreateCaptureWindow('a', ws_visible or ws_child, 0, 0, 4, 3, Handle, 100);
capDriverConnect(wndCap, 0);
capPreview(wndCap, true);
capPreviewRate(wndCap, 40);
capGetVideoFormat(wndCap, @info, sizeof(TBitmapInfo));
capSetCallbackOnFrame(wndCap, myProc);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
DestroyWindow(wndCap);
bmpCap.Free;
end;

procedure TForm1.Image2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
canProc := True;
x0 := x;
y0 := y;
x1 := x;
y1 := y;
end;

procedure TForm1.Image2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if canProc then
begin
with Image2.Picture.Bitmap.Canvas do
begin
Pen.Color := clWhite; // Pen.Mode := pmXor 及 DrawFocusRect 都不好用
Rectangle(x0, y0, x1, y1);
x1 := x;
y1 := y;
Pen.Color := clBlack;
Rectangle(x0, y0, x, y);
end;
end;
end;

procedure TForm1.Image2MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
canProc := False;
x1 := x;
y1 := y;
bitblt(Canvas.Handle, 0, 0, x1 - x0, y1 - y0,
Image1.Canvas.Handle, x0, y0, SRCCOPY);
end;

end.

to:cqbaobao
谢谢您的无私帮助，但是你的程序好象是用鼠标截图（而且是在静态图上的），
我的程序设想是想用一个IMAGE1动态显示从摄像头出来的信号，然后通过
BUTTONCLICK把中心头像截取到另一个IMAGE2中，为了提高截取得准确性，
想在IMAGE1的中间画一个框，就象照相机镜头中间的取景框一样的效果。
我在IMAGE1上放置了一个IMAGE3，画了一个框，设置为透明，但还是被动态
图覆盖掉了，哪怕我放一个PANEL也没用！

sunyb:
不可能的啊，我做过这样的东西，我是放了4个panel上去，模拟一个框框，
可以显示出来的！

这样解决.
因为你的Image1 是动态显示捕获的图象的. 所以你应该知道何时Image1被重画.
然后你创建一个位图. 装载你的取景框图片. 取景框图片就是画一个框咯. 需要透明的部分都用
纯色填充(比如用品红. R:255 G:0 B:255)
修改image1被重画的过程. 新建一个位图 . 捕获的图象画到位图里面. 然后 Bitblt 你的取景框图象
到位图中. 修改Bitblt的参数使之透明. 然后再把位图画到Image1里. 其实可以画到Paintbox中的.

不知道这个方法行不行?

4个PANEL？您的意思是用他们覆盖掉周围，只显示中间的？

xwings说的估计到了点子上，但是我是初次涉及图象捕捉，
对捕捉原理一点也不懂，所以就无法掌握Image1何时被重画，
而且每次重画每次BITBLT的话系统估计吃不消的，不知还有没有
更为理想简单的办法？
BTW：Bitblt的详细用法哪里有参考啊，我只有用到了一个SCRCOPY，
其他一点不知道。

肯定每次都要画的. bitblt速度很快.重画时间看看你显示的过程是如何写的..就知道了.
至于用法看MSDN吧. 我就不贴出来了.要提高速度就不要用Image .用paintbox

哦，理解错了你的意思，以下可在 Image1 上画取景框

..............

var
wndCap: HWND;
info: TBitmapInfo;
bmpCap: TBitmap;
rectCap: TRect;

function myProc(hWnd:HWND; lpVHdrVIDEOHDR):LongInt; stdcall;
var
p: TPoint;
begin
result := 0;
FrameToBitmap(bmpCap, lpvhdr^.lpData, info);
GetCursorPos(p);
ScreenToClient(Form1.Handle, p);
with Form1.Image1 do
begin
if PtInRect(rectCap, p) then
begin
bmpCap.Canvas.Rectangle(p.x - Form1.Image1.Left - 30, p.y - Form1.Image1.top - 30,
p.x - Form1.Image1.Left + 30, p.y - Form1.Image1.top + 30);
end;
end;
Form1.Image1.Picture.Bitmap := bmpCap;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
DoubleBuffered := true;

bmpCap := TBitmap.Create;
with bmpCap, bmpCap.Canvas do
begin
Width := 384;
Height := 288;
PixelFormat := pf24bit;
Pen.Mode := pmXor;
Pen.Color := clWhite;
Brush.Style := bsClear;
end;

with Image1 do
rectCap := rect(Left, Top, Left + Width, Top + Height);

wndCap := capCreateCaptureWindow('a', ws_visible or ws_child, 0, 0, 4, 3, Handle, 100);
capDriverConnect(wndCap, 0);
capPreview(wndCap, true);
capPreviewRate(wndCap, 66);
capGetVideoFormat(wndCap, @info, sizeof(TBitmapInfo));
capSetCallbackOnFrame(wndCap, myProc);
end;

至于点击后取图自己可以实现了吧

谢谢各位的帮忙，我的代码还处于测试学习阶段很简单的：
nit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls,VideoCap, VideoMci, MMSystem, StdCtrls,jpeg;

type
TForm1 = class(TForm)
Panel1: TPanel;
videoarea: TPanel;
Button1: TButton;
Panel2: TPanel;
Panel3: TPanel;
Image2: TImage;
Image1: TImage;
Label1: TLabel;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
MciClose;
CapSetVideoArea(VideoArea);
CapSetInfoLabel(label1);
try
CapOpenDriver;
CapShow;
except
showmessage('error!');
end;


end;


procedure TForm1.Button1Click(Sender: TObject);
var bmp1:TBitmap;
jpeg1:TJpegImage;
w,h,x,y:integer;
begin
sndplaysound('shortsnp.wav',SND_SYNC);
CapSetSingleImageFileName('TempImage.bmp');
CapGrabSingleFrame;
CapSetVideoLive;
bmp1:=TBitmap.Create;
bmp1.LoadFromFile('TempImage.bmp');
//w:=bmp1.Width div 2;
//h:=bmp1.Height div 1;
x:=bmp1.Width div 3;
y:=bmp1.Height div 5;
BitBlt(image2.Canvas.Handle,0,0,120,160,bmp1.Canvas.Handle,x,y,SRCCOPY);
image2.picture.Savetofile('TempImage.bmp');
image2.Stretch:=true;
image2.Picture.LoadFromFile('TempImage.bmp');
//image2.Picture.Bitmap.Monochrome:=true;
//image2.picture.bitmap.pixelformat := pf24bit;

Jpeg1 := TJpegImage.Create;
Jpeg1.CompressionQuality := 50;
Jpeg1.Assign(Image2.Picture.Bitmap);
jpeg1.SaveToFile('TempImage.jpg');
bmp1.Free;
jpeg1.Free;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
image2.Picture:=nil;
end;

end.

dfm文件：
object Form1: TForm1
Left = 211
Top = 138
Width = 696
Height = 480
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 72
Top = 24
Width = 201
Height = 160
BevelInner = bvLowered
BorderWidth = 3
Caption = 'Panel1'
TabOrder = 0
object videoarea: TPanel
Left = 5
Top = 5
Width = 191
Height = 150
Align = alClient
BevelOuter = bvNone
Caption = 'videoarea'
Color = clBlack
TabOrder = 0
object Image1: TImage
Left = 64
Top = 80
Width = 105
Height = 105
Transparent = True
end
object Label1: TLabel
Left = 63
Top = 65
Width = 44
Height = 13
Caption = 'ͼÏó״̬'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindow
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
end
end
object Button1: TButton
Left = 192
Top = 200
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 1
OnClick = Button1Click
end
object Panel2: TPanel
Left = 288
Top = 24
Width = 120
Height = 160
BevelInner = bvLowered
BorderWidth = 3
Caption = 'Panel2'
TabOrder = 2
object Panel3: TPanel
Left = 5
Top = 5
Width = 110
Height = 150
Align = alClient
BevelOuter = bvNone
Caption = 'ÕÕƬ'
Color = clWindow
TabOrder = 0
object Image2: TImage
Left = 0
Top = 0
Width = 110
Height = 150
Align = alClient
AutoSize = True
Center = True
Stretch = True
end
end
end
object Button2: TButton
Left = 288
Top = 200
Width = 75
Height = 25
Caption = 'Button2'
TabOrder = 3
OnClick = Button2Click
end
end

由于取得视频的过程是封装在VideoCap, VideoMci单元里的，
所以我就无法画上去除非修改源代码

这个东西还没见过，