戻る

ずっとUSBカメラって呼んでたんだけど、WEBカメラが正しい名前ともっぱらの噂。
このWEB、蜘蛛の巣ってのは、www、world wide webのWEB?
インターネットのこと?
でもこのてのカメラって、たぶん21世紀の初めか、へたをすると20世紀の終わりごろにはもうあったような気が。
そのころインターネット越しにこんなもの使ってた人がいたのかな。
光ケーブルどころかADSLだってそんなに行き届いてなかった時代でしょ。

なんてことはどうでもいいとして。

とりあえずボタン3つにテキストボックス1つ、それとイメージコントロール1つ、ならべてください(できればイメージコントロールは右下のほう。横:縦=4:3、サイズモードストレッチならなおよろし)
CommandButton1にキャプション"CameraStart"
CommandButton2にキャプション"SnapShot"
CommandButton3にキャプション"CameraStop"
こんなキャプション、べつに入れなくてもいいんですけど、まあ分かりやすいようにと。
TextBox1は空っぽのままうっかりCommandButton1押しちゃうと怒られるんで何か適当なデフォルト値を。
実のところ、ここに入れる値はマシンによってバラバラ。
つながってるカメラが1台だけで、なおかつそれが初めてつなぐ1台なら、たぶんゼロです。
あと勘違いされると困るんですけど、というか、じっさいこの段階だと勘違いする人がけっこういると思うんですけど、というか、勘違いされても実はさほど困りもしないんですけど、イメージコントロールはカメラとはあんまり関係ないです。
こんなもの貼り付けなくたってカメラの動作は確認できます。
撮影中のものをImage1に表示するわけじゃないんです。
表示する場所は、Accsessだったら開いているフォームそのもの、Excel、Wordだったらアプリそのもの。
Image1の使い道はまったく別なことです。
ま、細かいことは以下のコードを貼り付けて実行してから考えてください
(AccessでもExcelでもWordでもコードはほぼ一緒。"カメラ接続失敗"でも、TextBox1の値を1とか2とか変えていけばそのうち何とかなります。ついでに、ボタン貼り付けたりテキストボックス貼り付けたりコード貼り付けたりなんて面倒でやってられないと思ったら、こちらにアクセス、エクセル、ワード3種類の粗雑なサンプルがあります)


Option Compare Database '←Excel, Wordでは不要
Option Explicit

Private prvVarCaptureHandle As Long


Private Const WM_USER As Long = &H400
Private Const WM_CAP_START As Long = WM_USER
Private Const WM_CAP_DRIVER_CONNECT As Long = WM_CAP_START + 10
Private Const WM_CAP_DRIVER_DISCONNECT As Long = WM_CAP_START + 11
Private Const WM_CAP_SET_PREVIEW As Long = WM_CAP_START + 50
Private Const WM_CAP_SET_PREVIEWRATE As Long = WM_CAP_START + 52
Private Const WM_CAP_FILE_SAVEDIBA = WM_CAP_START + 25
Private Const WS_CHILD = &H40000000
Private Const WS_VISIBLE = &H10000000


Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
                (ByVal lpClassName As String, _
                ByVal lpWindowName As String) As Long 'Accessでは不要

Private Declare Function DestroyWindow Lib "user32" (ByVal hndw As Long) As Boolean

Private Declare Function capCreateCaptureWindow Lib "avicap32.dll" Alias "capCreateCaptureWindowA" _
                (ByVal lpszWindowName As String, _
                ByVal dwStyle As Long, _
                ByVal X As Long, _
                ByVal Y As Long, _
                ByVal nWidth As Long, _
                ByVal nHeight As Long, _
                ByVal hwndParent As Long, _
                ByVal nID As Long) As Long

Private Declare Function SendMessageAsLong Lib "user32" Alias "SendMessageA" _
                (ByVal hwnd As Long, _
                ByVal wMsg As Long, _
                ByVal wParam As Long, _
                ByVal lParam As Long) As Long
                
Private Declare Function SendMessageAsString Lib "user32" Alias "SendMessageA" _
                (ByVal hwnd As Long, _
                ByVal wMsg As Long, _
                ByVal wParam As Long, _
                ByVal lParam As String) As Long


