📄 dym1report1.ctl
字号:
VERSION 5.00
Object = "{C5DE3F80-3376-11D2-BAA4-04F205C10000}#1.0#0"; "VSFLEX6D.OCX"
Object = "{FA301621-BF09-11CF-91F7-C2863C385E30}#2.0#0"; "VSVIEW2.OCX"
Begin VB.UserControl dyM1Report
ClientHeight = 3600
ClientLeft = 0
ClientTop = 0
ClientWidth = 4800
ScaleHeight = 3600
ScaleWidth = 4800
ToolboxBitmap = "dyM1Report1.ctx":0000
Begin vsViewLib.vsPrinter cPrnReport
Height = 375
Left = 240
TabIndex = 2
Top = 3240
Visible = 0 'False
Width = 615
_Version = 131072
_ExtentX = 1085
_ExtentY = 661
_StockProps = 228
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BorderStyle = 1
Appearance = 1
BeginProperty HdrFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Courier New"
Size = 14.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ConvInfo = 1413783674
End
Begin VSFlex6DAOCtl.vsFlexGrid cfgdReport
Height = 2175
Left = 360
TabIndex = 0
Top = 840
Width = 3975
_ExtentX = 7011
_ExtentY = 3836
_ConvInfo = 1
Appearance = 0
BorderStyle = 1
Enabled = -1 'True
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
MousePointer = 0
BackColor = -2147483643
ForeColor = -2147483640
BackColorFixed = -2147483633
ForeColorFixed = -2147483630
BackColorSel = 8388608
ForeColorSel = -2147483634
BackColorBkg = -2147483636
BackColorAlternate= -2147483643
GridColor = -2147483633
GridColorFixed = -2147483632
TreeColor = -2147483632
FloodColor = 192
SheetBorder = -2147483642
FocusRect = 1
HighLight = 1
AllowSelection = -1 'True
AllowBigSelection= -1 'True
AllowUserResizing= 3
SelectionMode = 0
GridLines = 2
GridLinesFixed = 1
GridLineWidth = 1
Rows = 50
Cols = 10
FixedRows = 1
FixedCols = 0
RowHeightMin = 0
RowHeightMax = 0
ColWidthMin = 0
ColWidthMax = 0
ExtendLastCol = 0 'False
FormatString = ""
ScrollTrack = -1 'True
ScrollBars = 3
ScrollTips = 0 'False
MergeCells = 0
MergeCompare = 0
AutoResize = -1 'True
AutoSizeMode = 0
AutoSearch = 0
MultiTotals = -1 'True
SubtotalPosition= 1
OutlineBar = 1
OutlineCol = 1
Ellipsis = 0
ExplorerBar = 3
PicturesOver = 0 'False
FillStyle = 1
RightToLeft = 0 'False
PictureType = 0
TabBehavior = 0
OwnerDraw = 0
Editable = -1 'True
ShowComboButton = -1 'True
WordWrap = 0 'False
TextStyle = 0
TextStyleFixed = 0
OleDragMode = 0
OleDropMode = 0
DataMode = 0
VirtualData = -1 'True
End
Begin VSFlex6DAOCtl.vsFlexGrid cfgdTitle
Align = 1 'Align Top
Height = 585
Left = 0
TabIndex = 1
Top = 0
Width = 4800
_ExtentX = 8467
_ExtentY = 1032
_ConvInfo = 1
Appearance = 0
BorderStyle = 1
Enabled = -1 'True
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "隶书"
Size = 15
Charset = 134
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 = -2147483636
BackColorAlternate= -2147483643
GridColor = -2147483633
GridColorFixed = -2147483632
TreeColor = -2147483632
FloodColor = 192
SheetBorder = -2147483642
FocusRect = 0
HighLight = 1
AllowSelection = -1 'True
AllowBigSelection= -1 'True
AllowUserResizing= 2
SelectionMode = 0
GridLines = 0
GridLinesFixed = 0
GridLineWidth = 1
Rows = 2
Cols = 10
FixedRows = 0
FixedCols = 0
RowHeightMin = 0
RowHeightMax = 0
ColWidthMin = 0
ColWidthMax = 0
ExtendLastCol = 0 'False
FormatString = ""
ScrollTrack = -1 'True
ScrollBars = 0
ScrollTips = 0 'False
MergeCells = 1
MergeCompare = 0
AutoResize = 0 'False
AutoSizeMode = 0
AutoSearch = 0
MultiTotals = -1 'True
SubtotalPosition= 1
OutlineBar = 0
OutlineCol = 0
Ellipsis = 0
ExplorerBar = 0
PicturesOver = 0 'False
FillStyle = 1
RightToLeft = 0 'False
PictureType = 0
TabBehavior = 0
OwnerDraw = 0
Editable = 0 'False
ShowComboButton = -1 'True
WordWrap = 0 'False
TextStyle = 0
TextStyleFixed = 0
OleDragMode = 0
OleDropMode = 0
DataMode = 0
VirtualData = -1 'True
End
Begin VB.Menu mnuField
Caption = "Open"
Index = 0
Visible = 0 'False
Begin VB.Menu mnufield1
Caption = "合计"
Index = 0
End
Begin VB.Menu mnufield1
Caption = "平均值"
Index = 1
End
Begin VB.Menu mnufield1
Caption = "个数"
Index = 2
End
Begin VB.Menu mnufield1
Caption = "最大值"
Index = 3
End
Begin VB.Menu mnufield1
Caption = "最小值"
Index = 4
End
End
Begin VB.Menu mnuShow
Caption = "显示/隐藏"
NegotiatePosition= 1 'Left
Visible = 0 'False
Begin VB.Menu mnuCol
Caption = "显示/隐藏"
Index = 0
End
End
End
Attribute VB_Name = "dyM1Report"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'此控件的接口有
'按某列对后续列汇总
'按列选择汇总方式
'禁止拖动某列(不允许对某列进行分组)
'支持树型结构显示
Option Explicit
'汇总方式
Public Enum dym1TotalType
dym1汇总 = 1
dym1平均 = 2
dym1个数 = 4
dym1最大值 = 8
dym1最小值 = 16
End Enum
'报表风格
Public Enum dym1ReportStyle
dym1Report3D = 0
dym1ReportClassic = 1
dym1ReportActive = 2
dym1ReportPretty = 3
dym1ReportGreen = 4
End Enum
'报表数据类型
Public Enum dym1DataType
dym1DTtext
dym1DTNumeric
dym1DTBoolean
dym1DTDate
End Enum
Dim mbolAltDown As Boolean
'Default Property Values:
Const m_def_HighLight = 0
Const m_def_bolAllowDragCol = True
Const m_def_bolColEditable = True
Const m_def_bolIsTotalShow = True
Const m_def_bolTitleIsVisible = True
Const m_def_Title = "报表标题"
Const m_def_ReportStyle = 1
Const m_def_SubTitles = "副标题|格式|用分号换行|用竖线换列"
'********************************************
'私有变量
'Property Variables:
Dim m_HighLight As ShowSelSettings
Dim m_bolAllowDragCol As Boolean
Dim m_bolColEditable As Boolean
Dim m_bolIsTotalShow As Boolean '是否显示总计
Dim m_bolTitleIsVisible As Boolean '是否显示标题
Dim m_Title As String '报表标题
Dim m_RecordSet As RecordSet '数据源
Dim m_ReportStyle As dym1ReportStyle
Dim m_SubTitles As String '子标题
Dim mcolTotalType As New Collection '对每列的一种汇总的方式
Dim mcolTotalTypes As New Collection '用户可选择的汇总方式
Dim mcolVirtualCol As New Collection '在列交换后保存列原始位置
Dim mcolColEditAble As New Collection '保存某列是否可修改
Dim mintCol As Integer
'Event Declarations:
Event CellButtonClick(Row As Long, Col As Long) 'MappingInfo=cfgdReport,cfgdReport,-1,CellButtonClick
Attribute CellButtonClick.VB_Description = "Fired after the user clicks a cell button."
Event Click() 'MappingInfo=cfgdReport,cfgdReport,-1,Click
Event DblClick() 'MappingInfo=UserControl,UserControl,-1,DblClick
Attribute DblClick.VB_Description = "当用户在一个对象上按下并释放鼠标按钮后再次按下并释放鼠标按钮时发生。"
Event GetHeaderRow(Row As Long, HeaderRow As Long) 'MappingInfo=cfgdReport,cfgdReport,-1,GetHeaderRow
Attribute GetHeaderRow.VB_Description = "Fired while printing the control to set repeating header rows."
Event Hide() 'MappingInfo=UserControl,UserControl,-1,Hide
Attribute Hide.VB_Description = "当控件的 Visible 属性变为 False 时发生。"
Event KeyDown(KeyCode As Integer, Shift As Integer)
Attribute KeyDown.VB_Description = "当用户在拥有焦点的对象上按下任意键时发生。"
Event KeyDownEdit(Row As Long, Col As Long, KeyCode As Integer, Shift As Integer) 'MappingInfo=cfgdReport,cfgdReport,-1,KeyDownEdit
Attribute KeyDownEdit.VB_Description = "Fired when the user presses a key in cell-editing mode."
Event KeyPress(KeyAscii As Integer) 'MappingInfo=cfgdReport,cfgdReport,-1,KeyPress
Event KeyPressEdit(Row As Long, Col As Long, KeyAscii As Integer) 'MappingInfo=cfgdReport,cfgdReport,-1,KeyPressEdit
Attribute KeyPressEdit.VB_Description = "Fired when the user presses a key in cell-editing mode."
Event Scroll() 'MappingInfo=cfgdReport,cfgdReport,-1,Scroll
Attribute Scroll.VB_Description = "Fired after the control scrolls."
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=cfgdReport,cfgdReport,-1,MouseDown
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseMove
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=cfgdReport,cfgdReport,-1,MouseUp
Event ChangeEdit() 'MappingInfo=cfgdReport,cfgdReport,-1,ChangeEdit
Attribute ChangeEdit.VB_Description = "Fired after the text in the editor has changed."
Public Event PreView(paraPreviewMode As Boolean)
'当用户拖动标题栏时,自动汇总
Private Sub cfgdReport_AfterMoveColumn(ByVal Col As Long, Position As Long)
Dim i As Integer
Dim lintType As Integer '汇总方式
On Error GoTo errhandle
With cfgdReport
'首先记录改动后的各列的位置
i = mcolVirtualCol(Col + 1)
mcolVirtualCol.Remove Col + 1
If Position = .Cols - 1 Then
mcolVirtualCol.Add i
Else
If Position <> 0 Then
mcolVirtualCol.Add i, , Position + 1
Else
mcolVirtualCol.Add i, , 1
End If
End If
If RecordSet Is Nothing Then Exit Sub
Call subShowResult
End With
Exit Sub
errhandle:
Err.Raise 200101, "dym1Grid", "AterMoveColumn出错"
End Sub
'根据第一列的分组方式来对各列进行汇总
Public Sub subShowResult()
Dim i As Integer
Dim lintType As Integer
Dim lstrFormat As String
On Error GoTo errhandle
'根据各列自己的汇总方式来进行汇总
With cfgdReport
.Redraw = False
.Subtotal flexSTClear '清空原来的汇总行
.Select 1, 0, 1, 0 '第一行排序
.Sort = flexSortGenericAscending
For i = 1 To .Cols - 1
lintType = intTotalType(mcolVirtualCol(i + 1) + 1)
lstrFormat = funcstrColFormat(lintType, i)
If m_bolIsTotalShow Then
.Subtotal lintType, -1, i, lstrFormat, vbBlue, vbWhite, True, "共计"
End If
.Subtotal lintType, 0, i, lstrFormat, &H404000, vbWhite, True
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -