📄 vsflexgr.ctl
字号:
VERSION 5.00
Object = "{D76D7128-4A96-11D3-BD95-D296DC2DD072}#1.0#0"; "Vsflex7.ocx"
Begin VB.UserControl VSFlexGroup
Alignable = -1 'True
AutoRedraw = -1 'True
BackColor = &H80000010&
BorderStyle = 1 'Fixed Single
ClientHeight = 4635
ClientLeft = 0
ClientTop = 0
ClientWidth = 4965
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000E&
KeyPreview = -1 'True
ScaleHeight = 4635
ScaleWidth = 4965
Begin VB.PictureBox picGroup
AutoRedraw = -1 'True
BorderStyle = 0 'None
Height = 420
Index = 0
Left = 540
ScaleHeight = 420
ScaleWidth = 1260
TabIndex = 1
Tag = "Hello"
Top = 360
Visible = 0 'False
Width = 1260
End
Begin VSFlex7Ctl.VSFlexGrid VSFlexGrid4Group
Align = 2 'Align Bottom
Height = 3570
Left = 0
TabIndex = 0
Top = 1065
Width = 4965
_cx = 8758
_cy = 6297
_ConvInfo = 1
Appearance = 0
BorderStyle = 0
Enabled = -1 'True
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
MousePointer = 0
BackColor = -2147483643
ForeColor = -2147483640
BackColorFixed = -2147483633
ForeColorFixed = -2147483630
BackColorSel = -2147483635
ForeColorSel = -2147483634
BackColorBkg = 8421504
BackColorAlternate= -2147483643
GridColor = 14737632
GridColorFixed = 0
TreeColor = -2147483632
FloodColor = 192
SheetBorder = 0
FocusRect = 1
HighLight = 1
AllowSelection = -1 'True
AllowBigSelection= -1 'True
AllowUserResizing= 0
SelectionMode = 0
GridLines = 1
GridLinesFixed = 12
GridLineWidth = 1
Rows = 1
Cols = 10
FixedRows = 1
FixedCols = 1
RowHeightMin = 0
RowHeightMax = 0
ColWidthMin = 0
ColWidthMax = 0
ExtendLastCol = -1 'True
FormatString = ""
ScrollTrack = 0 'False
ScrollBars = 3
ScrollTips = 0 'False
MergeCells = 6
MergeCompare = 0
AutoResize = -1 'True
AutoSizeMode = 0
AutoSearch = 0
AutoSearchDelay = 2
MultiTotals = -1 'True
SubtotalPosition= 1
OutlineBar = 0
OutlineCol = 0
Ellipsis = 0
ExplorerBar = 3
PicturesOver = 0 'False
FillStyle = 0
RightToLeft = 0 'False
PictureType = 0
TabBehavior = 0
OwnerDraw = 0
Editable = 0
ShowComboButton = -1 'True
WordWrap = 0 'False
TextStyle = 0
TextStyleFixed = 0
OleDragMode = 0
OleDropMode = 0
DataMode = 0
VirtualData = -1 'True
DataMember = ""
ComboSearch = 3
AutoSizeMouse = -1 'True
FrozenRows = 0
FrozenCols = 0
AllowUserFreezing= 0
BackColorFrozen = 0
ForeColorFrozen = 0
WallPaperAlignment= 9
End
End
Attribute VB_Name = "VSFlexGroup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'--------------------------------------------------------
' API declarations
Private Type RECT
left As Long
top As Long
right As Long
bottom As Long
End Type
Private Const DFC_BUTTON = 4
Private Const DFCS_BUTTONPUSH = &H10
Private Declare Function DrawFrameControl Lib "user32" (ByVal hDC As Long, lpRect As RECT, ByVal un1 As Long, ByVal un2 As Long) As Long
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
'--------------------------------------------------------
' private declarations
Private Type POINTSGL
X As Single
Y As Single
End Type
Private Type GROUPINFO
ctl As PictureBox
text As String
End Type
Private Const CLR_BTNFACE = &H8000000F
Private Const CLR_BTNSHADOW = &H80000010
Private Const CLR_BTNHILITE = &H80000014
Private Const HELPMSG = "拖动表的列头名到这里可以按此列内容分类，也可以拖动表的列头来改变列位置。"
Private Const DRAG_TOLERANCE = 100 ' Twips
'--------------------------------------------------------
' variables
' mouse control
Private m_bCapture As Boolean ' mouse captured?
Private m_bDragging As Boolean ' dragging control?
Private m_ptDown As POINTSGL ' where was the click
Private m_ptControl As POINTSGL ' original coordinates
Private m_iGroups As Integer ' how many groups do we have
Private m_GroupInfo() As GROUPINFO ' group information vector
Dim m_bIsFirst As Boolean
Private Function FindColumn(s$) As Integer
' locate column based on header text
Dim i%
For i = 0 To VSFlexGrid4Group.Cols - 1
If VSFlexGrid4Group.Cell(flexcpTextDisplay, 0, i) = s Then
FindColumn = i
Exit Function
End If
Next
' this should never happen
FindColumn = -1
End Function
Private Sub UpdateGrid()
Dim i As Long, j As Long
On Error GoTo HaveNext
If m_bIsFirst = True Then
For i = 0 To VSFlexGrid4Group.Cols - 1
If VSFlexGrid4Group.ColHidden(i) = True Then
VSFlexGrid4Group.Cell(flexcpData, 0, i, 0, i) = 1
Else
VSFlexGrid4Group.Cell(flexcpData, 0, i, 0, i) = 0
End If
Next
m_bIsFirst = False
End If
' redraw is off to speed things up
VSFlexGrid4Group.Redraw = False
' move groups to left
Dim Col%
For i = VSFlexGrid4Group.FixedCols To m_iGroups + VSFlexGrid4Group.FixedCols - 1
Col = FindColumn(m_GroupInfo(i - VSFlexGrid4Group.FixedCols).text)
VSFlexGrid4Group.ColPosition(Col) = i
Next
' hide groups, make sure they're all sortable
For i = VSFlexGrid4Group.FixedCols To m_iGroups + VSFlexGrid4Group.FixedCols - 1
VSFlexGrid4Group.ColHidden(i) = True
If VSFlexGrid4Group.ColSort(i) = 0 Then VSFlexGrid4Group.ColSort(i) = flexSortGenericAscending
Next
' show non-groups
For i = m_iGroups + VSFlexGrid4Group.FixedCols To VSFlexGrid4Group.Cols - 1
If VSFlexGrid4Group.Cell(flexcpData, 0, i) = 0 Then
VSFlexGrid4Group.ColHidden(i) = False
End If
Next
' sort
VSFlexGrid4Group.Select VSFlexGrid4Group.Row, 0, VSFlexGrid4Group.Row, VSFlexGrid4Group.Cols - 1
VSFlexGrid4Group.Sort = flexSortUseColSort
' create groups
VSFlexGrid4Group.Subtotal flexSTClear
If m_iGroups > 0 Then
'VSFlexGrid4Group.MultiTotals = True
For i = VSFlexGrid4Group.FixedCols To m_iGroups + VSFlexGrid4Group.FixedCols - 1
VSFlexGrid4Group.Subtotal flexSTNone, i, , , CLR_BTNFACE, , True, , VSFlexGrid4Group.FixedCols
VSFlexGrid4Group.Subtotal flexSTCount, i, VSFlexGrid4Group.Cols - 1, "##0", , , True, , , True
Next
' group them
VSFlexGrid4Group.Outline m_iGroups + VSFlexGrid4Group.FixedCols - 1
VSFlexGrid4Group.OutlineCol = VSFlexGrid4Group.FixedCols - 1
VSFlexGrid4Group.AutoSize VSFlexGrid4Group.FixedCols - 1
' VSFlexGrid4Group.OutlineCol = m_iGroups + VSFlexGrid4Group.FixedCols
' VSFlexGrid4Group.AutoSize m_iGroups + VSFlexGrid4Group.FixedCols
End If
' move text to visible rows
If m_iGroups > 0 Then
For i = 1 To VSFlexGrid4Group.Rows - 1
If VSFlexGrid4Group.IsSubtotal(i) Then
'Dim nd As VSFlexNode
'Set nd = VSFlexGrid4Group.GetNode(i)
Dim s$
s = VSFlexGrid4Group.Cell(flexcpTextDisplay, i, VSFlexGrid4Group.FixedCols + VSFlexGrid4Group.RowOutlineLevel(i) - 1)
s = s & "(" & VSFlexGrid4Group.Cell(flexcpTextDisplay, i, VSFlexGrid4Group.Cols - 1) & ")"
VSFlexGrid4Group.Cell(flexcpText, i, VSFlexGrid4Group.Cols - 1) = ""
'VSFlexGrid4Group.Cell(flexcpText, i, VSFlexGrid4Group.FixedCols + VSFlexGrid4Group.RowOutlineLevel(i) - 1) = ""
VSFlexGrid4Group.Cell(flexcpText, i, VSFlexGrid4Group.FixedCols + m_iGroups) = s '& nd.child
End If
Next
End If
VSFlexGrid4Group.MergeCells = flexMergeSpill
' redraw is back on
VSFlexGrid4Group.Redraw = True
HaveNext:
End Sub
Private Sub VSFlexGrid4Group_BeforeDataRefresh(Cancel As Boolean)
Dim i As Integer
If m_iGroups > 0 Then
On Error Resume Next
For i = 1 To m_iGroups
DeleteGroup i
Next
End If
m_bIsFirst = True
VSFlexGrid4Group.clear 0, 0
Update
End Sub
Private Sub vsflexgrid4group_BeforeMouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single, Cancel As Boolean)
' if we clicked on a column, start dragging it
If Button = 1 And Shift = 0 And VSFlexGrid4Group.MouseRow = 0 And VSFlexGrid4Group.MouseCol > VSFlexGrid4Group.FixedCols - 1 Then
' make sure we don't group on everything
If m_iGroups >= VSFlexGrid4Group.Cols - 1 Then
Exit Sub
End If
' which column are we grouping on?
Dim Col%
Col = VSFlexGrid4Group.MouseCol
' confirm that this is a groupable column
Dim i%
For i = 0 To m_iGroups - 1
If m_GroupInfo(i).text = VSFlexGrid4Group.Cell(flexcpTextDisplay, 0, Col) Then
Cancel = True
Beep
Exit Sub
End If
Next
' UNDONE
' create entry in global array
i = m_iGroups
m_iGroups = m_iGroups + 1
ReDim Preserve m_GroupInfo(i)
' create new group control
Static newCtl%
newCtl = newCtl + 1
Load picGroup(newCtl)
Set m_GroupInfo(i).ctl = picGroup(newCtl)
m_GroupInfo(i).text = VSFlexGrid4Group.Cell(flexcpTextDisplay, 0, Col)
' init group control
With picGroup(newCtl)
.Tag = i
.Width = .TextWidth(m_GroupInfo(i).text) + 2 * VSFlexGrid4Group.RowHeight(0)
.Height = VSFlexGrid4Group.RowHeight(0) * 1.1
.Move VSFlexGrid4Group.ColPos(Col), VSFlexGrid4Group.top
.Font = VSFlexGrid4Group.Font
.ZOrder
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -