📄 frmcross.frm
字号:
End
Begin VB.Label LblDrag
Height = 255
Left = -71460
TabIndex = 59
Top = 3720
Visible = 0 'False
Width = 795
End
Begin VB.Label LblData
Caption = "数据"
Height = 315
Left = -70320
TabIndex = 35
Top = 1680
Width = 435
End
Begin VB.Label LblRow
Caption = "行"
Height = 315
Left = -72840
TabIndex = 27
Top = 1680
Width = 435
End
Begin VB.Label LblCol
Caption = "列"
Height = 315
Left = -70380
TabIndex = 31
Top = 900
Width = 495
End
Begin VB.Line Line2
X1 = -72940
X2 = -67960
Y1 = 1380
Y2 = 1380
End
Begin VB.Line Line1
X1 = -70500
X2 = -70500
Y1 = 615
Y2 = 2195
End
Begin VB.Shape shpCross
BackColor = &H80000011&
BorderColor = &H80000016&
Height = 1605
Left = -72960
Top = 600
Width = 5025
End
Begin ComctlLib.ImageList ImageList1
Left = -74325
Top = 1740
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 13
ImageHeight = 13
MaskColor = 12632256
_Version = 327682
BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7}
NumListImages = 3
BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmCross.frx":0203
Key = "open"
EndProperty
BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmCross.frx":02FD
Key = "closed"
EndProperty
BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmCross.frx":03F7
Key = "book"
EndProperty
EndProperty
End
Begin VB.Label LblList
Caption = "列名(&L)"
Height = 255
Left = -70620
TabIndex = 20
Top = 3360
Width = 675
End
Begin VB.Label LblReport
Caption = "报表项目"
Height = 225
Index = 0
Left = -69960
TabIndex = 13
Top = 600
Width = 1575
End
Begin VB.Label LblDataField
Caption = "数据项目"
Height = 225
Left = -72660
TabIndex = 11
Top = 600
Width = 1035
End
Begin VB.Label LblReportName
Caption = "报表名称"
Height = 375
Left = -72660
TabIndex = 7
Top = 600
Width = 1035
End
End
Begin VB.Line linSep
BorderColor = &H00808080&
Index = 0
X1 = -60.241
X2 = 7971.888
Y1 = 4493.671
Y2 = 4493.671
End
Begin VB.Line linSep
BorderColor = &H00FFFFFF&
Index = 1
X1 = 0
X2 = 7971.888
Y1 = 4509.494
Y2 = 4509.494
End
End
Attribute VB_Name = "frmCross"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 交叉表向导窗体
' 作者：邓强
' 日期：1998.06.26
'
' 引导用户选择交叉表项目
' SetCross 初始化向导, 返回是否选中"完成"按钮(CrossSet类模块调用)
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 查询条件变量
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private WithEvents mclsHook As Hook
Attribute mclsHook.VB_VarHelpID = -1
Private mclsFilter As FormCond '查询条件类
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 向导变量
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private mclsCross As CrossSet '交叉表类
Private mblnMeOK As Boolean '是否选中"完成"按钮
Private mblnFieldChanged As Boolean '是否重选查询项目
Private mOldLstNO As Byte '窗体旧的列表值 1:lstrow,2:lstcol,3:lstdata
Private mDragSource As Byte '拖动源列表1:lstrow,2:lstcol,3:lstdata,4:lstfield
Private Const mlngDragHeight As Long = 200 '拖动标记高度
Private Const mlngDragWidth As Long = 1500 '拖动标记高度
Private mblnIsDrag As Boolean '拖动标志
Private mblnIsInited(3) As Boolean 'Tab是否已初始化
Private Sub cmdAddCol_Click()
Dim intDel As Integer '要添加列索引(在源列表中被删除)
If LstCol.ListCount = 4 Then
Utility.ShowMsg Me.hwnd, "不能再加列项目了!", vbOKOnly, App.title
Exit Sub
End If
If LstField.ListIndex <> -1 Then
intDel = LstField.ListIndex
LstCol.AddItem LstField.list(LstField.ListIndex)
LstCol.Selected(LstCol.NewIndex) = True
LstField.RemoveItem LstField.ListIndex
If intDel < LstField.ListCount Then
LstField.Selected(intDel) = True
ElseIf LstField.ListCount > 0 Then
LstField.Selected(LstField.ListCount - 1) = True
Else
'字段列表为空
cmdAddRow.Enabled = False
cmdAddCol.Enabled = False
cmdAddData.Enabled = False
cmdBrowse(1).Enabled = False
End If
End If
'是否可完成
IsComplete
End Sub
Private Sub cmdAddData_Click()
If LstField.ListIndex <> -1 Then
'把数据列表的项目放回项目列表
If LstData.ListCount > 0 Then
LstField.AddItem LstData.list(0)
LstData.Clear
End If
'把项目列表选中项目移到数据列表中
LstData.AddItem LstField.list(LstField.ListIndex)
LstData.Selected(LstData.NewIndex) = True
LstField.RemoveItem LstField.ListIndex
If LstField.ListCount > 0 Then
LstField.Selected(LstField.ListCount - 1) = True
Else
'字段列表为空
cmdAddRow.Enabled = False
cmdAddCol.Enabled = False
cmdAddData.Enabled = False
cmdBrowse(1).Enabled = False
End If
End If
'是否可完成
IsComplete
End Sub
Private Sub cmdAddRow_Click()
Dim intDel As Integer '要添加列索引(在源列表中被删除)
If LstRow.ListCount = 4 Then
Utility.ShowMsg Me.hwnd, "不能再加行项目了!", vbOKOnly, App.title
Exit Sub
End If
If LstField.ListIndex <> -1 Then
intDel = LstField.ListIndex
LstRow.AddItem LstField.list(LstField.ListIndex)
LstRow.Selected(LstRow.NewIndex) = True
LstField.RemoveItem LstField.ListIndex
If intDel < LstField.ListCount Then
LstField.Selected(intDel) = True
ElseIf LstField.ListCount > 0 Then
LstField.Selected(LstField.ListCount - 1) = True
Else
'字段列表为空
cmdAddRow.Enabled = False
cmdAddCol.Enabled = False
cmdAddData.Enabled = False
cmdBrowse(1).Enabled = False
End If
End If
IsComplete
End Sub
Private Sub cmdArrow_Click(Index As Integer) '查询项目的移动
Dim intCount As Integer
Dim intLoc As Integer
Dim strSel As String
Select Case Index
Case 0 '左移
SendField LstDataField, LstReport, False
CmdEnabled LstDataField, cmdArrow(0), cmdArrow(1)
CmdEnabled LstReport, cmdArrow(2), cmdArrow(3)
Case 1 '左全移
SendField LstDataField, LstReport, True
CmdEnabled LstDataField, cmdArrow(0), cmdArrow(1)
CmdEnabled LstReport, cmdArrow(2), cmdArrow(3)
Case 2 '右移
SendField LstReport, LstDataField, False
CmdEnabled LstDataField, cmdArrow(0), cmdArrow(1)
CmdEnabled LstReport, cmdArrow(2), cmdArrow(3)
If LstReport.ListCount = 0 Then
txtList.Text = ""
txtList.Enabled = False
LblList.Enabled = False
End If
Case 3 '右全移
SendField LstReport, LstDataField, True
CmdEnabled LstDataField, cmdArrow(0), cmdArrow(1)
CmdEnabled LstReport, cmdArrow(2), cmdArrow(3)
txtList.Text = ""
txtList.Enabled = False
LblList.Enabled = False
End Select
'数据浏览按钮是否可用
If LstDataField.SelCount = 1 Then
cmdBrowse(0).Enabled = True
LblList.Enabled = True
Else
cmdBrowse(0).Enabled = False
End If
'数据项目已改变
mblnFieldChanged = True
End Sub
'列表项目数据的浏览
Private Sub CmdBrowse_Click(Index As Integer)
Select Case Index
Case 0
LstBrowse LstDataField
Case 1
LstBrowse LstField
End Select
End Sub
Private Sub CmdCancel_Click()
mblnMeOK = False
Unload Me
End Sub
Private Sub cmdCol_Click(Index As Integer)
StandardReport.FieldUpdown LstCol, Index '项目上下移动
End Sub
Private Sub cmdComplete_Click()
Dim blnIsSave As Boolean
mblnMeOK = True
If Not mblnIsInited(2) Then InitCrossWizard 2
GetCrossWizard '把用户的选择传递给交叉表类
Unload Me
End Sub
'删除行，列，数据列表中最后一个失去焦点列表中选中的项目
Private Sub cmdDelete_Click()
Dim intCount As Integer, intDelLoc As Integer
'清除LstField中的已选项目
intCount = 0
Do While intCount < LstField.ListCount
LstField.Selected(intCount) = False
intCount = intCount + 1
Loop
Select Case mOldLstNO
Case 1 '删除行字段
If LstRow.ListIndex <> -1 Then
intDelLoc = LstRow.ListIndex
LstField.AddItem LstRow.list(LstRow.ListIndex)
LstRow.RemoveItem LstRow.ListIndex
LstField.Selected(LstField.NewIndex) = True
'设置选择项目
If intDelLoc < LstRow.ListCount Then
LstRow.Selected(intDelLoc) = True
ElseIf LstRow.ListCount > 0 Then
LstRow.Selected(LstRow.ListCount - 1) = True
Else
cmdDelete.Enabled = False
End If
End If
Case 2 '删除列字段
If LstCol.ListIndex <> -1 Then
intDelLoc = LstCol.ListIndex
LstField.AddItem LstCol.list(LstCol.ListIndex)
LstCol.RemoveItem LstCol.ListIndex
LstField.Selected(LstField.NewIndex) = True
'设置选择项目
If intDelLoc < LstCol.ListCount Then
LstCol.Selected(intDelLoc) = True
ElseIf LstCol.ListCount > 0 Then
LstCol.Selected(LstCol.ListCount - 1) = True
Else
cmdDelete.Enabled = False
End If
End If
Case 3 '删除数据字段
If LstData.ListIndex <> -1 Then
LstField.AddItem LstData.list(LstData.ListIndex)
LstData.RemoveItem LstData.ListIndex
LstField.Selected(LstField.NewIndex) = True
cmdDelete.Enabled = False
End If
Case Else
End Select
'是否可完成
IsComplete
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -