home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vampso2a / mhdock.bas < prev    next >
Encoding:
BASIC Source File  |  1999-08-31  |  13.4 KB  |  303 lines
  1. Attribute VB_Name = "modMHDock"
  2. Option Explicit
  3.  
  4. Public Type seVarsType
  5.     origWndProc As Long ' Parent form's original WndProc address
  6.     lParenthWnd As Long ' Parent form's hWnd
  7.     lTophWnd As Long    ' MDIForm parent form hWnd
  8.     lTrayhWnd As Long   ' System tray hWnd
  9.     lseHwnd As Long     ' MHDock control hWnd
  10.     lxDock As Long      ' xDock property
  11.     lyDock As Long      ' yDock property
  12.     bDockEnabled As Long
  13. End Type
  14.  
  15. Public Type RECT
  16.     Left As Long
  17.     Top As Long
  18.     Right As Long
  19.     Bottom As Long
  20. End Type
  21.  
  22. Public Type POINTAPI
  23.     X As Long
  24.     Y As Long
  25. End Type
  26.  
  27. Public 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
  28. Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
  29. Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  30. Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  31. Public Declare Function GetDesktopWindow Lib "user32" () As Long
  32. Public Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
  33. Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
  34. Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  35. Public Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
  36. Public Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
  37. Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  38. Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  39. Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
  40.     
  41. Public Const GWL_WNDPROC = (-4)
  42. Public Const WM_DESTROY = &H2
  43. Public Const WM_MOVE = &H3
  44. Public Const WM_MOVING = &H216
  45. Public Const WM_MOUSEMOVE = &H200
  46. Public Const WM_ENTERSIZEMOVE = &H231
  47. Public Const WM_EXITSIZEMOVE = &H232
  48. Public Const SPI_GETBORDER = 5
  49.  
  50. Public Const GMEM_FIXED = &H0
  51. Public Const GMEM_ZEROINIT = &H40
  52. Public Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)
  53.  
  54. Dim seVars As seVarsType, hMem As Long, lLasthWnd As Long
  55.  
  56. Public Function AppWndProc(ByVal hwnd As Long, ByVal Msg As Long, _
  57.     ByVal wParam As Long, ByVal lParam As Long) As Long
  58.     Static pSave As POINTAPI, bSnappedX As Boolean, _
  59.         bSnappedY As Boolean
  60.     Static bLeft As Boolean, bTop As Boolean, bRight As Boolean, _
  61.         bBottom As Boolean
  62.     Static rOrig As RECT, bOrig As Boolean, rParent As RECT, _
  63.         rLatest As RECT
  64.     Static lMinX As Long, lMaxX As Long, lMinY As Long, _
  65.         lMaxY As Long
  66.     Static lxDock As Long, lyDock As Long
  67.     
  68.     If hwnd <> lLasthWnd Then
  69.         ' Get the seVars structure copy from the locked memory
  70.         hMem = Val(GetSetting("MHDock", "hMem", CStr(hwnd)))
  71.         CopyMemory seVars, ByVal hMem, LenB(seVars)
  72.         lLasthWnd = hwnd
  73.     End If
  74.     
  75.     Dim bDockNow As Boolean, P As POINTAPI, rTemp As RECT
  76.     Dim lBorder As Long, lEvent As Long
  77.     Select Case Msg
  78.         Case WM_ENTERSIZEMOVE, WM_EXITSIZEMOVE
  79.             Dim pErase As POINTAPI
  80.             Dim rErase As RECT
  81.             pSave = pErase
  82.             bSnappedX = False
  83.             bSnappedY = False
  84.             bLeft = False
  85.             bTop = False
  86.             bRight = False
  87.             bBottom = False
  88.             rOrig = rErase
  89.             bOrig = False
  90.             rParent = rErase
  91.             rLatest = rErase
  92.             lMinX = 0
  93.             lMaxX = 0
  94.             lMinY = 0
  95.             lMaxY = 0
  96.             lxDock = 0
  97.             lyDock = 0
  98.         Case WM_MOVING
  99.             If seVars.bDockEnabled Then
  100.                 ' The user is moving the Form. The moving rectangle
  101.                 ' is passed as a pointer in lParam
  102.                 CopyMemory rLatest, ByVal lParam, Len(rLatest)
  103.                 If Not bOrig Then
  104.                     ' First time in - get the parent rectangle to
  105.                     ' determine docking position
  106.                     bOrig = True: LSet rOrig = rLatest
  107.                     GetWindowRect seVars.lTophWnd, rParent
  108.                     lMinX = rParent.Left
  109.                     lMaxX = rParent.Right
  110.                     lMinY = rParent.Top
  111.                     lMaxY = rParent.Bottom
  112.                     lxDock = seVars.lxDock \ Screen.TwipsPerPixelX
  113.                     lyDock = seVars.lyDock \ Screen.TwipsPerPixelY
  114.                     If seVars.lTrayhWnd Then
  115.                         ' This form is on the screen - get the tray
  116.                         ' position and offset the Dock positions
  117.                         GetWindowRect seVars.lTrayhWnd, rTemp
  118.                         If rTemp.Left > 0 Then
  119.                             ' Bar is on the right
  120.                             lMaxX = lMaxX - (rTemp.Right - _
  121.                                 rTemp.Left) + 2
  122.                         ElseIf rTemp.Top > 0 Then
  123.                             ' Bar is on the bottom
  124.                             lMaxY = lMaxY - (rTemp.Bottom - _
  125.                                 rTemp.Top) + 2
  126.                         ElseIf rTemp.Right > lMaxX \ 2 Then
  127.                             ' Bar is on the top
  128.                             lMinY = rTemp.Bottom
  129.                         Else
  130.                             ' Bar is on the left
  131.                             lMinX = rTemp.Right
  132.                         End If
  133.                     Else
  134.                         ' This is a child window, so don't try to
  135.                         ' dock beyond the parent's borders
  136.                         SystemParametersInfo SPI_GETBORDER, 0, lBorder, 0
  137.                         lBorder = lBorder * 2
  138.                         lMinX = lMinX + lBorder
  139.                         lMaxX = lMaxX - lBorder
  140.                         lMinY = lMinY + lBorder
  141.                         lMaxY = lMaxY - lBorder
  142.                     End If
  143.                 End If
  144.                 If rLatest.Left <= lMinX + lxDock Then
  145.                     ' Dock to the left
  146.                     bDockNow = True
  147.                     rLatest.Left = lMinX
  148.                     rLatest.Right = rLatest.Left + (rOrig.Right - _
  149.                         rOrig.Left)
  150.                     bLeft = True
  151.                 ElseIf rLatest.Right >= lMaxX - lxDock Then
  152.                     ' Dock to the right
  153.                     bDockNow = True
  154.                     rLatest.Right = lMaxX
  155.                     rLatest.Left = rLatest.Right - (rOrig.Right - _
  156.                         rOrig.Left)
  157.                     bRight = True
  158.                 End If
  159.                 If rLatest.Top <= lMinY + lyDock Then
  160.                     ' Dock to the top
  161.                     bDockNow = True
  162.                     rLatest.Top = lMinY
  163.                     rLatest.Bottom = rLatest.Top + (rOrig.Bottom - _
  164.                         rOrig.Top)
  165.                     bTop = True
  166.                 ElseIf rLatest.Bottom >= lMaxY - lyDock Then
  167.                     ' Dock to the bottom
  168.                     bDockNow = True
  169.                     rLatest.Bottom = lMaxY
  170.                     rLatest.Top = rLatest.Bottom - (rOrig.Bottom - _
  171.                         rOrig.Top)
  172.                     bBottom = True
  173.                 End If
  174.                 If bDockNow Or bSnappedX Or bSnappedY Then
  175.                     ' User needs to Dock or is currently Docked
  176.                     ' (and we need to check for unDock conditions)
  177.                     GetCursorPos P
  178.                     If bDockNow And Not bSnappedX And (bLeft Or _
  179.                         bRight) Then
  180.                         ' First time Docking Left or Right
  181.                         bSnappedX = True
  182.                         LSet pSave = P
  183.                     ElseIf bSnappedX Then
  184.                         ' Docked on the Left or Right - check for
  185.                         ' unDock conditions
  186.                         If bLeft Then
  187.                             If P.X > pSave.X + lxDock Then
  188.                                 rLatest.Left = lMinX + lxDock + 1
  189.                                 rLatest.Right = rLatest.Left + _
  190.                                     (rOrig.Right - rOrig.Left)
  191.                                 bLeft = False
  192.                                 bSnappedX = False
  193.                             ElseIf P.X < pSave.X Then
  194.                                 LSet pSave = P
  195.                             End If
  196.                         ElseIf bRight Then
  197.                             If P.X < pSave.X - lxDock Then
  198.                                 rLatest.Right = lMaxX - lxDock - 1
  199.                                 rLatest.Left = rLatest.Right - _
  200.                                     (rOrig.Right - rOrig.Left)
  201.                                 bRight = False
  202.                                 bSnappedX = False
  203.                             ElseIf P.X > pSave.X Then
  204.                                 ' No need to unDock, so save the
  205.                                 ' cursor position
  206.                                 LSet pSave = P
  207.                             End If
  208.                         End If
  209.                     End If
  210.                     If bDockNow And Not bSnappedY And _
  211.                         (bTop Or bBottom) Then
  212.                         ' First time Docking Top or Bottom
  213.                         bSnappedY = True
  214.                         LSet pSave = P
  215.                     ElseIf bSnappedY Then
  216.                         ' Docked on the Top or Bottom - check for
  217.                         ' unDock conditions
  218.                         If bTop Then
  219.                             If P.Y > pSave.Y + lyDock Then
  220.                                 rLatest.Top = lMinY + lyDock + 1
  221.                                 rLatest.Bottom = rLatest.Top + _
  222.                                     (rOrig.Bottom - rOrig.Top)
  223.                                 bTop = False
  224.                                 bSnappedY = False
  225.                             ElseIf P.Y < pSave.Y Then
  226.                                 LSet pSave = P
  227.                             End If
  228.                         ElseIf bBottom Then
  229.                             If P.Y < pSave.Y - lyDock Then
  230.                                 rLatest.Bottom = lMaxY - lyDock - 1
  231.                                 rLatest.Top = rLatest.Bottom - _
  232.                                     (rOrig.Bottom - rOrig.Top)
  233.                                 bBottom = False
  234.                                 bSnappedY = False
  235.                             ElseIf P.Y > pSave.Y Then
  236.                                 LSet pSave = P
  237.                             End If
  238.                         End If
  239.                     End If
  240.                     ' Copy the modified RECT back into the
  241.                     ' original pointed to by lParam
  242.                     CopyMemory ByVal lParam, rLatest, Len(rLatest)
  243.                 End If
  244.             End If
  245.         Case WM_MOVE
  246.             ' Fire the original handler right away
  247.             AppWndProc = CallWindowProc(seVars.origWndProc, hwnd, _
  248.                 Msg, wParam, lParam)
  249.             If seVars.bDockEnabled Then
  250.                 ' Form was dropped - reset all flags and cause a
  251.                 ' MouseMove event back in the UserControl so that
  252.                 ' the Moved event can fire.
  253.                 If bOrig Then
  254.                     If bSnappedX Then
  255.                         If bLeft Then
  256.                             lEvent = 1
  257.                         Else
  258.                             lEvent = 2
  259.                         End If
  260.                     End If
  261.                     If bSnappedY Then
  262.                         If bTop Then
  263.                             lEvent = lEvent Or &H10000
  264.                         Else
  265.                             lEvent = lEvent Or &H20000
  266.                         End If
  267.                     End If
  268.                     SendMessage seVars.lseHwnd, WM_MOUSEMOVE, 0, _
  269.                         ByVal lEvent
  270.                 End If
  271.                 bSnappedX = False
  272.                 bSnappedY = False
  273.                 bLeft = False
  274.                 bTop = False
  275.                 bRight = False
  276.                 bBottom = False
  277.                 bOrig = False
  278.             Else
  279.                 SendMessage seVars.lseHwnd, WM_MOUSEMOVE, 0, ByVal 0
  280.             End If
  281.             Exit Function
  282.         Case WM_DESTROY
  283.             ' In case the Form is destroyed before the
  284.             ' Terminate event of the Control
  285.             AppWndProc = CallWindowProc(seVars.origWndProc, hwnd, _
  286.                 Msg, wParam, lParam)
  287.             SetHook hwnd, False, seVars.origWndProc
  288.             Exit Function
  289.     End Select
  290.     AppWndProc = CallWindowProc(seVars.origWndProc, hwnd, Msg, _
  291.         wParam, lParam)
  292. End Function
  293.  
  294. Public Sub SetHook(hwnd, bSet As Boolean, origWndProc As Long)
  295.     If bSet Then
  296.         origWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf AppWndProc)
  297.     ElseIf origWndProc Then
  298.         If GetWindowLong(hwnd, GWL_WNDPROC) <> origWndProc Then
  299.             SetWindowLong hwnd, GWL_WNDPROC, origWndProc
  300.         End If
  301.     End If
  302. End Sub
  303.