vsflexgr.ctl

本公司开发得大请油田人事管理系统c/s结构

        End With
        
        ' save original position (none in this case)
        m_ptControl.X = -1
        m_ptControl.Y = -1
        
        ' start dragging
        m_bCapture = True
        m_bDragging = True
        m_ptDown.X = X - picGroup(newCtl).left
        m_ptDown.Y = VSFlexGrid4Group.top + Y - picGroup(newCtl).top
        picGroup_Paint newCtl
        
        ' this is really cool:
        ' flex got the mouse down, but we want the group control to handle it
        ' so we set Cancel to true and transfer the mouse to the group control
        ' using the SetCapture API.
        Cancel = True
        With picGroup(newCtl)
            .Visible = True
            .SetFocus
            SetCapture .hwnd
        End With
    End If
End Sub

Private Sub picGroup_Click(Index As Integer)

    ' unless we were dragging, revert sort direction
    If (Not m_bDragging) And (m_ptControl.X > -1) Then
        
        ' revert sort direction
        Dim i%
        i = picGroup(Index).Tag
        If VSFlexGrid4Group.ColSort(i) = flexSortGenericDescending Then
            VSFlexGrid4Group.ColSort(i) = flexSortGenericAscending
        Else
            VSFlexGrid4Group.ColSort(i) = flexSortGenericDescending
        End If
        
        ' show the change
        UpdateLayout True
        
    End If
End Sub

Private Sub picGroup_KeyPress(Index As Integer, KeyAscii As Integer)
    
    ' escape cancels dragging/clicking
    If (KeyAscii = 27) And (m_bCapture = True) Then
        
        ' move control back to its original position
        If m_bDragging Then
        
            ' if the group was still being created (not just dragged), delete it
            If m_ptControl.X < 0 And m_ptControl.Y < 0 Then
                DeleteGroup Index
            
            ' otherwise, move it back to where it was
            Else
                picGroup(Index).Move m_ptControl.X, m_ptControl.Y
            End If
        End If
        
        ' reset state variables
        m_bCapture = False
        m_bDragging = True
    
    End If
    
End Sub

Private Sub DeleteGroup(Index As Integer)
    
    ' remove control from the list
    Dim i%, j%
    i = picGroup(Index).Tag
    For j = i To m_iGroups - 2
        m_GroupInfo(j) = m_GroupInfo(j + 1)
    Next
    m_iGroups = m_iGroups - 1
    
    If m_iGroups = 0 Then VSFlexGrid4Group.Outline -1

    ' hide/unload the control
    picGroup(Index).Visible = False
    If Index > 0 Then Unload picGroup(Index)
    
End Sub

Private Sub picGroup_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)

    ' left button starts dragging
    If Button = 1 Then
    
        ' save dragging information
        m_bCapture = True
        m_bDragging = False
        m_ptDown.X = X
        m_ptDown.Y = Y
        
        ' bring control to top, save its original position
        picGroup(Index).ZOrder
        m_ptControl.X = picGroup(Index).left
        m_ptControl.Y = picGroup(Index).top
    End If

End Sub

Private Sub picGroup_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)

    ' drag control around
    If m_bCapture Then
        With picGroup(Index)
                        
            ' if we are not dragging yet, maybe it's time to start
            If Not m_bDragging Then
                If Abs(X - m_ptDown.X) > DRAG_TOLERANCE Then m_bDragging = True
                If Abs(Y - m_ptDown.Y) > DRAG_TOLERANCE Then m_bDragging = True
            End If
            
            ' if we're dragging, then do it
            If m_bDragging Then
            
                ' get new coordinates
                X = .left + (X - m_ptDown.X)
                Y = .top + (Y - m_ptDown.Y)
                
                ' restrict boundaries
                If X < 0 Then X = 0
                If Y < 0 Then Y = 0
                If X > UserControl.ScaleWidth - .Width Then X = UserControl.ScaleWidth - .Width
                If Y > UserControl.ScaleHeight - .Height Then Y = UserControl.ScaleHeight - .Height
                If Y > VSFlexGrid4Group.top Then Y = VSFlexGrid4Group.top
            
                ' move the control
                .Move X, Y
                
                ' show where we'd go if we dropped now
                ' UNDONE
                
            End If
        End With
    End If
End Sub

Private Sub picGroup_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    ' if we were dragging,
    ' we may have just moved the group to a new position, or
    ' we may have dropped it back into the grid
    If m_bDragging Then
        
        VSFlexGrid4Group.Redraw = False
        
        ' back into grid, different position
        Y = picGroup(Index).top + Y
        If Y > VSFlexGrid4Group.top Then
            
            ' see which column it was and where the mouse is
            Dim Col%, i%
            Col = FindColumn(m_GroupInfo(picGroup(Index).Tag).text)
            i = VSFlexGrid4Group.MouseCol
            
            ' different? move column
            If i <> Col Then
                If i > 0 Then VSFlexGrid4Group.ColPosition(Col) = i
            
            ' same? switch sort order
            Else
                If VSFlexGrid4Group.ColSort(i) = flexSortGenericAscending Then
                    VSFlexGrid4Group.ColSort(i) = flexSortGenericDescending
                Else
                    VSFlexGrid4Group.ColSort(i) = flexSortGenericAscending
                End If
            End If
            
            ' remove our brand-new group
            DeleteGroup Index
        
        End If
        
        ' either way, show changes
        UpdateLayout True
        
        VSFlexGrid4Group.Redraw = True
    End If

    ' cancel capture no matter what
    m_bCapture = False

