＠掲示板 ＠掲示板現在、一定時間が経過したらウィンドウを表示して通常の画面操作ができないようにロックする機能を作成しています。
MsgBox表示中にその機能が発生した場合、ロックする画面を閉じたらMsgBoxがアクティブではない状態になってしまいます。
それを解消するため、ロックする前にアクティブだったウィンドウのハンドルを取得(GetForegroundWindow)し、ロック解除後にそのウィンドウをアクティブにする(SetActiveWindow)処理を入れました。
これでMsgBoxをアクティブにすることができたのですが、MsgBoxを閉じたら下のウィンドウにフォーカスが無い状態になってしまいます。
SetActiveWindowを実行するとこの状態になってしまうのですが、解決する方法があるでしょうか。
状況説明が長くなってしまい、分かりづらいとは思いますがよろしくお願いします。環境はVB6です。
http://madia.world.coocan.jp/vb/vb_bbs2/200402_04020031.html
AttachThreadInput()でスレッドにアタッチする等は行っていますかね？
＞もげ様
参考URLありがとうございます。
現在これを元に調査中です。
>AttachThreadInput()でスレッドにアタッチする等は行っていますかね？
特にそういった処理は入れていないです。
GetForegroundWindowとSetActiveWindowくらいしか行っていません。
ウィンドウをアクティブにしている部分のソースを記載しておきます。
何か分かったことがありましたら教えていただけますでしょうか。
'***************************************************
Private Sub TimerLock_Timer()
Dim hForegroundWnd&, rc&
LockCnt% = LockCnt% + 1 'ロックタイムカウント
If LockCnt% >= G_BCLOCKTM& Then
LockCnt% = 0
'アクティブフォームのタイトルを取得
hForegroundWnd = GetForegroundWindow()
'画面をロックする
Load FrmScrLock
FrmScrLock.Show 1
'ロック前にアクティブだったウィンドウをアクティブにする
Call SetActiveWindow(hForegroundWnd)
End If
End Sub
'***************************************************
Win98以降、Win2000以降では、
以下の手順をふむことで、ご期待どおりの動作になるかと思われます。
http://support.microsoft.com/kb/97925/ja
http://www.ocv.ne.jp/~oratorio/junk/Sample/30/SetForegroundWindow.txt
URL先の情報を元に修正してみたのですが解決しませんでした。
修正したソースを記載しますので、おかしなところや気づいたことがあれば教えてください。
説明しきれていない気がするので改めて説明してみます。
MsgBoxを閉じると通常ならその下のフォームのテキストボックスにフォーカスが来るが、画面をロックする機能を解除した後だとフォーム自体はアクティブになっているがテキストボックスにフォーカスが無い状態になってしまい、キーボードを押しても何も反応しなくなってしまいます。
'***************************************************
Private Sub TimerLock_Timer()
Dim hForegroundWnd&
Dim ThreadID1 As Long
Dim ThreadID2 As Long
Dim LockTimeout As Long
LockCnt% = LockCnt% + 1 'ロックタイムカウント
If LockCnt% >= G_BCLOCKTM& Then
LockCnt% = 0
'現在ユーザーが作業しているウィンドウを取得
hForegroundWnd = GetForegroundWindow()
'スレッドIDを取得
ThreadID1 = GetWindowThreadProcessId(hForegroundWnd, ByVal 0&)
ThreadID2 = GetWindowThreadProcessId(App.ThreadID, ByVal 0&)
'スレッドIDが異なるならアタッチ
If ThreadID1 <> ThreadID2 Then
AttachThreadInput ThreadID2, ThreadID1, 1
End If
'現在のフォアグラウンドロックタイムアウトの設定を取得
SystemParametersInfo SPI_GETFOREGROUNDLOCKTIMEOUT, 0, LockTimeout, 0
'設定を 0ms に変更
SystemParametersInfo SPI_SETFOREGROUNDLOCKTIMEOUT, 0, ByVal 0&, 0
'従業員バーコード入力項目
Load FrmScrLock
FrmScrLock.Show 1
'フォアグラウンドウィンドウに設定
SetForegroundWindow hForegroundWnd
'フォアグラウンドロックタイムアウトの設定を戻す
SystemParametersInfo SPI_SETFOREGROUNDLOCKTIMEOUT, 0, ByVal LockTimeout, 0
'スレッドIDが異なるならデタッチ
If ThreadID1 <> ThreadID2 Then
AttachThreadInput ThreadID2, ThreadID1, 0
End If
End If
End Sub
'***************************************************
当方が勘違いしていたかもしれません。
MsgBoxはどこで出していますか？
モーダル表示している
> FrmScrLock.Show 1
がMsgBoxということでしょうか？
> '現在ユーザーが作業しているウィンドウ
というのは、同じVBプロジェクト内（同じプログラム内）にあるフォームでしょうか？
それともVBアプリに限らず、他のプログラムも対象になりますか？
もげ様
>MsgBoxはどこで出していますか？
MsgBoxはTimerが来る前に別の処理で表示されています。
このTimerはMDIフォームにあり、
プログラム実行から終了まで常に動いています。
MsgBoxが表示されている状態でTimerを通ってカウントを増やし、
規定カウント数を超えると「If LockCnt% >= G_BCLOCKTM& Then」
の内部処理に入ります。
>> FrmScrLock.Show 1
>がMsgBoxということでしょうか？
これは画面をロックするウィンドウを表示しています。
このウィンドウでパスワードを入力すればロックが解除されて、
その下の処理へ進むようになっています。
パスワードが入力されるまでここで処理は止まります。
>> '現在ユーザーが作業しているウィンドウ
>
>というのは、同じVBプロジェクト内（同じプログラム内）にあるフォームで>しょうか？
>それともVBアプリに限らず、他のプログラムも対象になりますか？
対象は同じVBプロジェクト内のフォームのみです。
他のプログラムは対象にはなりません。
現象が再現できる最低限のコードを示していただけませんか？
当方環境で再現してみようと思いましたが、どうも事情が複雑なようで、
MsgBoxを先に閉じないと、MDIフォーム上のタイマーイベントは発生しないのですが。
開発環境だとMsgBox表示中はMDIのタイマーイベントは発生しないのですが、
EXEだとちゃんと発生するようです。
とりあえず今からコードをまとめてみます。
現象を再現できるコードです
・[Form1]はMDI子フォーム。Command(MsgBox実行)を設定。
・[Form2]はMDI子フォームではない。Command(閉じる)を設定。
EXEを作成して下記の事を試してください。
1,[Form1]のCommandを押してMsgBoxを実行。
2,MsgBoxのOKを押す。
※[Form1]のCommandにフォーカスはあります。
3,[Form1]のCommandを押してMsgBoxを実行。
4,その状態で[Form2]が表示されるまで待つ。
5,[Form2]が表示されたら[閉じる]を押す。
6,MsgBoxのOKを押す。
※[Form1]のCommandにフォーカスが無い状態になります。
****************************************************************
標準モジュール(Module1)
Option Explicit
Public Declare Function GetForegroundWindow Lib "user32" () As Long
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Declare Function GetWindowThreadProcessId Lib "user32" _
(ByVal hWnd As Long, lpdwProcessId As Long) As Long
Public Declare Function AttachThreadInput Lib "user32" _
(ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long) As Long
Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
(ByVal uiAction As Long, ByVal uiParam As Long, ByRef pvParam As Long, ByVal fWinIni As Long) As Long
Public Const SPI_GETFOREGROUNDLOCKTIMEOUT As Long = &H2000&
Public Const SPI_SETFOREGROUNDLOCKTIMEOUT As Long = &H2001&
****************************************************************
MDIフォーム(MDIForm1)
Private Sub Timer1_Timer()
Dim hForegroundWnd&
Dim ThreadID1 As Long
Dim ThreadID2 As Long
Dim LockTimeout As Long
Static LockCnt%
LockCnt% = LockCnt% + 1 'ロックタイムカウント
If LockCnt% >= 10 Then
LockCnt% = 0
'現在ユーザーが作業しているウィンドウを取得
hForegroundWnd = GetForegroundWindow()
'スレッドIDを取得
ThreadID1 = GetWindowThreadProcessId(hForegroundWnd, ByVal 0&)
ThreadID2 = GetWindowThreadProcessId(App.ThreadID, ByVal 0&)
'スレッドIDが異なるならアタッチ
If ThreadID1 <> ThreadID2 Then
AttachThreadInput ThreadID2, ThreadID1, 1
End If
'現在のフォアグラウンドロックタイムアウトの設定を取得
SystemParametersInfo SPI_GETFOREGROUNDLOCKTIMEOUT, 0, LockTimeout, 0
'設定を 0ms に変更
SystemParametersInfo SPI_SETFOREGROUNDLOCKTIMEOUT, 0, ByVal 0&, 0
'従業員バーコード入力項目
Load Form2
Form2.Show 1
'フォアグラウンドウィンドウに設定
SetForegroundWindow hForegroundWnd
'フォアグラウンドロックタイムアウトの設定を戻す
SystemParametersInfo SPI_SETFOREGROUNDLOCKTIMEOUT, 0, ByVal LockTimeout, 0
'スレッドIDが異なるならデタッチ
If ThreadID1 <> ThreadID2 Then
AttachThreadInput ThreadID2, ThreadID1, 0
End If
End If
End Sub
****************************************************************
フォーム(Form1)
Private Sub Command1_Click()
MsgBox "ボタンを押しました"
End Sub
****************************************************************
フォーム(Form2)
Private Sub Command1_Click()
Unload Me
End Sub
****************************************************************
確認しました。
当方には、MsgBoxを閉じた後に明示的にSetFocusする
くらいしか回避策は思いつきませんでした。
あとは識者のレスを期待します。
Form1の
Private Sub Command1_Click()
MsgBox "ボタンを押しました"
Me.ActiveControl.SetFocus '明示的にセットフォーカス
End Sub
＞もげ様
実際にはいくつもフォームがあり、全てのMsgBox処理の後にフォーカスを
セットする処理を入れるのは厳しいものがあります・・・。
解決方法が見つからないようなので、しばらくしたらあきらめる方向で検討したいと思います。
とりあえずこの件に関しては現状のまま進める方向になりましたのでクローズします。
もし何か分かりましたらコメントお願いします。
| ツイート |  |