📄 frmcustomerfield.frm
字号:
VERSION 5.00
Begin VB.Form frmCustomerField
Caption = "表头表尾项目"
ClientHeight = 5685
ClientLeft = 60
ClientTop = 345
ClientWidth = 7065
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5685
ScaleWidth = 7065
StartUpPosition = 3 '窗口缺省
Begin VB.Frame fraChoose
Caption = "选择表头项目"
Height = 2175
Left = 120
TabIndex = 1
Top = 3360
Width = 5535
Begin VB.CommandButton cmdArrow
Caption = ">"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 336
Index = 0
Left = 2630
TabIndex = 18
TabStop = 0 'False
Top = 900
UseMaskColor = -1 'True
Width = 300
End
Begin VB.CommandButton cmdArrow
Caption = "<"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 336
Index = 1
Left = 2630
TabIndex = 19
TabStop = 0 'False
Top = 1380
UseMaskColor = -1 'True
Width = 300
End
Begin VB.ListBox LstChoosed
Height = 1500
Left = 3075
TabIndex = 17
Top = 480
Width = 2235
End
Begin VB.ListBox LstChoose
Height = 1500
Left = 240
TabIndex = 15
Top = 480
Width = 2235
End
Begin VB.Label LblChoosed
Caption = "已选表头项目(&Y)"
Height = 315
Left = 3120
TabIndex = 16
Top = 240
Width = 1515
End
Begin VB.Label LblChoose
Caption = "可选表头项目(&K)"
Height = 315
Left = 180
TabIndex = 14
Top = 240
Width = 1575
End
End
Begin VB.Frame fraDefine
Caption = "自定义项目"
Height = 3100
Left = 120
TabIndex = 0
Top = 120
Width = 5535
Begin VB.ListBox LstHead
Height = 780
ItemData = "frmCustomerField.frx":0000
Left = 3000
List = "frmCustomerField.frx":0007
TabIndex = 9
Top = 480
Width = 2340
End
Begin VB.ListBox LstTail
Height = 780
ItemData = "frmCustomerField.frx":0014
Left = 3000
List = "frmCustomerField.frx":001B
TabIndex = 11
Top = 1680
Width = 2340
End
Begin VB.CommandButton cmdDelHead
Caption = "删除表头(&S)"
Enabled = 0 'False
Height = 315
Left = 2970
TabIndex = 12
Top = 2640
UseMaskColor = -1 'True
Width = 1140
End
Begin VB.CommandButton cmdDelTail
Caption = "删除表尾(&B)"
Enabled = 0 'False
Height = 315
Left = 4200
TabIndex = 13
Top = 2640
UseMaskColor = -1 'True
Width = 1140
End
Begin VB.CommandButton cmdAddTail
Caption = "增加表尾(&W)"
Enabled = 0 'False
Height = 315
Left = 1440
TabIndex = 7
Top = 2640
UseMaskColor = -1 'True
Width = 1140
End
Begin VB.CommandButton cmdAddHead
Caption = "增加表头(&J)"
Enabled = 0 'False
Height = 315
Left = 180
TabIndex = 6
Top = 2640
UseMaskColor = -1 'True
Width = 1140
End
Begin VB.ListBox LstDefine
Height = 1320
ItemData = "frmCustomerField.frx":0028
Left = 180
List = "frmCustomerField.frx":002F
TabIndex = 3
Top = 480
Width = 2460
End
Begin VB.TextBox txtAdd
Height = 315
Left = 180
TabIndex = 5
Top = 2160
Width = 2415
End
Begin VB.Label LblHead
Caption = "表头(&H)"
Height = 195
Left = 3000
TabIndex = 8
Top = 240
Width = 2115
End
Begin VB.Label LblTail
Caption = "表尾(&T)"
Height = 195
Left = 3000
TabIndex = 10
Top = 1380
Width = 2115
End
Begin VB.Label LblDefine
Caption = "定义项目(&D)"
Height = 255
Left = 180
TabIndex = 4
Top = 1920
Width = 1275
End
Begin VB.Label LblFunction
Caption = "可选栏目(&C)"
Height = 255
Left = 180
TabIndex = 2
Top = 240
Width = 1515
End
End
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Height = 315
Left = 5760
Style = 1 'Graphical
TabIndex = 21
Top = 720
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.CommandButton cmdAffirm
Default = -1 'True
Height = 315
Left = 5760
Style = 1 'Graphical
TabIndex = 20
Top = 240
UseMaskColor = -1 'True
Width = 1215
End
End
Attribute VB_Name = "frmCustomerField"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 报表自定义表头表尾项目设置窗体
' 作者：邓强
' 日期：1998.07.21
'
' 用于用户设置自定义表头表尾项目
' SetHeadTail 用户自定义表头表尾项目并选中'完成'按钮后，返回给报表
' (交叉表报表,标准表报表,列表报表调用)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Private mclsHeadTail As Object '报表类
Private mblnOk As Boolean '是否选中"完成"按钮
Private mblnChoose As Boolean '是否可操作可选表头项目
Private marr() As Variant '可选表头项目数组
Private mbytChoose As Byte '哪一个可选控件有效 0:都无效 ,1:lstDefine,2:txtAdd
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'项目后面带涵数标志 0:自定义(无),其他自然数:涵数索引
' (用一百个空格分开)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''
' 公共过程
''''''''''''''''''''''''''''''''''
Public Function SetHeadTail(cls As Object, Optional ByVal blnChoose As Boolean = False) As Boolean
Dim intCount As Integer, intLoc As Integer
Dim strTemp As String
mblnOk = False
mblnChoose = blnChoose
LstChoose.Clear
lstChoosed.Clear
If mblnChoose Then
fraChoose.Enabled = True
LblChoose.Enabled = True
lblChoosed.Enabled = True
' 传递数组
ReDim marr(cls.Columns - 1)
For intCount = 0 To UBound(marr)
marr(intCount) = cls.ColumnStyle(intCount)
Next intCount
'传递项目
For intCount = 0 To cls.Columns - 1
If cls.ColumnFieldHead(intCount) = 1 Or cls.ColumnFieldHead(intCount) = 2 Then
If marr(intCount) = 6 Then
lstChoosed.AddItem cls.ColumnFieldDesc(intCount) & Space(100) & CStr(intCount)
Else
LstChoose.AddItem cls.ColumnFieldDesc(intCount) & Space(100) & CStr(intCount)
End If
End If
Next intCount
If lstChoosed.ListCount = 0 And LstChoose.ListCount = 0 Then
fraChoose.Enabled = False
LblChoose.Enabled = False
lblChoosed.Enabled = False
End If
Else
fraChoose.Enabled = False
LblChoose.Enabled = False
lblChoosed.Enabled = False
End If
'装载图片资源
cmdAffirm.Picture = Utility.GetFormResPicture(1001, 0)
cmdCancel.Picture = Utility.GetFormResPicture(1002, 0)
Set mclsHeadTail = cls
InitHeadTail
Me.Show vbModal
If mblnOk Then
'把已选表头项目(非自定义)传给报表类
If mblnChoose Then
For intCount = 0 To UBound(marr, 1)
mclsHeadTail.ColumnStyle(intCount) = marr(intCount)
Next intCount
End If
Set cls = mclsHeadTail
End If
SetHeadTail = mblnOk
End Function
''''''''''''''''''''''''''''''''''
' 控件事件响应过程
''''''''''''''''''''''''''''''''''
Private Sub cmdAddHead_Click()
If LstHead.ListCount = 7 Then
Utility.ShowMsg Me.hwnd, "请原谅,不能再加表头项目了!", vbOKOnly, App.title
Exit Sub
End If
Select Case mbytChoose
Case 1 '加入可选项目
LstHead.AddItem LstDefine.list(LstDefine.ListIndex)
Case 2 '加入自定义项目
LstHead.AddItem txtAdd.Text & Space(100) & "0"
End Select
End Sub
Private Sub cmdAddTail_Click()
If LstTail.ListCount = 9 Then
Utility.ShowMsg Me.hwnd, "请原谅,不能再加表尾项目了!", vbOKOnly, App.title
Exit Sub
End If
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -