modwndprocprn.bas

来自「This application provides much functiona」· BAS 代码 · 共 103 行

Attribute VB_Name = "modWndProcPrn"
Option Explicit

Private DefaultWndProc_PrnLst As Long
Private gHW_PrnLst As Long
Private DefaultWndProc_PPortion As Long
Private gHW_PPortion As Long
Private DefaultWndProc_Zoom As Long
Private gHW_Zoom As Long

Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Const GWL_WNDPROC& = -4

'messages
Private Const CB_SHOWDROPDOWN& = &H14F
Private Const WM_LBUTTONDOWN& = &H201


Public Sub Hook_PrnLst(ByVal hw As Long)
    gHW_PrnLst = hw
    DefaultWndProc_PrnLst = SetWindowLong(gHW_PrnLst, GWL_WNDPROC, AddressOf CustomWindowProc_PrnLst)
End Sub

Public Sub Hook_PPortion(ByVal hw As Long)
    gHW_PPortion = hw
    DefaultWndProc_PPortion = SetWindowLong(gHW_PPortion, GWL_WNDPROC, AddressOf CustomWindowProc_PPortion)
End Sub

Public Sub Hook_Zoom(ByVal hw As Long)
    gHW_Zoom = hw
    DefaultWndProc_Zoom = SetWindowLong(gHW_Zoom, GWL_WNDPROC, AddressOf CustomWindowProc_Zoom)
End Sub

Public Sub UnHook_PrnLst()
Dim RetVal As Long

    RetVal = SetWindowLong(gHW_PrnLst, GWL_WNDPROC, DefaultWndProc_PrnLst)
End Sub

Public Sub UnHook_PPortion()
Dim RetVal As Long

    RetVal = SetWindowLong(gHW_PPortion, GWL_WNDPROC, DefaultWndProc_PPortion)
End Sub

Public Sub UnHook_Zoom()
Dim RetVal As Long

    RetVal = SetWindowLong(gHW_Zoom, GWL_WNDPROC, DefaultWndProc_Zoom)
End Sub

Public Function CustomWindowProc_PrnLst(ByVal hw As Long, ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim RetVal As Long, DefProc As Long

    RetVal = 0
    DefProc = CallWindowProc(DefaultWndProc_PrnLst, hw, Message, wParam, lParam)
    'Debug.Print Message
    Select Case Message
        Case WM_LBUTTONDOWN
            Call PostMessage(hw, CB_SHOWDROPDOWN, 1, 0)
            RetVal = DefProc
        Case Else
            RetVal = DefProc
    End Select
    CustomWindowProc_PrnLst = RetVal
End Function

Public Function CustomWindowProc_PPortion(ByVal hw As Long, ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim RetVal As Long, DefProc As Long

    RetVal = 0
    DefProc = CallWindowProc(DefaultWndProc_PPortion, hw, Message, wParam, lParam)
    'Debug.Print Message
    Select Case Message
        Case WM_LBUTTONDOWN
            Call PostMessage(hw, CB_SHOWDROPDOWN, 1, 0)
            RetVal = DefProc
        Case Else
            RetVal = DefProc
    End Select
    CustomWindowProc_PPortion = RetVal
End Function

Public Function CustomWindowProc_Zoom(ByVal hw As Long, ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim RetVal As Long, DefProc As Long

    RetVal = 0
    DefProc = CallWindowProc(DefaultWndProc_Zoom, hw, Message, wParam, lParam)
    'Debug.Print Message
    Select Case Message
        Case WM_LBUTTONDOWN
            Call PostMessage(hw, CB_SHOWDROPDOWN, 1, 0)
            RetVal = DefProc
        Case Else
            RetVal = DefProc
    End Select
    CustomWindowProc_Zoom = RetVal
End Function