📄 frmreporthead.frm
字号:
VERSION 5.00
Begin VB.Form frmReportHead
BorderStyle = 3 'Fixed Dialog
Caption = "表头栏目"
ClientHeight = 3030
ClientLeft = 45
ClientTop = 330
ClientWidth = 6495
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3030
ScaleWidth = 6495
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.Frame Frame1
Height = 2715
Left = 150
TabIndex = 2
Top = 150
Width = 4875
Begin VB.ListBox lstChoosed2
Height = 1860
ItemData = "frmReportHead.frx":0000
Left = 2790
List = "frmReportHead.frx":0007
TabIndex = 10
Top = 420
Width = 1605
End
Begin VB.ListBox lstBeChoose2
Height = 1860
ItemData = "frmReportHead.frx":0018
Left = 210
List = "frmReportHead.frx":001F
TabIndex = 9
Top = 420
Width = 1605
End
Begin VB.CommandButton cmdSerial2
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 = 4500
Picture = "frmReportHead.frx":0031
Style = 1 'Graphical
TabIndex = 8
Top = 945
UseMaskColor = -1 'True
Visible = 0 'False
Width = 240
End
Begin VB.CommandButton cmdSerial2
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 = 4500
Picture = "frmReportHead.frx":050F
Style = 1 'Graphical
TabIndex = 7
Top = 1425
UseMaskColor = -1 'True
Visible = 0 'False
Width = 240
End
Begin VB.CommandButton cmdLeftAll2
Caption = "<<"
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
Left = 2040
TabIndex = 6
Top = 1785
UseMaskColor = -1 'True
Width = 576
End
Begin VB.CommandButton cmdLeftOne2
Caption = "<"
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
Left = 2040
TabIndex = 5
Top = 1410
UseMaskColor = -1 'True
Width = 576
End
Begin VB.CommandButton cmdRightAll2
Caption = ">>"
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
Left = 2040
TabIndex = 4
Top = 1035
UseMaskColor = -1 'True
Width = 576
End
Begin VB.CommandButton cmdRightOne2
Caption = ">"
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
Left = 2040
TabIndex = 3
Top = 660
UseMaskColor = -1 'True
Width = 576
End
Begin VB.Label lblMayChoose
AutoSize = -1 'True
Caption = "可选栏目"
Height = 180
Left = 270
TabIndex = 12
Top = 210
Width = 720
End
Begin VB.Label lblChoosed
AutoSize = -1 'True
Caption = "已选栏目"
Height = 180
Left = 2850
TabIndex = 11
Top = 210
Width = 720
End
End
Begin VB.CommandButton cmdOk
Default = -1 'True
Height = 315
Left = 5220
Style = 1 'Graphical
TabIndex = 1
Top = 210
UseMaskColor = -1 'True
Width = 1155
End
Begin VB.CommandButton cmdCancel
Height = 315
Left = 5220
Style = 1 'Graphical
TabIndex = 0
Top = 600
UseMaskColor = -1 'True
Width = 1155
End
End
Attribute VB_Name = "frmReportHead"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' 表头表尾设置
' 作者：魏 然
' 日期：
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Private marrHeadField() As Variant
Private marrHeadFieldName() As Variant
Private marrHeadTop() As Long
Private marrHeadLeft() As Long
Private marrHeadHeight() As Long
Private marrHeadWidth() As Long
Private mblnOk As Boolean
Public Function SetHead(ByVal ReportID As Long, ByVal ViewId As Long, arrHeadField As Variant, _
arrHeadFieldName As Variant, arrHeadTop As Variant, arrHeadLeft As Variant, _
arrHeadHeight As Variant, arrHeadWidth As Variant) As Boolean
Dim strSql As String, strCondVersion As String
Dim rstHead As Recordset
Dim intCount As Integer
strCondVersion = " And (ViewField.bytVersion Mod " & gVersionType * 2 & ">=" & gVersionType & ")"
lstBeChoose2.Clear
lstChoosed2.Clear
gclsBase.BaseDB.QueryDefs("QReportCond").sql = "Select * From ReportField Where lngReportId =" & ReportID
strSql = "Select ViewField.lngViewFieldID As ID,ViewField.strViewFieldDesc As Name," & _
"lngDisplayTop,lngDisplayLeft,lngDisplayHeight,lngDisplayWidth," & _
"ReportField.blnIsHeaded As Choose,ViewField.bytHead From ViewField LEFT JOIN QReportCond ON " & _
"ViewField.lngViewFieldID=QReportCond.lngViewFieldID Where ViewField.bytHead>0 And ViewField.lngViewID=" & ViewId & strCondVersion
Set rstHead = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
With rstHead
Do While Not .EOF
If Utility.ArrIsEmpty(arrHeadField) Then
If !Choose Then
lstChoosed2.AddItem !Name + Space(100) & "/" & !ID & "/" & !bytHead & "/" & _
!lngdisplaytop & "/" & !lngDisplayLeft & "/" & !lngDisplayHeight & "/" & !lngDisplayWidth
Else
lstBeChoose2.AddItem !Name + Space(100) & "/" & !ID & "/" & !bytHead & "/" & _
!lngdisplaytop & "/" & !lngDisplayLeft & "/" & !lngDisplayHeight & "/" & !lngDisplayWidth
End If
Else
If IdInArr(!ID, arrHeadField) Then
lstChoosed2.AddItem !Name + Space(100) & "/" & !ID & "/" & !bytHead & "/" & _
!lngdisplaytop & "/" & !lngDisplayLeft & "/" & !lngDisplayHeight & "/" & !lngDisplayWidth
Else
lstBeChoose2.AddItem !Name + Space(100) & "/" & !ID & "/" & !bytHead & "/" & _
!lngdisplaytop & "/" & !lngDisplayLeft & "/" & !lngDisplayHeight & "/" & !lngDisplayWidth
End If
End If
.MoveNext
Loop
End With
RefreshButton2
RefreshUpDown2
Me.Show vbModal
If mblnOk Then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -