2018/5/27
表示画像の各種画像ファイルへの保存追加
Webカメラ「AVICAP32.DLL」の利用
Webカメラを利用する為のDLLが Win2000の時代から、AVICAP32.DLLが、Window OSに組み込まれています。
これを利用する事で簡単に、Webカメラの画像をパソコンに表示することが出来ます。
古くからあるので、インターネットで探せば、使用例が見つかりますが、どの様なものか確認をしてみました。
Webカメラ用のソフトは、OSに組み込まれているので、一般的な使用には、特に作る必要はないのですが、画像による測定に利用するには、一番安価な方法なので、取り上げてみました。
Webカメラは安価です。
Webカメラは、バッファローの"BSWHD06M" で、 1280×960：12fps、1280×720：30fps、640×480：30fps、640×360：30fps、352×288：30fps、320×240：30fps、176×144：30fps、160×120：30fps となっています。
AVICAP32.DLLを使用した場合、1280×960の解像度については、設定方法が悪いのか動作しませんでした。
DirectXを使用した例がインターネット上に有ったので、ダウンロードしてテストした結果、1280×960で動作しましたので、AVICAP32.DLLの制限かと思われます。
OpenCVでも1280×960の解像度で動作します。
WM_CAP_DLG_VIDEOFORMATを利用して、確認した結果、AVICAP32.DLLのデフォルト設定は、640×480が最大の解像度となっていました。
Delphiで画像の編集をするには、Delphiのビットマップにする必要がありますが、AVICAP32.DLLを利用してカメラの画像を編集用に取り込む方法としては、クリップボードにコピーし、クリップボードから貼り付ける方法と、実行表示画面から、コピーする方法があります。
表示画面からビットマップをコピーする場合は、Form か Panelに表示しておいて、そのビットマップをTbitmapにコピーします。
DirectXを使用して、画像を表示するプログラムは、http://www.delphibasics.info/home/delphibasicsprojects/directxdelphiwebcamcaptureexample からサンプルプログラムがダウンロードできます。
Delphi2007用なので、XE の場合 Char -> ansiChar に注意すれば、容易に動作します。
サンプルプログラム
動画保存中は、マウスカーソルが、矢印から待ち時間のアイコンに替わりますが、そのまま、停止のボタンをクリックすれば、動画として保存されます。
又、動画保存中は表示画像が乱れます。
ドライバーのバージョン取得用 capGetDriverDescription の wDriverIndex の値がインターネットで調べると、WORD となっていますが、実際にはDWORD (Cardinalと同じ) に設定しないと正常に動作しません。
サンプルプログラムは、Delphi XE7で、UniCoadなので external 'AVICAP32.DLL' name '**********W'を呼び出しています。
プログラム
unit unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, StrUtils, Clipbrd, Vcl.Buttons,
Vcl.ExtDlgs, system.UITypes;
type
TForm1 = class(TForm)
btnConnectClick: TButton;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Image1: TImage;
Button5: TButton;
SavePictureDialog1: TSavePictureDialog;
Button6: TButton;
ListBox1: TListBox;
GroupBox1: TGroupBox;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
RadioButton3: TRadioButton;
Panel1: TPanel;
Button7: TButton;
procedure btnConnectClickClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
const
WM_CAP_DRIVER_CONNECT = WM_USER + 10;
WM_CAP_DRIVER_DISCONNECT = WM_USER + 11;
WM_CAP_FILE_SET_CAPTURE_FILEA = WM_USER + 20;
WM_CAP_SAVEDIB = WM_USER + 25;
WM_CAP_SEQUENCE = WM_USER + 62;
WM_CAP_GRAB_FRAME = WM_USER + 60;
WM_CAP_SEQUENCE_NOFILE = WM_USER + 63;
WM_CAP_EDIT_COPY = WM_USER + 30;
WM_CAP_SET_OVERLAY = WM_USER + 51;
WM_CAP_SET_SCALE = WM_USER + 53;
WM_CAP_SET_PREVIEWRATE = WM_USER + 52;
WM_CAP_SET_PREVIEW = WM_USER + 50;
WM_CAP_STOP = WM_USER + 68;
WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_USER + 6;
WM_CAP_SET_CALLBACK_ERROR = WM_USER + 2;
WM_CAP_SET_CALLBACK_STATUSA = WM_USER + 3;
WM_CAP_SET_CALLBACK_FRAME = WM_USER + 5;
WM_CAP_GET_VIDEOFORMAT = WM_USER + 44;
WM_CAP_SET_VIDEOFORMAT = WM_USER + 45;
WM_CAP_DLG_VIDEOSOURCE = WM_USER + 42;
WM_CAP_DLG_VIDEOFORMAT = WM_USER + 41;
WM_CAP_DLG_VIDEODISPLAY = WM_USER + 43;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
CaptureWnd : HWND;
Filename : ansistring;
lpBmpInfo : Bitmapinfo;
CaptureWidth : integer;
CaptureHeight: integer;
ViewWidth : integer;
ViewHeight : integer;
// バッファサイズが確保できないのか
// CaptureWidth :integer = 1280; // NG
// CaptureHeight :integer = 960;
const
str_Connect = 'Webカメラに接続';
str_Disconn = '接続解除';
CaptureLeft = 0;
CaptureTop = 0;
SaveFileFilter =
'画像ファイル|*.png;*.jpg;*.gif;*.bmp;*.tif;*.wdp' +
'|*.png|*.png' +
'|*.jpg|*.jpg' +
'|*.gif|*.gif' +
'|*.bmp|*.bmp' +
'|*.tif|*.tif' +
'|*.wdp|*.wdp';
function capCreateCaptureWindow(WindowName: PChar;
dwStyle: Cardinal; x,y, nWidth,nHeight: Integer;
ParentWin: HWnd; nID: Integer): HWnd; stdcall;
external 'AVICAP32.DLL' name 'capCreateCaptureWindowW';
function capGetDriverDescription(wDriverIndex: DWORD;
lpszName: LPWSTR; cbName : integer;
lpszVer : LPWSTR; cbVer : Integer): Boolean; stdcall;
external 'AVICAP32.DLL' name 'capGetDriverDescriptionW';
procedure TForm1.btnConnectClickClick(Sender: TObject);
begin
if (Sender as TButton).Caption = str_Connect then begin
if RadioButton1.Checked then begin
CaptureWidth := 1280; // ok
CaptureHeight := 720;
ViewWidth := 640;
ViewHeight := 360;
end;
if RadioButton2.Checked then begin
CaptureWidth := 640; // ok
CaptureHeight := 480;
ViewWidth := 480;
ViewHeight := 360;
end;
if RadioButton3.Checked then begin
CaptureWidth := 640; // ok
CaptureHeight := 360;
ViewWidth := 640;
ViewHeight := 360;
end;
Panel1.Width := ViewWidth;
Panel1.Height := ViewHeight;
// デバイスの設定とハンドルの取得 画像の出力先panel1
CaptureWnd := capCreateCaptureWindow('Window',
WS_CHILD or WS_VISIBLE, CaptureLeft, CaptureTop,
CaptureWidth, CaptureHeight, Panel1.Handle, 0);
if CaptureWnd <> 0 then begin
// SendMessage(CaptureWnd, WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0, 0);
// SendMessage(CaptureWnd, WM_CAP_SET_CALLBACK_ERROR, 0, 0);
// SendMessage(CaptureWnd, WM_CAP_SET_CALLBACK_STATUSA, 0, 0);
//デバイスへの接続
SendMessage(CaptureWnd, WM_CAP_DRIVER_CONNECT, 0, 0);
// カメラ画像の調整
// SendMessage(CaptureWnd, WM_CAP_DLG_VIDEOSOURCE, 0, 0);
// カメラの解像度とフォーマットの指定
// WM_CAP_DLG_VIDEOFORMATは、4:3 で最大サイズ640×480です。
// SendMessage(CaptureWnd, WM_CAP_DLG_VIDEOFORMAT, 0, 0);
// Video フォーマットの取得
SendMessage(CaptureWnd, WM_CAP_GET_VIDEOFORMAT, sizeof(lpBmpInfo), Cardinal(@lpBmpInfo));
// 解像度の設定
with lpbmpInfo.bmiHeader do begin
biWidth := CaptureWidth;
biHeight := CaptureHeight;
biSizeImage := biWidth * biHeight * biBitCount div 8;
// biCompression := BI_RGB;
end;
// Video フォーマットの設定
SendMessage(CaptureWnd, WM_CAP_SET_VIDEOFORMAT, sizeof(lpBmpInfo), Cardinal(@lpBmpInfo));
//プレビュースケール 変倍有効設定
SendMessage(CaptureWnd, WM_CAP_SET_SCALE, 1, 0);
//プレビューのコマ数（ミリ秒）
SendMessage(CaptureWnd, WM_CAP_SET_PREVIEWRATE, 35, 0);
// 表示サイズの指定
SetWindowPos(CaptureWnd, HWND_BOTTOM, 0, 0,
ViewWidth, ViewHeight,
SWP_NOMOVE or SWP_NOZORDER);
// プレビュー開始
SendMessage(CaptureWnd, WM_CAP_SET_PREVIEW, 1, 0);
end;
(Sender as TButton).Caption:= str_Disconn
end
else begin
if CaptureWnd <> 0 then begin
// デバイスへの接続解除
SendMessage(CaptureWnd, WM_CAP_DRIVER_DISCONNECT, 0, 0);
// CaptureようWindowの破棄
DestroyWindow(CaptureWnd);
// ハンドルのクリア
CaptureWnd := 0;
(Sender as TButton).Caption:= str_Connect;
end;
end;
end;
// クリップボードへコピー
procedure TForm1.Button1Click(Sender: TObject);
begin
if CaptureWnd <> 0 then
SendMessage(CaptureWnd, WM_CAP_EDIT_COPY, 1, 0 );
end;
// ファイルへ保存
// SendMessageで送るファイル名はAnsiStringの必要があります。
procedure TForm1.Button2Click(Sender: TObject);
begin
if CaptureWnd <> 0 then begin
SavePictureDialog1.Filter := '画像ファイル|*.bmp';
if SavePictureDialog1.Execute then begin
Filename := ansistring(ChangeFileExt(SavePictureDialog1.FileName,'.bmp'));
end
else exit;
SendMessage(CaptureWnd, WM_CAP_SAVEDIB, 0, Cardinal(pAnsiChar(Filename)));
end;
end;
// ファイルへの動画保存開始
// SendMessageで送るファイル名はAnsiStringの必要があります。
procedure TForm1.Button3Click(Sender: TObject);
begin
if CaptureWnd <> 0 then begin
SavePictureDialog1.Filter := '動画ファイル|*.avi';
if SavePictureDialog1.Execute then begin
Filename := ansistring(ChangeFileExt(SavePictureDialog1.FileName,'.avi'));
end
else exit;
SendMessage(CaptureWnd, WM_CAP_FILE_SET_CAPTURE_FILEA, 0, Cardinal(pAnsichar (Filename)));
SendMessage(CaptureWnd, WM_CAP_SEQUENCE, 0, 0);
end;
end;
// 動画保存の停止
procedure TForm1.Button4Click(Sender: TObject);
begin
if CaptureWnd <> 0 then
SendMessage(CaptureWnd, WM_CAP_STOP, 0, 0);
end;
// クリップボードから画像貼り付け
procedure TForm1.Button5Click(Sender: TObject);
var
bitmm: TPicture;
begin
if Clipboard.HasFormat(CF_DIB) then begin
bitmm := TPicture.Create;
try
bitmm.Bitmap.Assign(Clipboard);
Image1.Canvas.StretchDraw(rect(0, 0, CaptureWidth div 4, CaptureHeight div 4), bitmm.Bitmap);
finally
bitmm.Free;
end;
end;
end;
// ドライバーバージョンの取得
procedure TForm1.Button6Click(Sender: TObject);
var
Indx : Cardinal;
szName, szVersion: array[0..MAX_PATH] of Char;
begin
ListBox1.Clear;
for Indx := 0 to 9 do begin
if capGetDriverDescription(Indx, @szName, sizeof(szName), @szVersion, sizeof(szVersion)) then begin
ListBox1.Items.Add(szName + ' (' + szVersion + ')');
end;
end;
end;
// Panle1に表示している画像をそのままコピーしてファイルに保存します。
// ファイル形式はWICでサポートしている全ての種類です。
procedure TForm1.Button7Click(Sender: TObject);
label
FEXIT;
var
srcDC : HDC;
Bmp : TBitmap;
cBMP : HBITMAP;
WIC : TWicImage;
WICF : TWicImageFormat;
Fname : String;
ExeStr : String;
FnameTop: String;
Findex : integer;
function WFormatSet: Boolean; // 拡張子によるファイルフォーマット設定
begin
Result := false;
ExeStr := LowerCase(ExeStr);
if ExeStr = '.jpg' then begin WICF := Wifjpeg; Result := True; end;
if ExeStr = '.jpeg' then begin WICF := Wifjpeg; Result := True; end;
if ExeStr = '.tif' then begin WICF := Wiftiff; Result := True; end;
if ExeStr = '.tiff' then begin WICF := Wiftiff; Result := True; end;
if ExeStr = '.png' then begin WICF := Wifpng; Result := True; end;
if ExeStr = '.gif' then begin WICF := Wifgif; Result := True; end;
if ExeStr = '.bmp' then begin WICF := Wifbmp; Result := True; end;
if ExeStr = '.wdp' then begin WICF := WifWMPhoto; Result := True; end;
if ExeStr = '.hdp' then begin WICF := WifWMPhoto; Result := True; end;
end;
begin
// Bitmapを準備
Bmp := TBitmap.Create;
cBMP := 0;
try
srcDC := GetDC(Panel1.Handle);
// サイズ設定 フォーマットが分からない場合はコンパチ設定
// サイズを指定したハンドルを生成して、それをBitmapハンドルに代入します
cBMP := CreateCompatibleBitmap(srcDC, ViewWidth, ViewHeight);
Bmp.Handle := cBMP;
// フォーマットコンパチの場合はサイズのみ指定で可
// Bmp.Width := ViewWidth;
// bmp.Height := ViewHeight;
try
// Bitmapに画像をコピーします
BitBlt(Bmp.Canvas.Handle, 0, 0, ViewWidth, ViewHeight, srcDC, CaptureLeft, CaptureTop, SRCCOPY);
finally
ReleaseDC(Panel1.Handle, srcDC);
end;
SavePictureDialog1.Filter := SaveFileFilter;
// SavePictureDialog1.DefaultExt := GraphicExtension(TWicImage);
if not SavePictureDialog1.Execute then goto FEXIT;
ExeStr := ExtractFileExt(SavePictureDialog1.FileName);
if ExeStr = '' then begin // 拡張子がなかったら
Findex := SavePictureDialog1.FilterIndex; // FilterIndexによる拡張子の設定
case Findex of
1, 3 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.jpg'); // 拡張子の設定
2 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.png'); // 拡張子の設定
4 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.gif'); // 拡張子の設定
5 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.bmp'); // 拡張子の設定
6 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.tif'); // 拡張子の設定
7 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.wdp'); // 拡張子の設定
end;
end
else
Fname := SavePictureDialog1.FileName;
ExeStr := ExtractFileExt(Fname); // 拡張子だけ取り出し
if not WFormatSet then begin // 拡張子によるファイルフォーマット設定と確認
application.MessageBox('ファイルの拡張子が間違っています。','注意', 0);
goto FEXIT;
end;
FnameTop := ExtractFileName(Fname); // ファイル名だけ取り出し
if Length(FnameTop) = Length(ExeStr) then begin // ファイル名の長さ確認
application.MessageBox('ファイル名がありません。','注意', 0);
goto FEXIT;
end;
if FileExists(Fname) then // ファイル名によるファイル検索
if MessageDlg('既に同じ名前のファイルがあります上書きしますか ' + ExtractFileName(Fname) + '?',
mtConfirmation, [mbYes, mbNo], 0, mbNo) = IDNo then goto FEXIT;
WIC := TWicImage.Create; // TWicImage生成
try
WIC.Assign(Bmp); // TWicImageにビットマップデーター割り付け
WIC.ImageFormat := WICF; // 保存フォーマットセット
WIC.SaveTofile(Fname); // ファイルの書き出し
finally
WIC.Free; // TWicImage解放
end;
FEXIT:
finally
DeleteObject(cBmp);
Bmp.Free;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
top := (screen.Height - Height) div 2;
left := (screen.Width - Width) div 2;
btnConnectClick.Caption := str_Connect;
CaptureWnd := 0;
panel1.Caption := '';
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if CaptureWnd <> 0 then begin
SendMessage(CaptureWnd, WM_CAP_DRIVER_DISCONNECT, 0, 0);
DestroyWindow(CaptureWnd);
end;
end;
end.
Webcameradelphi.zip