VB6.0用掲示板の過去のログ(No.1)−VBレスキュー(花ちゃん)
[記事リスト] [新規投稿] [新着記事] [ワード検索] [過去ログ] [管理用]

投稿日: 2002/09/02(Mon) 15:13
投稿者MS
URL
タイトルRe: (続)タスクバー「自動的に隠す」の設定/解除

Win98で実現する方法をいろいろと模索してみんですが、いい手が見つか
らず、結局、ダイアログ設定の操作手順をコードに置換えてみました。
以下がWin98限定のコードです。
この方法の問題は、ダイアログ設定の終了後、Formがアクティブになり
ません。フォアグラウンドウィンドウのスレッドとインプット状態を
共有する方法でアクティブになると思ったのですが。
回避策をご指導下さい。宜しくお願いします。

' Form Code
Option Explicit
Private Type RECT
    Left   As Long
    Top    As Long
    Right  As Long
    Bottom As Long
End Type
Private Type APPBARDATA
    cbSize           As Long
    hwnd             As Long
    uCallbackMessage As Long
    uEdge            As Long
    rc               As RECT
    lParam           As Long
End Type
Private Declare Function SHAppBarMessage Lib "shell32.dll" _
        (ByVal dwMessage As Long, pData As APPBARDATA) As Long
Private Const ABM_GETSTATE = &H4
Private Const ABS_AUTOHIDE = &H1

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 Sub Sleep Lib "kernel32" _
        (ByVal dwMilliseconds As Long)
Private Declare Function GetDlgItem Lib "user32" _
        (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long
' Private Const ID_ALWAYSONTOP = 1101
Private Const ID_AUTOHIDE = 1102
Private Const ID_OK = 1
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hwnd As Long, ByVal wMsg As Long, _
         ByVal wParam As Long, lParam As Any) As Long
Private Const BM_CLICK = &HF5
Private Const BM_SETCHECK = &HF1
Private Const BST_UNCHECKED = 0
Private Const BST_CHECKED = 1

Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function SetForegroundWindow Lib "user32" _
        (ByVal hwnd As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" _
        (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
        (ByVal uAction As Long, ByVal uParam As Long, _
         ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Const SPI_GETFOREGROUNDLOCKTIMEOUT = 2000
Private Const SPI_SETFOREGROUNDLOCKTIMEOUT = 2001
' Private Const SPIF_UPDATEINIFILE = 1
' Private Const SPIF_SENDWININICHANGE = 2
Private Declare Function AttachThreadInput Lib "user32" _
        (ByVal idAttach As Long, ByVal idAttachTo As Long, _
         ByVal fAttach As Long) As Long

Private Sub Command1_Click()
    Static fChkState As Boolean
    fChkState = Not fChkState
    Call SetTaskBarAutoHide(fChkState)
    DoEvents
    Call SetForegroundWnd(Me.hwnd)
End Sub

Private Sub SetTaskBarAutoHide(ByVal fChkState As Boolean)
    Dim hwndTask As Long
    Dim pbd As APPBARDATA
    Dim fIsAutoHide As Boolean
    Const sDlgTitle As String = "タスク バーのプロパティ"  ' Win98
    Dim oShell As Object
    Dim hwndDlg As Long
    Dim hwndChild As Long
    Dim hwndChk As Long
    ' [自動的に隠す]の状態を得る
    hwndTask = FindWindowEx(0, 0, "Shell_TrayWnd", vbNullString)
    pbd.cbSize = Len(pbd)
    pbd.hwnd = hwndTask
    fIsAutoHide = CBool(SHAppBarMessage(ABM_GETSTATE, pbd) And ABS_AUTOHIDE)
    If (fIsAutoHide And Not fChkState) Or (Not fIsAutoHide And fChkState) Then
        Call SetForegroundWindow(hwndTask)
        ' [タスク バーのプロパティ]ダイアログの起動
        Set oShell = CreateObject("Shell.Application")
        oShell.TrayProperties
        Set oShell = Nothing
        ' ダイアログ表示まで待機
        Do
            hwndDlg = FindWindowEx(0, 0, "#32770", sDlgTitle)
        Loop While (hwndDlg = 0)
        ' [自動的に隠す]チェックボックスの操作
        Call Sleep(100) ' 念のため
        hwndChild = FindWindowEx(hwndDlg, 0, "#32770", vbNullString)
        hwndChk = GetDlgItem(hwndChild, ID_AUTOHIDE)
        If (fIsAutoHide And Not fChkState) Then ' Check OFF
            Call SendMessage(hwndChk, BM_SETCHECK, BST_UNCHECKED, ByVal 0&)
        ElseIf (Not fIsAutoHide And fChkState) Then ' Check ON
            Call SendMessage(hwndChk, BM_SETCHECK, BST_CHECKED, ByVal 0&)
        End If
        ' [OK]ボタンでダイアログを閉じる
        Call SendMessage(GetDlgItem(hwndDlg, ID_OK), BM_CLICK, 0, ByVal 0&)
    End If
End Sub

Private Sub SetForegroundWnd(ByVal hwnd As Long)
    Dim dwCurThreadID As Long
    Dim dwThreadID As Long
    Dim dwLockTime As Long
    dwCurThreadID = GetWindowThreadProcessId(GetForegroundWindow(), ByVal 0)
    dwThreadID = GetWindowThreadProcessId(hwnd, ByVal 0)
    If (dwThreadID <> dwCurThreadID) Then
        Call AttachThreadInput(dwThreadID, dwCurThreadID, 1)
        Call SystemParametersInfo(SPI_GETFOREGROUNDLOCKTIMEOUT, 0, dwLockTime, 0)
        Call SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, 0, 0)
        Call SetForegroundWindow(hwnd)
        Call SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, dwLockTime, 0)
        Call AttachThreadInput(dwThreadID, dwCurThreadID, 0)
    Else: Call SetForegroundWindow(hwnd)
    End If
End Sub


- 関連一覧ツリー (★ をクリックするとツリー全体を一括表示します)

- 返信フォーム (この記事に返信する場合は下記フォームから投稿して下さい)

- Web Forum -