Private Sub CommandButton1_Click()
    Dim MyHandle As Long

    MyHandle = Me.hwnd  'Accessの場合
    MyHandle = FindWindow("XLMAIN", "Microsoft Excel - " & "現在作成中の「このファイル」の名前" & ".xls") 'Excelの場合  
    MyHandle = FindWindow("OpusApp", "Microsoft Word - " & "現在作成中の「このファイル」の名前" & ".doc") 'Wordの場合
    'Access以外の2つについては、FindWindow("OpusApp", "現在作成中の「このファイル」の名前"  & ".doc - Microsoft Word")
    'なんて形になることもあったりして。
    'たぶんMSOfficeのバージョン、Windowsのバージョンによる。
    'タスクマネージャの「アプリケーション」にどういう名前で表示されているか、見てもらうしかない。

    prvVarCaptureHandle = capCreateCaptureWindow("", WS_VISIBLE Or WS_CHILD, 0, 0, 320, 240, MyHandle, 0)
    If prvVarCaptureHandle = 0 Then
        MsgBox "表示画面作成失敗", vbOKOnly, "残念"
        Exit Sub
    End If
    If SendMessageAsLong(prvVarCaptureHandle, WM_CAP_DRIVER_CONNECT, Int(Me.TextBox1.Value), 0) = 0 Then
        Call DestroyWindow(prvVarCaptureHandle)
        prvVarCaptureHandle = 0
        MsgBox "カメラ接続失敗", vbOKOnly, "残念"
        Exit Sub
    End If
    Call SendMessageAsLong(prvVarCaptureHandle, WM_CAP_SET_PREVIEWRATE, 66, 0)
    Call SendMessageAsLong(prvVarCaptureHandle, WM_CAP_SET_PREVIEW, 1, 0)
End Sub

Private Sub CommandButton2_Click()
    Dim MyStrFile As String

    If prvVarCaptureHandle <> 0 Then

        MyStrFile = CurrentProject.Path & "\" & "tmp" & Format(Time, "hhnnss") & ".bmp" 'Accessの場合
        MyStrFile = ThisWorkbook.Path & "\" & "tmp" & Format(Time, "hhnnss") & ".bmp" 'Excelの場合
        MyStrFile = ActiveDocument.Path & "\" & "tmp" & Format(Time, "hhnnss") & ".bmp" 'Wordの場合
        
        Call SendMessageAsString(prvVarCaptureHandle, WM_CAP_FILE_SAVEDIBA, 0, MyStrFile)

        Image1.Picture = MyStrFile 'Accessの場合
        Image1.Picture = LoadPicture(MyStrFile) 'Excel, Wordの場合
    End If
End Sub

Private Sub CommandButton3_Click()
    If prvVarCaptureHandle <> 0 Then
        Call SendMessageAsLong(prvVarCaptureHandle, WM_CAP_DRIVER_DISCONNECT, Int(Me.TextBox1.Value), 0)
        Call DestroyWindow(prvVarCaptureHandle)
        prvVarCaptureHandle = 0
    End If
End Sub


Accessだとフォームでタイマーが使えるので数秒おきにスナップショットが自動でとれます(Word、Excelではたぶん無理)
これを応用すると監視カメラみたいなものがつくれる(ほんの一例 作成に使ったAccessのバージョンは2000。他のバージョンで動かなかったらごめんなさい)

注意しなきゃならないのはハードディスクの容量。
今どきハードディスクがパンクしてえらい目にあったなんて人はそんなにいませんよね。
これを使うと比較的簡単に経験できます。

使うカメラにもよりまけど、たとえば640 X 480のbitmap画像なら1枚あたり約1.2MB、5秒おきの撮影で1時間に720枚すなわち840MB、1日10時間動かすとして約8.5GM、ハードディスクの残が20GBのマシンなら3日目あたりに面白いことが起こる。

なんでbitmapなんだ。バカじゃねーの。jpegにすれば10分の1ぐらいになるじゃん、と。
はいはい、私が悪うございました。
AccessVBAだけでbitmap→jpeg変換をする技量は自分にはありません。
doodleなんとかいう他人様作のdll(もちろんWEB上での拾い物)の力を借りれば、どうにかVBAでも出来るのは確認済みなんですけど。

撮影のたびにやらせる処理だと思うと、何となく気が乗らない。
4秒5秒おきに延々、撮影→圧縮処理→保存って、どうなんでしょ。
実際には大したことないのかもしれないですけどね(そのあたりの機械の事情って全然知らない)

いいんじゃないですか、bitmapのままで。
jpeg化したっていつかはパンクするんですよ。
それがちょっと延びるだけじゃないですか。

そんなことより、ある程度日数の経った画像を自動的に削除するほうに神経使ったほうがいいような気がします。
例としてアップしたものには仕込んでませんけど、コード書きとしてはそんなに面倒じゃありません。
このあたりを参考にどうぞ(VBSのコードはほぼそのままVBAでも通用します)

