C
cailiao
Unregistered / Unconfirmed
GUEST, unregistred user!
我的网上找到了用USB摄像头照相的源码,但因为摄像头拍出来的都是横行的320X240,我想做个拍工作证相折程序,要拍出240X320的相,证问要怎样做,请各位帮帮忙!
程序在一个Form中放1个panel,6个button(分别命名为 捕捉,关闭,开始录像,结束,退出程序,拍照) 及两个saveDialog
源码
----------------------------------------------------------------
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Panel1: TPanel;
SaveDialog1: TSaveDialog;
SaveDialog2: TSaveDialog;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
hWndC: THandle;
implementation
const WM_CAP_START = WM_USER;
//wm_user:一个常量 $0400=1024 $0400为16进制数
const WM_CAP_STOP = WM_CAP_START + 68;
const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;
const WM_CAP_SAVEDIB = WM_CAP_START + 25;
const WM_CAP_GRAB_FRAME = WM_CAP_START + 60;
const WM_CAP_SEQUENCE = WM_CAP_START + 62;
const WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20;
const WM_CAP_SEQUENCE_NOFILE =WM_CAP_START+ 63;
const WM_CAP_SET_OVERLAY =WM_CAP_START+ 51;
const WM_CAP_SET_PREVIEW =WM_CAP_START+ 50;
const WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_CAP_START +6;
const WM_CAP_SET_CALLBACK_ERROR=WM_CAP_START +2;
const WM_CAP_SET_CALLBACK_STATUSA= WM_CAP_START +3;
const WM_CAP_SET_CALLBACK_FRAME= WM_CAP_START +5;
const WM_CAP_SET_SCALE=WM_CAP_START+ 53;
const WM_CAP_SET_PREVIEWRATE=WM_CAP_START+ 52;
function capCreateCaptureWindowW(lpszWindowName
CHAR;
dwStyle:longint;
x:integer;
y:integer;
nWidth : integer;nHeight : integer;ParentWin : HWND;
nId : integer): HWND;STDCALL;EXTERNAL 'AVICAP32.DLL';
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
hWndC := capCreateCaptureWindowW('My Own Capture Window',WS_CHILD or WS_VISIBLE,
Panel1.Left,Panel1.Top,Panel1.Width,Panel1.Height,Form1.Handle,0);
if hWndC <> 0 then
begin
SendMessage(hWndC, WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0, 0);
SendMessage(hWndC, WM_CAP_SET_CALLBACK_ERROR, 0, 0);
SendMessage(hWndC, WM_CAP_SET_CALLBACK_STATUSA, 0, 0);
SendMessage(hWndC, WM_CAP_DRIVER_CONNECT, 0, 0);
SendMessage(hWndC, WM_CAP_SET_SCALE, 1, 0);
SendMessage(hWndC, WM_CAP_SET_PREVIEWRATE, 66, 0);
SendMessage(hWndC, WM_CAP_SET_OVERLAY, 1, 0);
SendMessage(hWndC, WM_CAP_SET_PREVIEW, 1, 0);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if hWndC <> 0 then
begin
SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);
hWndC := 0;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
var i:integer;
begin
if hWndC <> 0 then
begin
// label label1;
if SaveDialog2.Execute then
begin
if FileExists(SaveDialog2.FileName) then
begin
i:= MessageBox(Form1.Handle,'文件夹下已经存在同名文件,是否覆盖?','确认信息窗口',MB_OKCANCEL);
if i=IDOK then
begin
SendMessage(hWndC,WM_CAP_FILE_SET_CAPTURE_FILEA,0,Longint(pchar(SaveDialog2.FileName)));
SendMessage(hWndC,WM_CAP_SEQUENCE, 0, 0);
end;
//else
goto label1;
end
else
begin
//ShowMessage(SaveDialog2.FileName);
///hWndC,WM_CAP_FILE_SET_CAPTURE_FILEA,0,Longint(pchar('c:/test.avi')));
//SendMessage(hWndC,WM_CAP_SEQUENCE, 0, 0);
SendMessage(hWndC,WM_CAP_FILE_SET_CAPTURE_FILEA,0, Longint(pchar(SaveDialog2.FileName)));
SendMessage(hWndC, WM_CAP_SEQUENCE, 0, 0);
end;
end;
end
else
begin
ShowMessage('请按捕获,然后才能录像');
end;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
Form1.Close;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
if hWndC <> 0 then
begin
SendMessage(hWndC, WM_CAP_STOP, 0, 0);
end
else
begin
ShowMessage('请按捕获和录像按钮,然后才能结束');
end;
end;
procedure TForm1.Button6Click(Sender: TObject);
var i:integer;
begin
if hWndC <> 0 then
begin
if SaveDialog1.Execute then
begin
if FileExists(SaveDialog1.FileName) then
//判断是否存在同名文件
begin
i:= MessageBox(Form1.Handle,'文件夹下已经存在同名文件,是否覆盖?','确认信息窗口',MB_OKCANCEL);
if i=IDOK then
SendMessage(hWndC,WM_CAP_SAVEDIB,0,longint(pchar(SaveDialog1.FileName)));
end
else
SendMessage(hWndC,WM_CAP_SAVEDIB,0,longint(pchar(SaveDialog1.FileName)));
end;
//if not DirectoryExists('C:/Documents and Settings/All Users/桌面/照片') then
//begin
//ForceDirectories('C:/Documents and Settings/All Users/桌面/照片');
//end;
//SendMessage(hWndC,WM_CAP_SAVEDIB,0,longint(pchar('C:/Documents and Settings/All Users/桌面/照片/'+FormatDateTime('"照片"yyyymmddhhnnsszzz',Now)+'.bmp')));
end
else
begin
ShowMessage('请按捕获按钮,然后才能拍照');
end
end;
end.
程序在一个Form中放1个panel,6个button(分别命名为 捕捉,关闭,开始录像,结束,退出程序,拍照) 及两个saveDialog
源码
----------------------------------------------------------------
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Panel1: TPanel;
SaveDialog1: TSaveDialog;
SaveDialog2: TSaveDialog;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
hWndC: THandle;
implementation
const WM_CAP_START = WM_USER;
//wm_user:一个常量 $0400=1024 $0400为16进制数
const WM_CAP_STOP = WM_CAP_START + 68;
const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;
const WM_CAP_SAVEDIB = WM_CAP_START + 25;
const WM_CAP_GRAB_FRAME = WM_CAP_START + 60;
const WM_CAP_SEQUENCE = WM_CAP_START + 62;
const WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20;
const WM_CAP_SEQUENCE_NOFILE =WM_CAP_START+ 63;
const WM_CAP_SET_OVERLAY =WM_CAP_START+ 51;
const WM_CAP_SET_PREVIEW =WM_CAP_START+ 50;
const WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_CAP_START +6;
const WM_CAP_SET_CALLBACK_ERROR=WM_CAP_START +2;
const WM_CAP_SET_CALLBACK_STATUSA= WM_CAP_START +3;
const WM_CAP_SET_CALLBACK_FRAME= WM_CAP_START +5;
const WM_CAP_SET_SCALE=WM_CAP_START+ 53;
const WM_CAP_SET_PREVIEWRATE=WM_CAP_START+ 52;
function capCreateCaptureWindowW(lpszWindowName
CHAR;dwStyle:longint;
x:integer;
y:integer;
nWidth : integer;nHeight : integer;ParentWin : HWND;
nId : integer): HWND;STDCALL;EXTERNAL 'AVICAP32.DLL';
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
hWndC := capCreateCaptureWindowW('My Own Capture Window',WS_CHILD or WS_VISIBLE,
Panel1.Left,Panel1.Top,Panel1.Width,Panel1.Height,Form1.Handle,0);
if hWndC <> 0 then
begin
SendMessage(hWndC, WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0, 0);
SendMessage(hWndC, WM_CAP_SET_CALLBACK_ERROR, 0, 0);
SendMessage(hWndC, WM_CAP_SET_CALLBACK_STATUSA, 0, 0);
SendMessage(hWndC, WM_CAP_DRIVER_CONNECT, 0, 0);
SendMessage(hWndC, WM_CAP_SET_SCALE, 1, 0);
SendMessage(hWndC, WM_CAP_SET_PREVIEWRATE, 66, 0);
SendMessage(hWndC, WM_CAP_SET_OVERLAY, 1, 0);
SendMessage(hWndC, WM_CAP_SET_PREVIEW, 1, 0);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if hWndC <> 0 then
begin
SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);
hWndC := 0;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
var i:integer;
begin
if hWndC <> 0 then
begin
// label label1;
if SaveDialog2.Execute then
begin
if FileExists(SaveDialog2.FileName) then
begin
i:= MessageBox(Form1.Handle,'文件夹下已经存在同名文件,是否覆盖?','确认信息窗口',MB_OKCANCEL);
if i=IDOK then
begin
SendMessage(hWndC,WM_CAP_FILE_SET_CAPTURE_FILEA,0,Longint(pchar(SaveDialog2.FileName)));
SendMessage(hWndC,WM_CAP_SEQUENCE, 0, 0);
end;
//else
goto label1;
end
else
begin
//ShowMessage(SaveDialog2.FileName);
///hWndC,WM_CAP_FILE_SET_CAPTURE_FILEA,0,Longint(pchar('c:/test.avi')));
//SendMessage(hWndC,WM_CAP_SEQUENCE, 0, 0);
SendMessage(hWndC,WM_CAP_FILE_SET_CAPTURE_FILEA,0, Longint(pchar(SaveDialog2.FileName)));
SendMessage(hWndC, WM_CAP_SEQUENCE, 0, 0);
end;
end;
end
else
begin
ShowMessage('请按捕获,然后才能录像');
end;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
Form1.Close;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
if hWndC <> 0 then
begin
SendMessage(hWndC, WM_CAP_STOP, 0, 0);
end
else
begin
ShowMessage('请按捕获和录像按钮,然后才能结束');
end;
end;
procedure TForm1.Button6Click(Sender: TObject);
var i:integer;
begin
if hWndC <> 0 then
begin
if SaveDialog1.Execute then
begin
if FileExists(SaveDialog1.FileName) then
//判断是否存在同名文件
begin
i:= MessageBox(Form1.Handle,'文件夹下已经存在同名文件,是否覆盖?','确认信息窗口',MB_OKCANCEL);
if i=IDOK then
SendMessage(hWndC,WM_CAP_SAVEDIB,0,longint(pchar(SaveDialog1.FileName)));
end
else
SendMessage(hWndC,WM_CAP_SAVEDIB,0,longint(pchar(SaveDialog1.FileName)));
end;
//if not DirectoryExists('C:/Documents and Settings/All Users/桌面/照片') then
//begin
//ForceDirectories('C:/Documents and Settings/All Users/桌面/照片');
//end;
//SendMessage(hWndC,WM_CAP_SAVEDIB,0,longint(pchar('C:/Documents and Settings/All Users/桌面/照片/'+FormatDateTime('"照片"yyyymmddhhnnsszzz',Now)+'.bmp')));
end
else
begin
ShowMessage('请按捕获按钮,然后才能拍照');
end
end;
end.