ExcelVBAで透明画面を追従させたい

質問

ExcelでUSBカメラのライブ画像を表示して、ボタンが押されたときに画像を取り込み画像処理して結果を表示するマクロを作成しています。

ライブ画像の上に透明画面をかぶせて十字線を表示しているのですが、Excelの画面を移動するとライブ画像は一緒に移動しますが、透明画面は移動せずExcel画面の外にはみ出してしまいます。

透明画面もExcel画面と一緒に移動させるにはどうすればよいでしょうか。

現在は次のようにマクロを作成しています。

1. 「ActiveMovie control type library」を参照設定してUSBカメラのライブ画像を表示・取り込み。

2. CreateWindowExにより透明画面作製。背景はNULL_BRUSH。スタイルはWS_POPUP。親ウィンドウはExcel。

3. 十字線はWM_PAINTで描画。

なお、透明画面のスタイルをWS_CHILDにすればExcel画面と一緒に移動しますが、ライブ画像(ActiveMovie)の下になってしまうため十字線が見えなくなります。

回答No.5

mitarashi

#4です。
フレームをもう一個作って、背景に十字線画像を読み込んで、 SetLayeredWindowAttributesでクロマキーをやってみたらどうかとか、
画像をワークシートに貼り付けて透明色を指定でやったらどうかとか試してみましたが、いずれもNGでした。
という事で、残念ながらギブアップです。
最初に戻ってCBT フックとか、出来ても不安定だろうからC++でActiveXExeを作ってやって、CBTフックしてエクセルにイベントを渡そうなどと妄想は膨らみますが、実力が伴わないので、このあたりで失礼させていただきます。

お礼

いろいろとアドバイスを頂き、ありがとうございます。

また何かアイデアがありましたら、よろしくお願いします。

回答No.4

mitarashi

#3です。
>WS_POPUP を削除すればよいと思います。

ご指摘の通りでした。ありがとうございました。
今夜はそれ以上時間がとれませんので、とりあえずご報告まで。

回答No.3

mitarashi

#1,2です。当然TOPMOSTは試されましたね？
当方、それ以前に子ウィンドウにならないでお手上げです。
逆に質問させていただいてしまいますが、下記でどこか勘違いがあるのでしょうか？
よかったら教えて下さい。

With myWinClass
.cbSize = Len(myWinClass)
.style = CS_HREDRAW Or CS_VREDRAW Or CS_GLOBALCLASS
.lpfnWndProc = FunctionPointer(AddressOf WindowProc)
.cbClsExtra = 0&
.cbWndExtra = 0&
WindowFromObject Sheets(1).Frame1, hFrame
'Debug.Print "hFrame:", hFrame '取得できています
frameInstance = GetWindowLong(hFrame, GWL_HINSTANCE)
.hInstance = frameInstance
.hIcon = LoadIcon(frameInstance, IDI_APPLICATION) '0&にしてみても同じでした
.hCursor = LoadCursor(frameInstance, IDC_ARROW) '同上
.hbrBackground = GetStockObject(WHITE_BRUSH)
.lpszMenuName = 0&
.lpszClassName = CLASSNAME
.hIconSm = LoadIcon(frameInstance, IDI_APPLICATION)
End With
RegisterClassEx myWinClass

hWnd = CreateWindowEx(WS_EX_TOPMOST, CLASSNAME, TITLE _
, WS_CHILD Or WS_POPUP Or WS_VISIBLE Or WS_BORDER Or WS_OVERLAPPEDWINDOW , 0, 0, 320, 240, hFrame, 0&, frameInstance, 0&)
ShowWindow hWnd, SW_SHOWNORMAL
UpdateWindow hWnd

補足

> 当然TOPMOSTは試されましたね？
SetWindowPos でライブ画面を透明画面の後ろにしていますが、うまくいきません。

念のため TOPMOST を試してみましたが、だめでした。

> 当方、それ以前に子ウィンドウにならないでお手上げです。
WS_POPUP を削除すればよいと思います。

下記を参照してください。

http://msdn.microsoft.com/ja-jp/library/czada357(v=vs.90).aspx

WS_CHILD 子ウィンドウを作成します。WS_POPUP スタイルと一緒に使うことはできません。

回答No.2

mitarashi

