VB6.0用掲示板の過去のログ(No.1)−VBレスキュー(花ちゃん)
[記事リスト]
[新規投稿]
[新着記事]
[ワード検索]
[過去ログ]
[管理用]
| 投稿日 | ： 2003/04/07(Mon) 18:09 |
| 投稿者 | ： peta |
| Ｅメール | ： |
| ＵＲＬ | ： |
| タイトル | ： Re^2: コモンダイアログの表示 |
> OCXでは無理ですが、
と、思ったんですが実験してみたら、それなりに可能な様です。
ただ、確実な方法かどうかは疑問ですので機能しない場合があるかも？
参考程度に。
' フォームモジュール
Option Explicit
Private Sub Command1_Click()
Call Hook
With CommonDialog1
.InitDir = App.Path
.Flags = cdlOFNHideReadOnly
.ShowOpen
End With
Call UnHook
End Sub
' 標準モジュール
Option Explicit
Private m_hHook As Long
Private Type CWPSTRUCT
lParam As Long
wParam As Long
Message As Long
hwnd As Long
End Type
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
(ByVal idHook As Long, ByVal lpfn As Long, _
ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Const WH_CALLWNDPROC = 4&
Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook&) As Long
Private Declare Function CallNextHookEx Lib "user32" _
(ByVal hHook As Long, ByVal nCode As Long, _
ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetParent Lib "user32" _
(ByVal hwnd As Long) As Long
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, lParam As Any) As Long
Private Const WM_NOTIFY = &H4E&
Private Const WM_WINDOWPOSCHANGED = &H47&
Private Const WM_COMMAND = &H111&
Private Const WM_LBUTTONDOWN = &H201&
Private Const WM_LBUTTONUP = &H202&
Private Const MK_LBUTTON = &H1&
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Const HDM_FIRST = &H1200&
Private Const HDM_GETITEMRECT = (HDM_FIRST + 7)
Private Const LVM_FIRST = &H1000&
Private Const LVM_GETHEADER = (LVM_FIRST + 31)
Private Const LVM_SETCOLUMNWIDTH = (LVM_FIRST + 30)
Private Const LVSCW_AUTOSIZE = -1
Public Sub Hook()
If (m_hHook <> 0) Then Call UnHook
m_hHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf FileDlgHookProc, _
App.hInstance, App.ThreadID)
End Sub
Public Sub UnHook()
If (m_hHook = 0) Then Exit Sub
Call UnhookWindowsHookEx(m_hHook)
m_hHook = 0
End Sub
Private Function FileDlgHookProc(ByVal nCode As Long, _
ByVal wParam As Long, _
cwp As CWPSTRUCT) As Long
If (nCode >= 0) Then
Static hDlg As Long
Static hwndLV As Long
Static fReadyLV As Boolean
Select Case cwp.Message
Case WM_NOTIFY
Dim hwndDef As Long
Dim hwndTB As Long
If (hwndLV = 0) Then
hDlg = GetParent(cwp.hwnd)
hwndDef = FindWindowEx(hDlg, 0, "SHELLDLL_DefView", vbNullString)
hwndLV = FindWindowEx(hwndDef, 0, "SysListView32", vbNullString)
If (hwndLV <> 0) Then
hwndTB = FindWindowEx(hDlg, 0, "ToolBarWindow32", vbNullString)
Call SendMessage(hDlg, WM_COMMAND, &HA004&, ByVal hwndTB)
Call SetLVColumnWidth(hwndLV, 0, 10)
fReadyLV = True
End If
End If
Case WM_WINDOWPOSCHANGED
If (fReadyLV) Then
Call SetLVColumnClick(hwndLV, 3)
Call SetLVColumnWidth(hwndLV)
fReadyLV = False
hDlg = 0
hwndLV = 0
Call UnHook
End If
End Select
End If
FileDlgHookProc = CallNextHookEx(m_hHook, nCode, wParam, cwp)
End Function
Private Sub SetLVColumnWidth(ByVal hwndLV As Long, _
Optional ByVal iItemHD As Long = 0, _
Optional ByVal dwWidth As Long = LVSCW_AUTOSIZE)
Call SendMessage(hwndLV, LVM_SETCOLUMNWIDTH, iItemHD, ByVal dwWidth)
End Sub
Private Sub SetLVColumnClick(ByVal hwndLV As Long, _
ByVal iItemHD As Long)
Dim hwndHD As Long
Dim rcItem As RECT
Dim lParam As Long
hwndHD = SendMessage(hwndLV, LVM_GETHEADER, 0, ByVal 0&)
Call SendMessage(hwndHD, HDM_GETITEMRECT, iItemHD, rcItem)
lParam = ((rcItem.Left + rcItem.Right) / 2) Or _
((rcItem.Top + rcItem.Bottom) / 2) * &H10000
Call SendMessage(hwndHD, WM_LBUTTONDOWN, MK_LBUTTON, ByVal lParam)
Call SendMessage(hwndHD, WM_LBUTTONUP, MK_LBUTTON, ByVal lParam)
End Sub
- 関連一覧ツリー
（★ をクリックするとツリー全体を一括表示します）
- 返信フォーム
（この記事に返信する場合は下記フォームから投稿して下さい）