【求助】 无边框窗体拉伸

like5188

在网上找了下面的代码，在VB中能成功拉伸窗体，请求高手指点怎么把它用在access中来！！！！！急


Option   Explicit   
   
  Private   Const   WM_NCLBUTTONDOWN   =   &HA1   
  Private   Const   HTLEFT   =   10   
  Private   Const   HTRIGHT   =   11   
  Private   Const   HTTOP   =   12   
  Private   Const   HTBOTTOM   =   15   
  Private   Const   HTBOTTOMRIGHT   =   17   
  Private   Const   HTBOTTOMLEFT   =   16   
  Private   Const   HTTOPLEFT   =   13   
  Private   Const   HTTOPRIGHT   =   14   
   
  'sendmessage函数声明   
  Private   Declare   Function   SendMessage   Lib   "user32"   Alias   "SendMessageA"   (ByVal   hwnd   As   Long,   ByVal   wMsg   As   Long,   ByVal   wParam   As   Long,   lParam   As   Any)   As   Long   
  Private   Declare   Function   ReleaseCapture   Lib   "user32"   ()   As   Long   
  Private   Declare   Function   SetCapture   Lib   "user32"   (ByVal   hwnd   As   Long)   As   Long   
   
  Private   intEdge   As   Integer       '临界距离，鼠标在离边框距离小于等于该值则判定在边框上……   
   
  Private   Sub   Form_Load()   
        '相当于三个象素   
        intEdge   =   Me.ScaleX(3,   vbPixels,   Me.ScaleMode)   
  End   Sub   
   
  Private   Sub   Form_MouseDown(Button   As   Integer,   Shift   As   Integer,   X   As   Single,   Y   As   Single)   
        'Critical:将处理四角的代码放在前面   
        If   X   +   intEdge   >=   ScaleWidth   And   Y   +   intEdge   >=   ScaleHeight   Then           '右下角   
              ReleaseCapture   
              SendMessage   hwnd,   WM_NCLBUTTONDOWN,   HTBOTTOMRIGHT,   0   
        ElseIf   Y   +   intEdge   >=   ScaleHeight   And   X   <=   intEdge   Then                     '左下角   
              ReleaseCapture   
              SendMessage   hwnd,   WM_NCLBUTTONDOWN,   HTBOTTOMLEFT,   0   
        ElseIf   Y   <=   intEdge   And   X   <=   intEdge   Then                                         '左上角   
              ReleaseCapture   
              SendMessage   hwnd,   WM_NCLBUTTONDOWN,   HTTOPLEFT,   0   
        ElseIf   Y   <=   intEdge   And   X   +   intEdge   <=   ScaleWidth   Then                         '右上边   
              ReleaseCapture   
              SendMessage   hwnd,   WM_NCLBUTTONDOWN,   HTTOPRIGHT,   0   
        ElseIf   X   +   intEdge   >=   ScaleWidth   And   Y   <=   ScaleHeight   Then             '右边   
              ReleaseCapture   
              SendMessage   hwnd,   WM_NCLBUTTONDOWN,   HTRIGHT,   0   
        ElseIf   Y   +   intEdge   >=   ScaleHeight   And   X   <=   ScaleWidth   Then               '下边   
              ReleaseCapture   
              SendMessage   hwnd,   WM_NCLBUTTONDOWN,   HTBOTTOM,   0   
        ElseIf   X   <=   intEdge   And   Y   <=   ScaleHeight   Then                               '左边   
              ReleaseCapture   
              SendMessage   hwnd,   WM_NCLBUTTONDOWN,   HTLEFT,   0   
        ElseIf   Y   <=   intEdge   And   X   <=   ScaleWidth   Then                                 '上边   
              ReleaseCapture   
              SendMessage   hwnd,   WM_NCLBUTTONDOWN,   HTTOP,   0   
        End   If   
  End   Sub   
   
  Private   Sub   Form_MouseMove(Button   As   Integer,   Shift   As   Integer,   X   As   Single,   Y   As   Single)   
        'Critical:将处理四角的代码放在前面   
        If   (X   +   intEdge   >=   ScaleWidth   And   Y   +   intEdge   >=   ScaleHeight)   Or   (Y   <=   intEdge   And   X   <=   intEdge)   Then                       '右下\左上角   
              MousePointer   =   vbSizeNWSE   
        ElseIf   Y   +   intEdge   >=   ScaleHeight   And   X   <=   intEdge   Or   Y   <=   intEdge   And   X   +   intEdge   <=   ScaleWidth   Then                       '左下\右上角   
              MousePointer   =   vbSizeNESW   
        ElseIf   X   +   intEdge   >=   ScaleWidth   And   Y   <=   ScaleHeight   Or   X   <=   intEdge   And   Y   <=   ScaleHeight   Then       '左、右   
              MousePointer   =   vbSizeWE   
        ElseIf   Y   +   intEdge   >=   ScaleHeight   And   X   <=   ScaleWidth   Or   Y   <=   intEdge   And   X   <=   ScaleWidth   Then         '上边下边   
              MousePointer   =   vbSizeNS   
        Else   
              MousePointer   =   vbNormal   
        End   If   
  End   Sub   
   
  Private   Sub   Form_MouseUp(Button   As   Integer,   Shift   As   Integer,   X   As   Single,   Y   As   Single)   
        SetCapture   hwnd   
  End   Sub