📄 frmbanreport.frm
字号:
Begin ListRefer.ListText cmbDate
Height = 315
Left = 855
TabIndex = 6
Top = 420
Width = 1905
_ExtentX = 3360
_ExtentY = 556
Locked = -1 'True
BackColor = -2147483643
RMenu = "1"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin GACALENDARLibCtl.Calendar detBegin
Height = 300
Left = 2955
OleObjectBlob = "frmBanReport.frx":0557
TabIndex = 7
Top = 435
Width = 1335
End
Begin VB.Label lblFrom
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "从"
Height = 180
Left = 2760
TabIndex = 31
Top = 480
Width = 180
End
Begin VB.Label lblTo
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "到"
Height = 180
Left = 4320
TabIndex = 30
Top = 480
Width = 180
End
Begin VB.Label lblD
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "日期(&D)"
Height = 180
Left = 120
TabIndex = 5
Top = 480
Width = 630
End
Begin VB.Label lblHead
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "科目(&A)"
Height = 180
Index = 0
Left = 90
TabIndex = 9
Top = 840
Visible = 0 'False
Width = 630
End
Begin MSForms.CommandButton CmdPaper
Height = 345
Left = 3930
TabIndex = 15
Top = 6540
Width = 1215
Caption = "纸张"
PicturePosition = 196613
Size = "2143;609"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
Begin MSForms.CommandButton CmdZoom
Height = 345
Left = 2700
TabIndex = 14
Top = 6540
Width = 1215
Caption = "缩放"
PicturePosition = 196613
Size = "2143;609"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
End
Attribute VB_Name = "frmBanReport"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' 余额表窗体
' 作者：魏然
' 日期：1998.10.23
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Private Enum VerifyType '复核、记帐标志
vtAll = 0
vtNotVerify = 1 '未复核
vtVerifyNotRecord = 2 '已复核未记帐
vtVerified = 3 '已复核(包括未记帐和已记帐)
vtRecorded = 4 '已记帐
End Enum
Private WithEvents mclsMainControl As MainControl '主控对象类
Attribute mclsMainControl.VB_VarHelpID = -1
Private WithEvents ABook As ReportBook
Attribute ABook.VB_VarHelpID = -1
Private mclsFset As ClsFormatset
Private mclsReportSet As banreport '报表设置类
Private mclsFilterCond As FormCond '报表条件设置类
Private mlngCondType As Long
Private mblnLoad As Boolean
Private mblnChanged As Boolean
Private mblnOrient As Boolean '纵向打印
Private mintCurrencyCol As Integer '币种名称列
Private mstrWhere As String
Private mvtVerify As VerifyType
Private mintMastDealRow As Integer '已进行数据处理的最大行
Private mintMastDealCol() As Integer '本页已显示的最大列
Private mblnIsOver As Boolean '是否处理报表的最后一行
Private mintSub As Integer
Private mstrCurrencyName As String '具体币种名称
Private ZoomIndex As Integer
Private PaperWidth As Long
Private PaperHeight As Long
Private mblnOrientation As Boolean
Private mintCurContents As Integer '当前目录
Private mbResizeing As Boolean '移动标志
Private mintNowPage As Integer '当前页
Private mintPages As Integer '总页数
Private mintPageRows As Integer '每页行数
Private mintZeroRow As Integer '隐藏行数
Private mintFCIndex As Integer '当前表头索引
Private mblnDateChange As Boolean '日期是否改变
Private mstrLevel As String
Private mstrVoucherType As String
Private mstrFhCond As String
Private mstrHF(6) As String
Private mintDirectCol As Integer '方向列
Private mintBNatureCol As Integer '期初本币列
Private mintBCurrCol As Integer '期初原币列
Private mintBQuanCol As Integer '期初数量列
Private mintENatureCol As Integer '期末本币列
Private mintECurrCol As Integer '期末原币列
Private mintEQuanCol As Integer '期末数量列
Private mblnAlign As Boolean
Private mbytData As Byte
Private mblnDetail As Boolean
Private mblnNature As Boolean
Private mblnHeadChange As Boolean
Private mblnFirstLoad As Boolean
Private mstrCond As String '表头栏目对应的条件
Private mbytCurType As Byte '币种表头选择类型 1=所有币种 2=本位币 3=具体币种
Private mstrVoucherNo As String
Private mblnLockHead As Boolean
Private mstrOldDate As String
Private marrTotal() As String '按科目类型合计数
Private marrTotalRow() As Integer '按科目类型合计行
Private marrAccountType() As Integer '科目类型ID
Private mblnRefresh As Boolean
Private mcolDirect As Collection
Private mcolTypeDirect As Collection
'''''''''''''''''''''''''''''
'
' 属 性
'
'''''''''''''''''''''''''''''
Public Property Get Filtercond() As FormCond
Set Filtercond = mclsFilterCond
End Property
Public Property Set Filtercond(New_Filter As FormCond)
Set mclsFilterCond = New_Filter
End Property
Public Property Get ReportSet() As banreport
Set ReportSet = mclsReportSet
End Property
Public Property Set ReportSet(New_ReportSet As banreport)
Set mclsReportSet = New_ReportSet
End Property
Private Sub ABook_ColumnResize(col As Integer, ByVal width As Integer, bCancel As Integer)
Dim intCol As Integer
Dim lngWid As Long
On Error Resume Next
If mintSub = 1 Or col <= mclsReportSet.FixColumns - 1 Then
mclsReportSet.ColumnWidth(col + 1) = width * Screen.TwipsPerPixelX
Else
mclsReportSet.ColumnWidth(mintMastDealCol(mintSub - 1) + mclsReportSet.FixColumns - 1) = width * Screen.TwipsPerPixelX
End If
lngWid = 0
For intCol = 0 To ABook.MaxCol - 1
If intCol = col Then
lngWid = lngWid + width
Else
lngWid = lngWid + ABook.ColumnWidth(intCol)
End If
Next intCol
If lngWid > ABook.ColCount Then
GetPages
mintNowPage = 1
SetData
InitScrollbar
Else
If UBound(mintMastDealCol) > 1 And mintSub <> UBound(mintMastDealCol) Then
GetPages
mintNowPage = 1
SetData
InitScrollbar
End If
End If
mblnChanged = True
ABook.Refresh
End Sub
'''''''''''''''''''''''''''''
'
' 数据组织
'
'''''''''''''''''''''''''''''
Private Sub ABook_FCMouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbRightButton Then
mintFCIndex = Index
'装载自由单元弹出菜单资源
If ABook.IsMultiSel Then '如果表头栏目多选
Report.FreeCellFatSet
PopupMenu frmMain.mnuListActivity
End If
End If
End Sub
Private Sub ABook_HFMouseUp(Button As Integer, Shift As Integer, x As Single, y As Single, pos As Integer)
ABook_MouseUp Button, Shift, x, y
End Sub
Private Sub ABook_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbRightButton Then
CallReportPopMenu
PopupMenu frmMain.mnuListReport
End If
End Sub
Private Sub ABook_RowScroll(ByVal Distance As Long)
Dim lngValue As Long
lngValue = VScroll.Value + Distance
If lngValue > VScroll.Max Then
VScroll.Value = VScroll.Max
ElseIf lngValue < VScroll.Min Then
VScroll.Value = VScroll.Min
Else
VScroll.Value = lngValue
End If
End Sub
Private Sub cmdMiss_Click()
Dim frmVoucherInfo As VoucherInfo
Dim strFixCond As String, strOtherCond As String, strDateCond As String
Dim strWhere As String
strFixCond = GetFixCond
strOtherCond = GetOtherCond
strDateCond = "Voucher.strDate>=" & Format(detBegin.Text, "yyyy-MM-dd") & _
" And Voucher.strDate<=" & Format(detEnd.Text, "yyyy-MM-dd")
If strFixCond <> "" Then
strWhere = strFixCond
End If
If mstrWhere <> "" Then
strWhere = strWhere & " And (" & mstrWhere & ")"
End If
If strOtherCond <> "" Then
strWhere = strWhere & " And (" & strOtherCond & ")"
End If
If strDateCond <> "" Then
strWhere = strWhere & " And (" & strDateCond & ")"
End If
If mstrVoucherType <> "" Then
strWhere = strWhere & " And (" & mstrVoucherType & ")"
End If
Set frmVoucherInfo = New VoucherInfo
MsgForm.PleaseWait
frmVoucherInfo.GetVoucherInfo strWhere, Format(detBegin.Text, "yyyy-MM-dd"), Format(detEnd.Text, "yyyy-MM-dd")
Unload MsgForm
frmVoucherInfo.Show vbModal
Set frmVoucherInfo = Nothing
End Sub
Private Sub detBegin_GotFocus()
mstrOldDate = detBegin.Text
End Sub
Private Sub detBegin_Change()
If mblnDateChange Then
If cmbDate.Text <> "自定义" Then
cmbDate.Text = "自定义"
End If
End If
End Sub
Private Sub detEnd_Change()
If mblnDateChange Then
If cmbDate.Text <> "自定义" Then
cmbDate.Text = "自定义"
End If
End If
End Sub
Private Sub detEnd_GotFocus()
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -