資訊好好玩

0愛的鼓勵 0訂閱站台

Option Explicit

'以下程式在module1.bas
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
   (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
   (ByVal hwnd As Long, ByVal nIndex As Long) As Long
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

Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" ( _
    lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Public Const GWL_WNDPROC = (-4)
Public Const WM_WINDOWPOSCHANGING = &H46
Type WINDOWPOS
        hwnd As Long
        hWndInsertAfter As Long
        x As Long
        y As Long
        cx As Long
        cy As Long
        flags As Long
End Type

Public preWinProc As Long

Public Function wndproc(ByVal hwnd As Long, ByVal Msg As Long, _
                          ByVal wParam As Long, ByVal lParam As Long) As Long
  Dim lwd As Long, hwd As Long
  If Msg = WM_WINDOWPOSCHANGING Then
     Dim WPOS As WINDOWPOS
     CopyMemory WPOS, ByVal lParam, Len(WPOS)
     If WPOS.x < 0 Then
        WPOS.x = 0
        CopyMemory ByVal lParam, WPOS, Len(WPOS)
     End If
  End If
  '將之送往原來的Window Procedure
  wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
End Function

'以下在form
Sub Form_Load()
  Dim ret As Long
  '記錄原本的Window Procedure的位址
  preWinProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
  ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf wndproc)
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Dim ret As Long
  '取消Message的截取，而使之又只送往原來的Window Procedure
  ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, preWinProc)
End Sub