Private Type POINTAPI X As Long Y As LongEnd TypePrivate Type RECT Left As Long Top As Long Right As Long Bottom As LongEnd TypePrivate Declare Function ClipCursor Lib "user32" (lpRect As RECT) As LongPrivate Declare Function ClipCursorByNum Lib "user32" Alias "ClipCursor" (ByVal _ lpRect As Long) As LongPrivate Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As LongPrivate Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As _ IntegerPrivate Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, _ lpRect As RECT) As LongPrivate Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, _ lpPoint As POINTAPI) As LongPrivate Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, _ lpRect As RECT, ByVal bErase As Long) As LongPrivate Declare Function InvalidateRectByNum Lib "user32" Alias _ "InvalidateRect" (ByVal hwnd As Long, ByVal lpRect As Long, _ ByVal bErase As Long) As Long' Drag a control until the user releases all mouse buttons'' You should call this routine from the MouseDown event procedures' of the controls that you want to make draggable, after' you determine that the user has initiated a drag operation.' For example, if you want to let the user drag controls' using the Ctrl+Right button combination, add this code' to their MouseDown procedure:'' Private Sub Command1_MouseDown(...)' If Button = vbRightButton And Shift = vbCtrlMask Then' DragControl Command1' End If' End Sub'' From that point on, this procedure takes the control and' exits only when the user releases all mouse buttonsSub DragControl(ctrl As Control) Dim startButton As Integer Dim startPoint As POINTAPI Dim currPoint As POINTAPI Dim contRect As RECT Dim contScaleMode As Integer ' get mouse position and buttons pressed GetCursorPos startPoint If GetAsyncKeyState(vbLeftButton) Then startButton = vbLeftButton If GetAsyncKeyState(vbRightButton) Then startButton = startButton Or _ vbRightButton If GetAsyncKeyState(vbMiddleButton) Then startButton = startButton Or _ vbMiddleButton ' get container upper-left corner position ' in screen coordinates (currPoint is Zero) ClientToScreen ctrl.Container.hwnd, currPoint ' get container size GetClientRect ctrl.Container.hwnd, contRect ' convert to screen coordintes contRect.Left = currPoint.X contRect.Top = currPoint.Y contRect.Right = contRect.Right + currPoint.X contRect.Bottom = contRect.Bottom + currPoint.Y ' limit the cursor within the parent control ClipCursor contRect ' get the ScaleMode that is active for the control ' this is the ScaleMode of its container, or it ' is vbTwips if its container does not support ' the ScaleMode property On Error Resume Next contScaleMode = vbTwips ' ignore next assignement if the container ' dows not support ScaleMode property contScaleMode = ctrl.Container.ScaleMode Do ' exit if all mouse buttons are released If (startButton And vbLeftButton) = 0 Or GetAsyncKeyState(vbLeftButton) _ = 0 Then If (startButton And vbRightButton) = 0 Or GetAsyncKeyState _ (vbRightButton) = 0 Then If (startButton And vbMiddleButton) = 0 Or GetAsyncKeyState _ (vbMiddleButton) = 0 Then Exit Do End If End If End If ' get current mouse position GetCursorPos currPoint ' move the control if they are different If currPoint.X <> startPoint.X Or currPoint.Y <> startPoint.Y Then ' move the control With ctrl.Parent ctrl.Move ctrl.Left + .ScaleX(currPoint.X - startPoint.X, _ vbPixels, contScaleMode), ctrl.Top + .ScaleY(currPoint.Y - _ startPoint.Y, vbPixels, contScaleMode) ' refresh container InvalidateRectByNum .hwnd, 0, False .Refresh End With LSet startPoint = currPoint End If ' allow background processing DoEvents Loop ' restore full mouse movement ClipCursorByNum 0End Sub


The Best Mechanical Keyboards For Programmers: Where To Find Them
When it comes to programming, a good mechanical keyboard can make all the difference. Naturally, you would want one of the best mechanical keyboards for programmers. But with so many