📄 frmqryplay1.frm
字号:
VERSION 5.00
Object = "{8099FCC2-0A81-11D2-BAA4-04F205C10000}#1.0#0"; "Vsflex6.ocx"
Begin VB.Form frmQryPlay1
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "查询"
ClientHeight = 6375
ClientLeft = 45
ClientTop = 330
ClientWidth = 9615
FillColor = &H00808080&
LinkTopic = "Form2"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 6375
ScaleWidth = 9615
Begin VSFlex6Ctl.vsFlexGrid CountGrid
Height = 375
Left = 0
TabIndex = 1
Top = 6000
Width = 9615
_cx = 1196608
_cy = 1180309
_ConvInfo = -1
Appearance = 0
BorderStyle = 1
Enabled = -1 'True
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
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 = 12510433
ForeColorSel = 12582912
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= 0
SelectionMode = 1
GridLines = 1
GridLinesFixed = 2
GridLineWidth = 1
Rows = 1
Cols = 15
FixedRows = 0
FixedCols = 1
RowHeightMin = 350
RowHeightMax = 400
ColWidthMin = 0
ColWidthMax = 0
ExtendLastCol = 0 'False
FormatString = ""
ScrollTrack = 0 'False
ScrollBars = 0
ScrollTips = 0 'False
MergeCells = 0
MergeCompare = 0
AutoResize = -1 'True
AutoSizeMode = 0
AutoSearch = 0
MultiTotals = -1 'True
SubtotalPosition= 1
OutlineBar = 0
OutlineCol = 0
Ellipsis = 0
ExplorerBar = 0
PicturesOver = 0 'False
FillStyle = 0
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
DataMember = ""
End
Begin VSFlex6Ctl.vsFlexGrid QueryGrid
Height = 6015
Left = 0
TabIndex = 0
Top = 0
Width = 9615
_cx = 1196608
_cy = 1190258
_ConvInfo = -1
Appearance = 0
BorderStyle = 1
Enabled = -1 'True
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
MousePointer = 0
BackColor = 16777215
ForeColor = -2147483640
BackColorFixed = -2147483633
ForeColorFixed = -2147483630
BackColorSel = -2147483635
ForeColorSel = 16777215
BackColorBkg = -2147483636
BackColorAlternate= 16777215
GridColor = -2147483633
GridColorFixed = -2147483632
TreeColor = -2147483632
FloodColor = 192
SheetBorder = -2147483642
FocusRect = 1
HighLight = 1
AllowSelection = 0 'False
AllowBigSelection= 0 'False
AllowUserResizing= 1
SelectionMode = 0
GridLines = 1
GridLinesFixed = 2
GridLineWidth = 1
Rows = 50
Cols = 15
FixedRows = 1
FixedCols = 1
RowHeightMin = 300
RowHeightMax = 600
ColWidthMin = 0
ColWidthMax = 0
ExtendLastCol = 0 'False
FormatString = ""
ScrollTrack = 0 'False
ScrollBars = 3
ScrollTips = 0 'False
MergeCells = 0
MergeCompare = 0
AutoResize = -1 'True
AutoSizeMode = 0
AutoSearch = 0
MultiTotals = -1 'True
SubtotalPosition= 0
OutlineBar = 0
OutlineCol = 0
Ellipsis = 0
ExplorerBar = 0
PicturesOver = 0 'False
FillStyle = 0
RightToLeft = 0 'False
PictureType = 0
TabBehavior = 1
OwnerDraw = 0
Editable = 0 'False
ShowComboButton = -1 'True
WordWrap = 0 'False
TextStyle = 0
TextStyleFixed = 0
OleDragMode = 0
OleDropMode = 0
DataMode = 0
VirtualData = -1 'True
DataMember = ""
End
End
Attribute VB_Name = "frmQryPlay1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim RptName As String, WantCounts() As Boolean, Counts() As Currency
Dim Types() As String, SortField As Long, SortType As Boolean
Private Sub Form_Load()
Dim QueryRst As ADODB.Recordset
Dim i As Long, j As Long, Para(1 To 8)
Me.Show
DoEvents
Me.MousePointer = 11
For i = 1 To 8
Para(i) = QuickTranArray(i)
Next
'GetConnect.ConnectionTimeout = 300
RptName = QuickTranArray(3)
Me.Caption = QuickTranArray(4)
If QuickTranArray(1) = "SQL" Then
Set QueryRst = New ADODB.Recordset
'Debug.Print "SQL=" & QuickTranArray(9)
'Opadc Adodc1, QuickTranArray(9)
QueryRst.Open QuickTranArray(9), GetConnect, adOpenForwardOnly
Else
Set QueryRst = Rst_DisPlayQuery
End If
'QueryGrid.VirtualData = False
Set QueryGrid.DataSource = QueryRst
'Set QueryGrid.DataSource = Nothing
' If QuickTranArray(1) = "SQL" Then
' QueryRst.Close
' End If
' Set QueryRst = Nothing
'=============================标题================================================
KillString Para(2)
For i = 1 To QueryGrid.Cols - 1
If i <= QuickTranCount Then
QueryGrid.Cell(flexcpText, 0, i) = QuickTranArray(i)
'Debug.Print QuickTranArray(i)
End If
QueryGrid.Cell(flexcpAlignment, 0, i) = 5
Next
'=============================宽度================================================
QueryGrid.ColWidth(0) = 500
KillString Para(5)
For i = 1 To QueryGrid.Cols - 1
If i <= QuickTranCount Then
QueryGrid.ColWidth(i) = QuickTranArray(i)
End If
Next
'=============================格式================================================
KillString Para(8)
For i = 1 To QueryGrid.Cols - 1
If i <= QuickTranCount Then
If QuickTranArray(i) <> "" Then
QueryGrid.ColFormat(i) = QuickTranArray(i)
End If
End If
Next
'=============================汇总================================================
ReDim WantCounts(1 To QueryGrid.Cols - 1)
KillString Para(6)
For i = 1 To QueryGrid.Cols - 1
If i <= QuickTranCount Then
WantCounts(i) = IIf(QuickTranArray(i) = "0", False, True)
Else
WantCounts(i) = False
End If
Next
ReDim Counts(1 To QueryGrid.Cols - 1)
For i = 1 To QueryGrid.Rows - 1
QueryGrid.Cell(flexcpText, i, 0) = i
For j = 1 To QueryGrid.Cols - 1
If WantCounts(j) Then
Counts(j) = Counts(j) + Val(QueryGrid.Cell(flexcpText, i, j))
End If
Next
Next
' CountGrid.BindToArray Counts
CountGrid.FixedCols = 1
CountGrid.Cols = QueryGrid.Cols
For i = 1 To QueryGrid.Cols - 1
CountGrid.Cell(flexcpText, 0, i) = IIf(Counts(i) = 0, "", Counts(i))
Next
CountGrid.Cell(flexcpText, 0, 0) = "合计"
QueryGrid_Scroll
'=============================排序================================================
ReDim Types(1 To QueryGrid.Cols - 1)
KillString Para(7)
For i = 1 To QueryGrid.Cols - 1
If i <= QuickTranCount Then
Types(i) = QuickTranArray(i)
Else
Types(i) = ""
End If
Next
CountGrid.Cols = QueryGrid.Cols
For i = 0 To QueryGrid.Cols - 1
CountGrid.ColWidth(i) = QueryGrid.ColWidth(i)
Next
CountGrid.Refresh
Me.MousePointer = 0
End Sub
Private Sub Form_Resize()
' Dim i As Long
' CountGrid.Cols = QueryGrid.Cols
' For i = 0 To QueryGrid.Cols - 1
' CountGrid.ColWidth(i) = QueryGrid.ColWidth(i)
' Next
' CountGrid.Refresh
End Sub
Private Sub QueryGrid_AfterUserResize(ByVal Row As Long, ByVal Col As Long)
CountGrid.ColWidth(Col) = QueryGrid.ColWidth(Col)
CountGrid.LeftCol = QueryGrid.LeftCol
End Sub
Private Sub QueryGrid_DblClick()
Dim xCol As Long, xRow As Long, i As Long
If Me.QueryGrid.MouseRow = 0 And Me.QueryGrid.MouseCol > 0 Then
xRow = Me.QueryGrid.MouseRow
xCol = Me.QueryGrid.MouseCol
Me.QueryGrid.Col = xCol
Me.QueryGrid.ColDataType(xCol) = flexDTDate
If xCol = SortField Then
SortType = True
Else
SortField = xCol
SortType = False
End If
' Debug.Print Me.QueryGrid.Cell(flexcpText, 0, xCol)
'MsgBox Types(xCol)
Select Case Types(xCol)
Case "货币", "数字"
If SortType Then
Me.QueryGrid.ColSort(xCol) = flexSortNumericDescending
Me.QueryGrid.Sort = flexSortNumericDescending
Else
Me.QueryGrid.ColSort(xCol) = flexSortNumericAscending
Me.QueryGrid.Sort = flexSortNumericAscending
End If
Case "字符"
If SortType Then
Me.QueryGrid.ColSort(xCol) = flexSortStringDescending
Me.QueryGrid.Sort = flexSortStringDescending
Else
Me.QueryGrid.ColSort(xCol) = flexSortStringAscending
Me.QueryGrid.Sort = flexSortStringAscending
End If
Case "日期"
If SortType Then
Me.QueryGrid.ColSort(xCol) = flexSortStringDescending
Me.QueryGrid.Sort = flexSortStringDescending
Else
Me.QueryGrid.ColSort(xCol) = flexSortStringAscending
Me.QueryGrid.Sort = flexSortStringAscending
End If
Case Else
If SortType Then
Me.QueryGrid.ColSort(xCol) = flexSortStringDescending
Me.QueryGrid.Sort = flexSortStringDescending
Else
Me.QueryGrid.ColSort(xCol) = flexSortStringAscending
Me.QueryGrid.Sort = flexSortStringAscending
End If
End Select
Me.QueryGrid.Refresh
QueryGrid_Scroll
For i = 1 To QueryGrid.Rows - 1
QueryGrid.Cell(flexcpText, i, 0) = i
Next
End If
End Sub
Private Sub QueryGrid_Scroll()
Dim i As Long, j As Long
On Error Resume Next
CountGrid.LeftCol = QueryGrid.LeftCol
For i = QueryGrid.TopRow To QueryGrid.BottomRow
For j = QueryGrid.LeftCol To QueryGrid.RightCol
If i Mod 2 = 0 Then
QueryGrid.Cell(flexcpBackColor, i, j) = &HE3FBFB '&HBEE4E1
Else
QueryGrid.Cell(flexcpBackColor, i, j) = &HBEE4E1 '&HC0EEC0 '&HE3FBFB
End If
Next
Next
End Sub
Private Sub RptPrint_Click()
If RptName = "" Then
MsgBox "未定义报表!"
Else
' Dim rep As ActiveReport
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -