mousedrop.bas

这是一个JSP在线考试系统

Attribute VB_Name = "MouseDrop"
'模块名：MouseDrop.bas
'说明：程序中使用的共用涵数和过程，以及引用API函数声明
'日期：1999.01.08
'编者：徐景周

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
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

 '建立圆角钜形的特殊窗体
Public Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Public Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Public Const WM_NCHITTEST = &H84  '无标题拖动参数
Public Const HTCAPTION = 2
Public Const HTCLIENT = 1
Public Const GWL_WNDPROC = (-4)
Public PROROC As Long


Function WindowProc(ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Dim rv As Long
   
      If msg = WM_NCHITTEST Then
        rv = DefWindowProc(hwnd, msg, wParam, lParam)
        If rv = HTCLIENT Then
          WindowProc = HTCAPTION
        Else
          WindowProc = rv
        End If
       '将其他的消息传给默认的窗口函数进行处理
      Else
        WindowProc = CallWindowProc(PROROC, hwnd, msg, wParam, lParam)
      End If
      
End Function