tagCANDY CGI VBレスキュー(花ちゃん) - VBレスキュー(花ちゃん)の投稿サンプル用掲示板 - Visual Basic 6.0 VB2005 VB2010
VB2005用トップページへVBレスキュー(花ちゃん)のトップページVB6.0用のトップページ
VBレスキュー(花ちゃん)の投稿サンプル用掲示板
     サンプル投稿用掲示板  VB2005 〜 用トップページ  VB6.0 用 トップページ
メッセージボックスの強制終了(VB6.0) ( No.0 )  [親スレッドへ]
日時: 2007/07/15 18:43
名前: 花ちゃん

***********************************************************************************
* カテゴリー:[メッセージ][][]                               *
* キーワード:自動的,クリック,閉じる,ボタンをクリック,,                     *
***********************************************************************************

-----------------------------------------------------------------------------------
No.1828 Re:メッセージボックスの強制終了  投稿者:ゆう(U) [2001/02/06(火)17:54分]
-----------------------------------------------------------------------------------

●ゆー太郎 さんの言われる通り専用のフォームを用意す(造)るのが一番安全かつ確実です。

勧めしない方法ですが・・・

[CLSMSGBOXAA.CLS]
Option Explicit
'==========================================================
'自動解答付きMsgBoxクラス
'==========================================================
'////////////////////////////////
'// Timerコントロールが必要です //
'///////////////////////////////

Private Declare Function FindWindowEx Lib "user32" _
         Alias "FindWindowExA" _
               (ByVal hWnd1 As Long, _
                ByVal hWnd2 As Long, _
                ByVal lpsz1 As String, _
                ByVal lpsz2 As String) As Long
Private Declare Function SendMessage Lib "user32" _
                Alias "SendMessageA" _
               (ByVal hWnd As Long, _
                ByVal wMsg As Long, _
                ByVal wParam As Long, _
                ByRef lParam As Any) As Long
Private Declare Function SetWindowText Lib "user32" _
                Alias "SetWindowTextA" _
               (ByVal hWnd As Long, _
                ByVal lpString As String) As Long
Private Declare Function timeGetTime Lib "winmm.dll" _
               () As Long

Private hMsgBox As Long
Private strCaption As String
Private lngLimit As Long
Private blnInit As Boolean
Private varArray As Variant
Private lngArrayCount As Long
Private lngButtonNumber As Long

Private WithEvents myTimer As Timer

'==========================================================
'自動解答付きMsgBox関数 MsgBox
'==========================================================
' result = MsgBox(Prompt, [Buttons], [Title], [ButtonsCap], _
'                 [MilliSecond], [ButtonMumber])
' 引数 Prompt      :MsgBoxと同じ
'    Buttons     :MsgBoxと同じ
'    Title       :MsgBoxと同じ
'    ButtonsCap  :変更時のボタンキャプチャ
'    MilliSecond :自動解答までの秒数(ミリ秒・動作最小値は60?)
'    ButtonNumber:自動解答時のボタン番号(最小値=0:最左)
'----------------------------------------------------------
' 注意 IDEでは正常に(意図した)動作しません。
'    Timerイベントのバグ(?)を利用した機能なので動作確認は
'    十分に行って使用下さい。
'    ボタン幅は変更していませんので、文字数に注意して下さい。
'----------------------------------------------------------
'例
' Dim cMsgBox As New clsMsgBoxAA
' dim lngResult As Long
' Set cMsgBox.Timer = Timer1
' lngResult = cMsgBox.MsgBox("Hello", _
'                            vbYesNoCancel Or vbDefaultButton1, _
'                            "TiTle", _
'                            Array("はい(&Y)", "いいえ(&N)", "中止(&C)"), _
'                            2000, _
'                            2)
'----------------------------------------------------------
Public Function MsgBox(ByRef Prompt As String, _
                       Optional ByVal Buttons As _
                       VbMsgBoxStyle = vbOKOnly, _
                       Optional ByRef Title As Variant, _
                       Optional ByRef ButtonsCap As Variant, _
                       Optional ByVal MilliSecond As _
                       Long = 5000&, _
                       Optional ByVal ButtonNumber As _
                       Long = 0 _
                      ) As VbMsgBoxResult
  
  If TypeName(myTimer) = "Nothing" Then
    VBA.MsgBox "Timerが設定されていません", vbCritical
    Err.Raise 17
    Exit Function
  End If

  If IsMissing(Title) Then
    strCaption = App.Title
  Else
    strCaption = Title
  End If
  If Not IsMissing(ButtonsCap) Then
    varArray = ButtonsCap
    lngArrayCount = UBound(varArray) - LBound(varArray) + 1
  End If
  lngButtonNumber = ButtonNumber
  lngLimit = timeGetTime + MilliSecond
  blnInit = True
  With myTimer
    .Interval = 50
    .Enabled = True
    MsgBox = VBA.MsgBox(Prompt, Buttons, Title)
    .Enabled = False
  End With
End Function

Private Sub myTimer_Timer()
Const WM_LBUTTONDOWN = &H201&   '左のマウスボタンを押した
Const WM_LBUTTONUP = &H202&     '左のマウスボタンを離した
Const MK_LBUTTON = &H1&         '左のマウスボタンが押されている
  Dim i As Long
  Dim hButton As Long

  If blnInit Then
    hMsgBox = FindWindowEx(0, 0, "#32770", strCaption)
    If hMsgBox = 0 Then Exit Sub
    For i = 0 To lngArrayCount - 1
      hButton = FindWindowEx(hMsgBox, hButton, "Button", vbNullString)
      Call SetWindowText(hButton, CStr(varArray(i)) & vbNullChar)
    Next
    blnInit = False
  Else
    If lngLimit < timeGetTime Then
      For i = 0 To lngButtonNumber
        hButton = FindWindowEx(hMsgBox, hButton, "Button", vbNullString)
      Next
      Call SendMessage(hButton, WM_LBUTTONDOWN, MK_LBUTTON, ByVal 0&)
      Call SendMessage(hButton, WM_LBUTTONUP, 0&, ByVal 0&)
    End If
  End If
End Sub

Public Property Set msgTimer(ByRef msgTimer As Timer)
  If TypeOf msgTimer Is Timer Then
    Set myTimer = msgTimer
  End If
End Property

Private Sub Class_Terminate()
  Set myTimer = Nothing
End Sub

無理やりこんなこともできます。
※動作確認はしっかり行ってください
 どのような結果になっても私は責任持ちません



 [スレッド一覧へ] [親スレッドへ]