End Sub

Private Sub picGroup_Paint(Index As Integer)
    
    Dim rc As RECT
    
    With picGroup(Index)
        
        ' draw frame
        rc.top = 0
        rc.left = 0
        rc.right = .Width / Screen.TwipsPerPixelX
        rc.bottom = .Height / Screen.TwipsPerPixelY
        DrawFrameControl .hDC, rc, DFC_BUTTON, DFCS_BUTTONPUSH
        
        ' draw text
        .CurrentX = .TextWidth(" ")
        .CurrentY = (.Height - .TextHeight(" ")) / 2.5
        picGroup(Index).Print m_GroupInfo(.Tag).text
        
        ' draw sort arrow if this is a group already
        If VSFlexGrid4Group.ColWidth(.Tag) = 0 Then
            Dim X As Single, Y As Single, sz As Single
            sz = .Height * (1 / 3)
            X = .Width - sz
            
            ' pointing up
            If VSFlexGrid4Group.ColSort(.Tag) = flexSortGenericDescending Then
                Y = (.Height - sz) / 2 + sz
                picGroup(Index).Line (X, Y)-(X - sz, Y), CLR_BTNHILITE
                picGroup(Index).Line -(X - sz / 2, Y - sz), CLR_BTNSHADOW
                picGroup(Index).Line -(X, Y), CLR_BTNHILITE
            
            ' pointing down
            Else
                Y = (.Height - sz) / 2
                picGroup(Index).Line (X, Y)-(X - sz, Y), CLR_BTNSHADOW
                picGroup(Index).Line -(X - sz / 2, Y + sz), CLR_BTNSHADOW
                picGroup(Index).Line -(X, Y), CLR_BTNHILITE
            End If
        End If
    End With

End Sub

Private Sub UserControl_Initialize()
    
    ' initialize embedded FlexGrid
    With VSFlexGrid4Group
        .SelectionMode = flexSelectionByRow
        .AllowUserResizing = flexResizeColumns
        .OutlineBar = flexOutlineBarComplete
        .ExplorerBar = flexExSortAndMove
    End With
    
    ' initialize group control based on grid data
    With picGroup(0)
        .Font = VSFlexGrid4Group.Font
        .Height = VSFlexGrid4Group.RowHeight(0)
        .Tag = 0
    End With

End Sub

Private Sub UpdateLayout(dogrid As Boolean)
    
    Dim swap As GROUPINFO
    Dim i%, cnt%, done%
    Dim X As Single, Y As Single, rh As Single
    Dim offsety As Single
    
    ' see how many groups are visible
    cnt = m_iGroups
    
    ' dimension and clear grouping area
    rh = VSFlexGrid4Group.RowHeight(0)
    offsety = rh / 2
    Y = 2 * VSFlexGrid4Group.RowHeight(0)
    If cnt > 1 Then Y = Y + (cnt - 1) * offsety
    Y = UserControl.ScaleHeight - Y
    If Y < 0 Then Y = 0
    VSFlexGrid4Group.Height = Y
    UserControl.Cls
    
    ' if no groups, show helpful message
    If cnt = 0 Then
        UserControl.CurrentX = rh / 2
        UserControl.CurrentY = rh / 2
        UserControl.Print HELPMSG
    End If
    
    ' sort group vector by position (left-to-right)
    While Not done
        done = True
        For i = 0 To cnt - 2
            If m_GroupInfo(i).ctl.left > m_GroupInfo(i + 1).ctl.left Then
                done = False
                swap = m_GroupInfo(i)
                m_GroupInfo(i) = m_GroupInfo(i + 1)
                m_GroupInfo(i + 1) = swap
            End If
        Next
    Wend
    
    ' each control gets and index into the vector
    For i = 0 To cnt - 1
        m_GroupInfo(i).ctl.Tag = i
    Next
    
    ' position group controls
    Y = rh / 2
    X = Y
    For i = 0 To cnt - 1
        With m_GroupInfo(i).ctl
        
            ' move the control
            .Move X, Y
            Y = Y + offsety
            X = X + .Width + rh / 3
        
            ' draw connector
            If i < cnt - 1 Then
                UserControl.Line (X, Y + 2 / 3 * rh)-(X - rh * 2 / 3, Y + 2 / 3 * rh), 0
                UserControl.Line -(X - rh * 2 / 3, Y + rh / 2 - Screen.TwipsPerPixelY), 0
            End If
    
            ' draw placeholder
            UserControl.Line (.left, .top)-(.left + .Width - Screen.TwipsPerPixelX, .top + .Height - Screen.TwipsPerPixelY), 0, B
        
        End With
    Next
    
    ' redraw all controls at their new positions
    For i = 0 To cnt - 1
        picGroup_Paint m_GroupInfo(i).ctl.Index
    Next
    UserControl.Refresh
    
    ' update the grid
    If dogrid Then UpdateGrid
    
    ' redraw all controls at their new positions (to show sort direction)
    For i = 0 To cnt - 1
        picGroup_Paint m_GroupInfo(i).ctl.Index
    Next
    
End Sub

Private Sub UserControl_Resize()
    UpdateLayout False
End Sub

Public Property Get FlexGrid() As VSFlex7Ctl.VSFlexGrid
    Set FlexGrid = VSFlexGrid4Group
End Property

Public Sub Update()
    UpdateLayout True
End Sub