#1です。ぼちぼちと調べて遊んでおりました。
Webカメラの画像をVBAで表示する方法はみつけたのですが、ワークシートに載せ替えようと思うと、Excelのクライアント座標がなんだか腑に落ちないので、ハンドルが取得可能なフレームをワークシートに置いてやってみました。 CreateWindowExにより作成する透明Windowもこのフレームの子ウィンドウにするのはいかがでしょうか。ちょっとトライしてみましたが、簡単にはいきそうもないのでアイデアのみに止めます。（もしトライしてうまくいったら教えて下さい。）

'http://i-break.net/article/69427813.html '出典
Private CapHandle 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 WM_CAP_SET_SCALE As Long = WM_CAP_START + 53
Private Const WS_CHILD = &H40000000
Private Const WS_VISIBLE = &H10000000
Private Const SWP_NOMOVE As Long = &H2
Private Const SWP_NOSIZE As Integer = 1
Private Const SWP_NOZORDER As Integer = &H4
Private Const HWND_BOTTOM As Integer = 1

Private Declare Function WindowFromObject Lib "oleacc" Alias "WindowFromAccessibleObject" (ByVal pacc As Object, phwnd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
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 Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Type POINTAPI
x As Long
y As Long
End Type

Private Const PPI As Long = 72
Private Const DPI As Long = 96

Dim MyHandle As Long
Private Const cameraNo As Long = 0

Private Sub CommandButton1_Click()
Dim camTop As Long
Dim camLeft As Long

WindowFromObject Me.Frame1, MyHandle
CapHandle = capCreateCaptureWindow("", WS_VISIBLE Or WS_CHILD, 0, 0, 1280, 1024, MyHandle, 0)

If CapHandle = 0 Then
MsgBox "作成失敗", vbOKOnly, "エラー"
Exit Sub
End If

' Connect to device
If SendMessageAsLong(CapHandle, WM_CAP_DRIVER_CONNECT, cameraNo, 0) = 0 Then
Call DestroyWindow(CapHandle)
CapHandle = 0
MsgBox "接続失敗", vbOKOnly, "エラー"
Exit Sub
End If

'Set the preview scale
Call SendMessageAsLong(CapHandle, WM_CAP_SET_SCALE, 1, 0)

'Set the preview rate in milliseconds
Call SendMessageAsLong(CapHandle, WM_CAP_SET_PREVIEWRATE, 66, 0)

'Start previewing the image from the camera
Call SendMessageAsLong(CapHandle, WM_CAP_SET_PREVIEW, 1, 0)

SetWindowPos CapHandle, HWND_BOTTOM, 0, 0, 320, 240, SWP_NOZORDER

End Sub

Private Sub CommandButton3_Click()
If CapHandle <> 0 Then
' Disconnect from device
Call SendMessageAsLong(CapHandle, WM_CAP_DRIVER_DISCONNECT, cameraNo, 0)

' close window
Call DestroyWindow(CapHandle)
CapHandle = 0
End If
End Sub

'フレームの設定
Private Sub frameSetting()
With Me.Frame1
.Caption = ""
.SpecialEffect = fmSpecialEffectFlat
.BackColor = &HFFFFFF
.Width = CLng(320 * PPI / DPI)
.Height = CLng(240 * PPI / DPI)
End With
End Sub

お礼

詳細に説明していただきありがとうございます。

回答して頂いたように VideoForWindows を使い、フレームの子画面として透明画面を作成しましたが、やはり透明画面はキャプチャ画面の下になってしまいました。

回答No.1

mitarashi

試しにやってみた事はありますが、VBAからCreateWindowExで作成したWindowの実用例を初めて知りました。感服。当方よりスキルが高い方に対してお役に立つかどうか不明ですが、ライブ画像がセル基準でおかれているなら、ライブ画像の左上隅のセルをスクリーンの座標に変換し、それに合わせて透明Windowを設定する事はできないでしょうか。どんなイベントでというのは分かりかねます。
http://home.att.ne.jp/zeta/gen/excel/c04p06.htm

面白そうなので、下記をみつけて試そうと思いましたが、ActiveMovie control type libraryの参照設定でエラーになって出来ませんでした。（当方Windows7Home 64bit）。残念。
http://tanlab.blog.fc2.com/blog-entry-25.html

お礼

回答して頂きありがとうございます。

ライブ画像はセルの位置をスクリーン座標に変換して設定しています。

透明画面はライブ画像のハンドルから GetWindowRect で位置と大きさを取得して設定しています。

回答中にもあるように、適切なイベントがあればそのタイミングで透明画面の位置をライブ画像に一致させればいいのですが、、、