Code des Controls SizeGrip

Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Private Declare Function DrawFrameControl Lib "user32" _
 (ByVal hDC As Long, lpRect As RECT, ByVal nCtlType As Long, _
 ByVal nFlags As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" _
 (ByVal nIndex As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () _
 As Long
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 mForm As Form

Private WithEvents eForm As Form

Public Event MouseDown(Button As Integer, Shift As Integer, _
 X As Single, Y As Single)
Public Event MouseMove(Button As Integer, Shift As Integer, _
 X As Single, Y As Single)
Public Event MouseUp(Button As Integer, Shift As Integer, _
 X As Single, Y As Single)
Public Event ScrollbarSizeChanged(ByVal VScrollWidth As Long, _
 ByVal HScrollHeight As Long)

Private pAutoZOrder As Boolean
Private pHScrollHeight As Long
Private pVScrollWidth As Long

Public Property Get AutoZOrder() As Boolean
  AutoZOrder = pAutoZOrder
End Property

Public Property Let AutoZOrder(ByVal New_AutoZOrder As Boolean)
  pAutoZOrder = New_AutoZOrder
  PropertyChanged "AutoZOrder"
End Property

Public Property Get HScrollHeight() As Long
  HScrollHeight = pHScrollHeight
End Property

Public Property Get VScrollWidth() As Long
  VScrollWidth = pVScrollWidth
End Property

Public Sub DoSize(ByVal AnyHwnd As Long)
  zSize AnyHwnd
End Sub

Private Sub eForm_Resize()
  UserControl_Resize
End Sub

Private Sub UserControl_Initialize()
  pAutoZOrder = True
End Sub

Private Sub UserControl_MouseDown(Button As Integer, _
 Shift As Integer, X As Single, Y As Single)
  If mForm Is Nothing Then
    RaiseEvent MouseDown(Button, Shift, X, Y)
  Else
    Select Case Button
      Case vbLeftButton
        zSize mForm.Hwnd
    End Select
  End If
End Sub

Private Sub UserControl_MouseMove(Button As Integer, _
 Shift As Integer, X As Single, Y As Single)
  RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub

Private Sub UserControl_MouseUp(Button As Integer, _
 Shift As Integer, X As Single, Y As Single)
  RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub

Private Sub UserControl_Paint()
  Dim nRect As RECT
  
  Const DFC_SCROLL = 3
  Const DFCS_SCROLLSIZEGRIP = &H8

  Static sInProc As Boolean
  
  If sInProc Then
    Exit Sub
  Else
    sInProc = True
  End If
  UserControl_Resize
  With UserControl
    nRect.Right = .ScaleWidth
    nRect.Bottom = .ScaleHeight
    DrawFrameControl .hDC, nRect, DFC_SCROLL, DFCS_SCROLLSIZEGRIP
    If Not Ambient.UserMode Then
      UserControl.Line (0, 0)-(.ScaleWidth - 1, .ScaleHeight - 1), _
       vbBlack, B
    End If
  End With
  sInProc = False
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  pAutoZOrder = PropBag.ReadProperty("AutoZOrder", True)
  With UserControl
    If TypeOf .Parent Is Form Then
      If Not TypeOf .Parent Is MDIForm Then
        Set mForm = .Parent
        If Ambient.UserMode Then
          Set eForm = mForm
        End If
      End If
    End If
  End With
End Sub

Private Sub UserControl_Resize()
  Dim nVScrollWidth As Long
  Dim nHScrollHeight As Long
  Dim nChanged As Boolean
  Dim nWidth As Single
  Dim nHeight As Single
  
  Const SM_CXVSCROLL = 2
  Const SM_CYHSCROLL = 3
  
  Static sInProc As Boolean
  
  If sInProc Then
    Exit Sub
  Else
    sInProc = True
  End If
  On Error Resume Next
  If pAutoZOrder Then
    Extender.ZOrder 1
  End If
  nVScrollWidth = GetSystemMetrics(SM_CXVSCROLL)
  nHScrollHeight = GetSystemMetrics(SM_CYHSCROLL)
  If CBool(nVScrollWidth <> pVScrollWidth) _
   Or CBool(nHScrollHeight <> pHScrollHeight) Then
    pVScrollWidth = nVScrollWidth
    pHScrollHeight = nHScrollHeight
    nChanged = True
  End If
  If Ambient.UserMode Then
    If mForm Is Nothing Then
      UserControl.Size pVScrollWidth * Screen.TwipsPerPixelX, _
       pHScrollHeight * Screen.TwipsPerPixelY
    Else
      With mForm
        nWidth = .ScaleX(pVScrollWidth, vbPixels, .ScaleMode)
        nHeight = .ScaleY(pHScrollHeight, vbPixels, .ScaleMode)
        Extender.Move .ScaleWidth - nWidth, _
         .ScaleHeight - nHeight, nWidth, nHeight
      End With
    End If
  Else
    UserControl.Size pVScrollWidth * Screen.TwipsPerPixelX, _
     pHScrollHeight * Screen.TwipsPerPixelY
  End If
  UserControl_Paint
  If nChanged Then
    RaiseEvent ScrollbarSizeChanged(pVScrollWidth, pHScrollHeight)
  End If
  sInProc = False
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  PropBag.WriteProperty "AutoZOrder", pAutoZOrder, True
End Sub

Private Sub zSize(ByVal iHwnd As Long)
  Const WM_NCLBUTTONDOWN = &HA1
  Const HTBOTTOMRIGHT = 17

  ReleaseCapture
  SendMessage iHwnd, WM_NCLBUTTONDOWN, HTBOTTOMRIGHT, 0
End Sub

Copyright © 1999 - 2011 Harald M. Genauck, ip-pro gmbh  /  Impressum