📄 frmcrossreport.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.2#0"; "COMCTL32.OCX"
Begin VB.Form frmCrossReport
Caption = "交叉表查询"
ClientHeight = 5415
ClientLeft = 60
ClientTop = 345
ClientWidth = 8760
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 5820
ScaleMode = 0 'User
ScaleWidth = 8880
Begin ComctlLib.Toolbar Toolbar1
Align = 1 'Align Top
Height = 420
Left = 0
TabIndex = 0
Top = 0
Width = 8760
_ExtentX = 15452
_ExtentY = 741
ButtonWidth = 635
ButtonHeight = 582
Appearance = 1
_Version = 327682
BorderStyle = 1
Begin VB.CommandButton cmdAccSet
Caption = "报表设置(&S)"
Height = 300
Left = 45
TabIndex = 5
Top = 45
Width = 1170
End
Begin VB.CommandButton cmdFormatSet
Caption = "显示格式(&F)"
Height = 300
Left = 1290
TabIndex = 4
Top = 45
Width = 1170
End
Begin VB.CommandButton cmdHide
Caption = "隐藏标题(&H)"
Height = 300
Left = 2460
TabIndex = 3
Top = 45
Width = 1170
End
Begin VB.CommandButton cmdSave
Caption = "报表保存(&M)"
Height = 300
Left = 3705
TabIndex = 2
Top = 45
Width = 1170
End
Begin VB.CommandButton cmdPrint
Caption = "打印(&P)"
Height = 300
Left = 4875
TabIndex = 1
Top = 45
Width = 1170
End
End
Begin VB.PictureBox picAccount
Appearance = 0 'Flat
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 4815
Left = 60
ScaleHeight = 4785
ScaleWidth = 8565
TabIndex = 6
Top = 480
Width = 8595
Begin MSFlexGridLib.MSFlexGrid msgAccount
Bindings = "frmCrossReport.frx":0000
Height = 3615
Left = 180
TabIndex = 7
Top = 1020
Width = 8175
_ExtentX = 14420
_ExtentY = 6376
_Version = 65541
Rows = 14
Cols = 14
BackColor = -2147483639
ForeColor = -2147483630
BackColorFixed = -2147483628
ForeColorSel = -2147483643
BackColorBkg = -2147483628
GridLinesFixed = 1
AllowUserResizing= 1
Appearance = 0
End
Begin VB.Data Data1
Caption = "Data1"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 'DefaultCursor
DefaultType = 2 'UseODBC
Exclusive = 0 'False
Height = 345
Left = 2400
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 2400
Visible = 0 'False
Width = 2415
End
Begin MSFlexGridLib.MSFlexGrid msgTitle
Height = 1095
Left = 180
TabIndex = 10
Top = 300
Width = 8175
_ExtentX = 14420
_ExtentY = 1931
_Version = 65541
Rows = 4
Cols = 9
BackColorFixed = -2147483639
BackColorBkg = 16777215
AllowUserResizing= 1
Appearance = 0
End
Begin VB.Label LblTitle
AutoSize = -1 'True
BackColor = &H80000014&
Caption = "LblTitle"
Height = 180
Left = 3240
TabIndex = 8
Top = 60
Width = 720
End
End
Begin VB.Label LblShadow
BackColor = &H80000010&
Caption = "Label1"
Height = 4815
Left = 120
TabIndex = 9
Top = 540
Width = 8595
End
End
Attribute VB_Name = "frmCrossReport"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 交叉表报表窗体
' 作者：邓强
' 日期：1998.06.26
'
' 根据用户选择交叉表项目组织数据显示
' ShowAcntBook 显示数据(类模块CrossSet和Report模块调用)
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Const lngTitleTop As Long = 350 '表头顶部位置
Const lngFormWidth As Long = 8500 '窗体最小宽度
Const lngFormHeight As Long = 5370 '窗体最小高度
Private WithEvents mclsMainControl As MainControl '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Private mblnHaveHead As Boolean '是否需要标题
Private WithEvents mclsHook As Hook
Attribute mclsHook.VB_VarHelpID = -1
Private mOldCol As Integer
Private mclsCross As CrossSet '交叉表设置对象
Private mclsFormCond As FormCond
Private mintMastDealRow As Integer '已进行格式数据处理的最大行
Private mblnIsOk As Boolean '向导是否选中"完成"按钮
Private mstrOtherCond As String '附加条件
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 响应消息
Public Sub ResponseMessage()
Dim vntMessage As Variant
For Each vntMessage In mclsMainControl.Messages
Select Case vntMessage
' 单位 部门 科目 摘要
Case Message.msgCustomer, Message.msgDepartment, Message.msgAccount, Message.msgRemark
RefreshData
Case Else
End Select
Next
mclsMainControl.Messages.Clear
End Sub
'显示报表
Public Sub ShowAcntBook(ByVal lngReportId As Long, ByVal ViewId As Long, Optional clsReportSet As CrossSet, _
Optional clsFormCond As FormCond, Optional strOtherCond As String)
mstrOtherCond = strOtherCond
'显示已存盘的帐表
If clsReportSet Is Nothing Then
Set mclsCross = New CrossSet
Set mclsFormCond = New FormCond
mclsFormCond.InitCondArr lngReportId, ViewId, 2
mclsCross.GetReportSet (lngReportId)
'显示才由向导生成的帐表
Else
Set mclsCross = clsReportSet
Set mclsFormCond = clsFormCond
End If
Set mclsMainControl = gclsSys.MainControls.Add(Me)
RefreshData
End Sub
Private Sub cmdAccSet_Click()
mblnIsOk = mclsCross.ShowWizard(mclsCross.ReportID, mclsCross.ParentId, mclsCross.Level, mclsFormCond, False)
If mblnIsOk Then RefreshData
End Sub
'涮新数据
Private Sub RefreshData()
Dim Strsql As String, strWhere As String
Dim rstTemp As Recordset
msgAccount.FixedCols = 0
strWhere = mclsFormCond.GetCond
'加入附加条件
If strWhere <> "" Then
If mstrOtherCond <> "" Then strWhere = strWhere & " And " & mstrOtherCond
Else
If mstrOtherCond <> "" Then strWhere = mstrOtherCond
End If
'生成SQL子句
If strWhere <> "" Then
Strsql = mclsCross.GetSQLPre & " WHERE " & strWhere & Space(1) & mclsCross.GetSQLLast
Else
Strsql = mclsCross.GetSQLPre & Space(1) & mclsCross.GetSQLLast
End If
Set rstTemp = gclsBase.BaseDB.OpenRecordset(Strsql, dbOpenSnapshot)
If rstTemp.EOF Then
Me.Hide
MsgBox ("所选项目没有数据,请重选!")
cmdAccSet_Click
If mblnIsOk Then
Me.Show
Else
frmResManage.CallPopMenu '调用菜单
Unload Me
End If
Exit Sub
End If
Set Data1.Recordset = rstTemp
rstTemp.Close '关闭记录集
InitTitle '初始化表头
DealRowColTotal '处理行列合计
mintMastDealRow = 1
DealFormat '处理数据格式
Caption = "交叉表查询" & " - " & mclsCross.ReportName
LblTitle.Caption = mclsCross.ReportName
LblTitle.Left = (msgAccount.Width - LblTitle.Width) \ 2
End Sub
Private Sub cmdFormatSet_Click()
Dim blnIsOK As Boolean
blnIsOK = frmFormat.SetFormat(mclsCross)
If blnIsOK Then RefreshData
End Sub
Private Sub cmdSave_Click()
Dim mblnIsOk As Boolean
mblnIsOk = mclsCross.SaveCross
If mblnIsOk Then
mclsFormCond.KeyID = mclsCross.ReportID
mclsFormCond.UpdateCond
Caption = "交叉表查询" & " - " & mclsCross.ReportName
LblTitle.Caption = mclsCross.ReportName
LblTitle.Left = (msgAccount.Width - LblTitle.Width) \ 2
End If
End Sub
Private Sub Form_Activate()
CallReportPopMenu
End Sub
Private Sub Form_Load()
mblnHaveHead = True
'设置钩子对象
Set mclsHook = New Hook
mclsHook.SetHook msgTitle.hwnd
CallReportPopMenu
End Sub
Private Sub cmdHide_Click()
mblnHaveHead = Not mblnHaveHead
If mblnHaveHead Then
cmdHide.Caption = "隐藏标题(&H)"
Else
cmdHide.Caption = "显示标题(&I)"
End If
Form_Resize
End Sub
Private Sub InitTitle()
Dim intRow As Integer, intCol As Integer
Dim strTitle As String
msgAccount.Redraw = False
msgTitle.Redraw = False
LblTitle.Caption = mclsCross.ReportName
msgTitle.Cols = msgAccount.Cols
msgTitle.FixedRows = mclsCross.ColColumns
msgAccount.FixedCols = mclsCross.RowColumns
msgTitle.FixedCols = msgAccount.FixedCols
'对表头赋值
For intCol = msgTitle.FixedCols To msgTitle.Cols - 1
strTitle = msgAccount.TextMatrix(0, intCol)
For intRow = 0 To msgTitle.FixedRows - 1
msgTitle.TextMatrix(intRow, intCol) = GetNoXString(strTitle, intRow + 1, "/")
msgTitle.RowHeight(intRow) = 225
Next intRow
msgTitle.FixedAlignment(intCol) = 4
Next intCol
For intRow = msgTitle.FixedRows To 3
msgTitle.RowHeight(intRow) = 0
Next intRow
'合并性质
msgAccount.MergeCells = flexMergeRestrictRows
msgTitle.MergeCells = flexMergeRestrictColumns
For intCol = 0 To msgTitle.FixedCols - 1
For intRow = 0 To msgTitle.FixedRows - 1
msgTitle.TextMatrix(intRow, intCol) = msgAccount.TextMatrix(0, intCol)
Next intRow
msgTitle.MergeCol(intCol) = True
Next intCol
For intCol = 0 To msgAccount.FixedCols - 1
msgAccount.MergeCol(intCol) = True
Next
msgTitle.MergeRow(0) = True
msgTitle.MergeRow(1) = True
msgTitle.MergeRow(2) = True
msgAccount.RowHeight(0) = 0
Form_Resize
msgAccount.Redraw = True
msgTitle.Redraw = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set mclsCross = Nothing
Set mclsFormCond = Nothing
gclsSys.MainControls.Remove Me
End Sub
Private Sub Form_Resize()
msgAccount.Redraw = False
If Me.WindowState = vbMinimized Then
Exit Sub
End If
If Me.Width < lngFormWidth Then
Me.Width = lngFormWidth
End If
If Me.Height < lngFormHeight Then
Me.Height = lngFormHeight
End If
picAccount.Height = Me.Height - 700
picAccount.Width = Me.Width - 220
lblShadow.Height = picAccount.Height
lblShadow.Width = picAccount.Width
msgAccount.Width = picAccount.Width - 450
msgTitle.Width = msgAccount.Width
If mblnHaveHead Then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -