Windows7-VB6でのアクティブウィンドウキャプチャ

質問

Windows7-VB6でのアクティブウィンドウキャプチャ

お世話になります。

Private Declare Sub keybd_event Lib "User32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Const VK_LMENU = &HA4
Private Const VK_SNAPSHOT = &H2C

Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2
Private Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)

Private Sub Command1_Click()

Command1.SetFocus
DoEvents

Load form2

Clipboard.Clear
keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0

DoEvents

keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0
keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0

※form2.picPrint.Picture = Clipboard.GetData()

上記コードはWinXPであれば問題なく動作するのですが
Win7ではform2のピクチャボックスにイメージが貼り付けられません
※行にブレイクを入れて、一旦プログラムを停止し再開するとOKで
その他にもALTキーの送信をしないでprtscrのみでも動作可能です。

win7-vb6でアクティブウィンドウのキャプチャを
クリップボードを使用し、フォームのピクチャボックスに貼り付けることは
可能でしょうか

回答No.1

vbhanatyan · ベストアンサー

Windows 7 の場合 PC によって Shift キーを併用しないとprtscr が動作しない等があります。
今回のように、行にブレイクを入れて、一旦プログラムを停止し再開するとOK との事なら
下記のように待ち時間を作ってやれば 多分 取得できるはずです。
待ち時間は、PC の性能によって変わってきますので、0.1 ～ 1.0 位の間で調整して見て下さい

クリップボードにコピーしてから、取得するまでの間にも入れるようにして下さい。
(クリップボードに書き込みされる前に読みにいっている可能性があります)
後は、様子を見ながら、DoEvents を書いているところに入れて見る等試してみて下さい。

Dim sngSt As Single
sngSt = Timer
Do While Timer - sngSt < 0.5
　　DoEvents
Loop

お礼

花ちゃん様

ご回答ありがとうございます。
頂いたコードをピクチャボックスに貼り付ける直前に行うことで解決しました。
当方でも取得するまでに時間がかかるのでは、と思いつき
同じ場所でsleepやloopによる待機を行ったのですがうまくいきませんでした。

ちなみに上記コードだとDo While内のDoEventsが通常1回しか実行されませんが
問題なく動作します。
同様にLoopをなくしてDoEventsを単体で実行させると動作しなくなりますが
その違いが理解できませんでした。

本題と離れてしまいますが、教えていただけると幸いです

回答No.3

vbhanatyan

実際の状況に近い状態の確認ならこちらの方が。

Private Sub Command1_Click()
Dim sngSt As Single
sngSt = Timer
Dim n As Long

Do While Timer - sngSt < 0.1 '0.5秒間ループを繰り返す(0,5秒間待機する)
DoEvents
n = n + 1
Loop
Debug.Print n
End Sub

これで、どの位 DoEvents が実行されたか解りましたか？
本来は、DoEvents や sleep 等は使用すべきではありませんが、多用しなかったり、ご自分の
ソフト内で問題が起きない範囲内なら...。

回答No.2

vbhanatyan

>ちなみに上記コードだとDo While内のDoEventsが通常1回しか実行されませんが
>問題なく動作します。
1回しか実行されないってどのようにして確認しましたか？
そもそも何をしているのか理解されていないような。

>同様にLoopをなくしてDoEventsを単体で実行させると動作しなくなりますが
>その違いが理解できませんでした。
下記を試して見て下さい。
Private Sub Command1_Click()
　　Dim sngSt As Single
　　sngSt = Timer
　　Do While Timer - sngSt < 0.5　　'0.5秒間ループを繰り返す(0,5秒間待機する)
' DoEvents
　　　　Debug.Print "AAAA"
　　Loop
End Sub
0.5 の所を 1.0 とか 0.1 とかに変えてどのように変化するとかも見ておいて下さい。