それにしてもMSOfficeってのは凄いアプリ群ですね。
ただの伝票整理ソフト、チラシ作成ソフト、販売管理ソフトと割り切っちゃうのはあまりにももったいない。
ここから別の新たなソフトがつくれる、立派なプログラミングツールだと思います。
(特にフォームとデータベースが楽に使えるAccessは強力)

極端な話、VBAでゲームをつくったり、その気になれば画像を直にいじくりまわすことも可能(らしい)。
といってもWindowsAPIを呼び出すケースが多く、そこまで深入りするならプログラミングツールとしてもう少し体裁の整ったものを使ったほうが楽なんじゃないかという気もしたりしなかったり。

というわけで、Delphiで同じようなものをつくってみたんですけど、手間はさほど変わりませんでした(なんてこったい)
監視カメラソフトの製品というかEXEファイルはこちら
ソースファイルはこちら(Delphi持ってない人は使えない。ただpasファイルのコードはメモ帳で読める)

こっちには、古い画像ファイルを自動的に削除するコードも仕込んであります。
(起動時に働く。削除画像がたくさんあると、クリックしてから画面が現れるまでけっこう時間がかかります。それによってどういうことが起こるかというと、イラついたあげく再度クリック再々度クリックで二重起動三重起動。そのへんのところは注意するか工夫するかしてください。工夫ってのはつまり多重起動防止の仕掛け。面倒なので解説は省略しますけど、何とかやりようはあります。ただ本音をいっちゃえば、多重起動したから何なのさ、致命的なトラブルが起こるわけでもないじゃん、よくあるただのメモリ無駄食いじゃん、と)

Accsess版、Delphi版ともに撮影した画像は一時間ごとに別フォルダに保存させるようにしました。
ひとつのフォルダに全部放り込んじゃうと、サムネイル(カタログ風の縮小画像)一覧表示が困難になる、というかへたをするとマシンがフリーズする恐れがありますんで(サムネイル表示機能をつけたのはDelphi版だけ。Access版にはつけられそうにない)
ただそれだって5秒おきの撮影なら一時間あたり720枚。
縮小画像一覧表示にはえらい時間がかかります(640X480, 32bit, 1.2MBX720枚、CPU1200MHZ、メモリ384MBのマシンで75秒)
表示のために仕込んだこちらのコードがどんくさいせいかもしれません。

画像閲覧に関しては遥かに優秀なフリーソフトが沢山あるんで、そっちを使ったほうがいいような気もします(個人的にはVectorで見つけたVIXという無料ソフトを愛用。これは一覧表示もめちゃめちゃ速い。いったいどんなコードを仕込んだのか、と、いや、教えてもらったところで理解できませんけど。あちらさんはDelphiみたいなお手軽ツールじゃなくCだかC++使ってるらしいんで)

ついでにちょっと実験のつもりで、撮影保存されたbitmapファイルを一気にまとめてjpegにする機能もつけました(Delphi版のみ)
これは使っても使わなくてもという感じ。
とんでもない枚数の画像ファイルを相手にすることになるわけで、かなり時間を食います。

所要時間ってのはたぶん画像の枚数よりもファイルサイズの合計に比例するんだろうなと、まあ漠然とした想像ですが。
1.2MB X 720枚=840MBで大体135秒、というのが大雑把な実験結果(サイズは840MBから141MBまで激減)

しょぼいマシンによる実験結果とはいえ、たかだか840MBで(この場合は本当に「たかだか」です)135秒もかかるってのはかなり恐ろしい話です。
あとは勝手に計算して勝手に想像して勝手に震え上がってくださいとしかいいようのない恐ろしさです。
jpeg化なんてどうでもいいという気持ちになってきます。


ところで〜
サムネイルを表示やjpeg圧縮にかかる時間を測定した上記の実験には、実際にカメラで撮影した画像を使っていません(カメラってのはたぶん\2,000か\3,000程度で買えるんでしょうけど、自宅には持っていない)
即席でつくったソフトから、適当な色柄をつけたbitmapを自動的に吐き出させました。
(→こちら。カメラソフトと同じフォルダ中に置いて使うと、撮影した場合と同様のファイル名で一気に大量の画像をつくります)

本当にテキトーなbitmapなので、圧縮率その他の数値は、実際の写真画像とは多少違ってくるかもしれません。
いや、本当に言いたいのはそんなことじゃなく、このbitmap自動吐き出しソフト作成がけっこう面白かったという話。
正確にいうと、作成作業自体が面白かったわけじゃなく、つくりながら別な面白い使い道を考えてたんです。
どんな使い道かといえば、「ハードディスクの残りスペースを短時間のうちに無意味なファイルで埋め尽くす」ってこと。