frmreportsumbook.frm

金算盘软件代码

Private Sub Form_Deactivate()
    frmMain.mnuFilePrint.Enabled = False
    frmMain.SetEditUnEnabled
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
    Case vbKeyPageUp
       If VScroll.Value = VScroll.Min Then
          If mlngCurPage > 1 Then
             mlngCurPage = mlngCurPage - 1
             SetData
             VScroll.Value = VScroll.Max
          End If
       Else
          VScroll.Value = IIf(VScroll.Value - VScroll.LargeChange > VScroll.Min, VScroll.Value - VScroll.LargeChange, VScroll.Min)
       End If
    Case vbKeyPageDown
       If VScroll.Value = VScroll.Max Then
          If mlngCurPage < mlngPages Then
             mlngCurPage = mlngCurPage + 1
             SetData
             VScroll.Value = VScroll.Min
          End If
       Else
          VScroll.Value = IIf(VScroll.Value + VScroll.LargeChange < VScroll.Max, VScroll.Value + VScroll.LargeChange, VScroll.Max)
       End If
    Case vbKeyLeft
         HScroll.Value = IIf(HScroll.Value - HScroll.LargeChange > HScroll.Min, HScroll.Value - HScroll.LargeChange, HScroll.Min)
    Case vbKeyRight
         HScroll.Value = IIf(HScroll.Value + HScroll.LargeChange < HScroll.Max, HScroll.Value + HScroll.LargeChange, HScroll.Max)
    Case vbKeyEscape
        Unload Me
    End Select
End Sub

Private Sub mclsMainControl_ChildActive()
    Utility.SetHelpID Me.HelpContextID
End Sub

Private Sub mclsMainControl_FilePrint()
    CmdPrint_Click
End Sub

Private Sub mclsMainControl_ListActivityMenu(ByVal intIndex As Integer)
Dim intLoc As Integer, intCell As Integer, intFunc As Integer
Dim strName As String
Dim blnOK As Boolean
    If ABook.IsMultiSel Then
        Select Case intIndex
            Case 0, 1, 2
                ABook.SetFCMultiAlignment intIndex + 1
            Case 4, 5, 6
                ABook.SetFCMultiAlignment intIndex
            Case 8, 9, 10
                ABook.SetFCMultiAlignment intIndex - 1
        End Select
        ReGetCellChanged
    Else
        mclsCell.FindLoc mintFCIndex, intLoc
        Select Case intIndex
        Case 0  '修改自由单元
            strName = mclsCell.CellName(intLoc)
            intFunc = mclsCell.CellFunc(intLoc)
            blnOK = frmFreeCell.SetCell(strName, intFunc)
            If blnOK Then
                 mclsCell.CellName(intLoc) = strName
                 mclsCell.CellFunc(intLoc) = intFunc
                 SetData
            End If
        Case 1  '删除自由单元
            intFunc = Utility.ShowMsg(Me.hWnd, "确定要删除此自由表头吗?", vbQuestion + vbYesNo, App.title)
            If intFunc = 6 Then
                mclsCell.DelCell mintFCIndex
                SetData
            End If
        End Select
    End If
    mblnChanged = True
End Sub

Private Sub mclsMainControl_ListReportMenu(ByVal intIndex As Integer)
Dim intFunc As Integer, intCond As Integer, intLists As Integer
Dim strName As String
Dim blnOK As Boolean
Dim lngWidth As Long, lngHeight As Long
    Select Case intIndex
    Case 0
        cmdAccSet_Click
    Case 1
        cmdFormatSet_Click
    Case 2
    Case 3
        cmdSave_Click
    Case 4
        cmdSaveAs_Click
    Case 5
    Case 6
        CmdPrint_Click
'    Case 9
'         '新增自由单元
'        blnOK = frmFreeCell.SetCell(strName, intFunc)
'        If blnOK Then
'            GetFontWidHei lngWidth, lngHeight, strName, intFunc
'            mclsCell.AddCell mclsSum.ListColumns + 2 + mclsCell.FreeCells, strName, mbytCellType, intFunc, mlngCellTop, mlngCellLeft, lngWidth, lngHeight
'            SetData
'            mblnChanged = True
'        End If
    Case 10     '重新设置自由单元
        With mclsSum
            intCond = IIf(.CondShow = 1, 1, 0)
            For intLists = 0 To .ListColumns - 1
                .ColumnAlign(.ColumnListLoc(intLists)) = StandardReport.GetAddFCAlign(.ListColumns + intCond + 1, intLists + intCond + 1)
            Next
            .TitleAlign = 13
            .CondAlign = 1
        End With
        mclsCell.ReSetDateCellLoc
        SetData
        mblnChanged = True
    Case 8    '锁定自由单元
        If ABook.FCLocked Then
            ABook.FCLocked = 0
            ABook.FCPlace = 1
            ABook.Refresh
        Else
            ABook.FCLocked = 1
            ABook.FCPlace = 0
            ABook.Refresh
        End If
    Case 9    '显示网格
        ABook.FCPlace = IIf(ABook.FCPlace = 0, 1, 0)
        ABook.Refresh
    Case 13
        mblnAutoRefresh = Not mblnAutoRefresh
    End Select
End Sub



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'                      *             辅助支持                  *
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'加快捷报表条件
Private Sub AddFastCond(ByVal intLoc As Integer, ByVal CodeId As Long)
Dim intCount As Integer
    If CodeId = 0 Then Exit Sub
    For intCount = 0 To mclsSum.ListColumns - 1
        If cboList(intCount).Tag = intLoc Then cboList(intCount).SeekId CodeId: Exit For
    Next
End Sub
'得到列表框条件
Private Sub GetListCond()
Dim intCount As Integer
Dim strCode As String, strTemp As String
    mstrListCond = ""
    For intCount = 0 To mclsSum.ListColumns - 1
        strTemp = Trim(cboList(intCount).Text)
        strCode = GetNoXString(strTemp, 1)
        Select Case Left(LblList(intCount).Caption, 4)
        Case "保险号码", "保险单位", "医疗机构"         '医疗保险特殊处理
            If mstrListCond = "" Then
                mstrListCond = LblList(intCount).Tag & "='" & strCode & "'"
            Else
                mstrListCond = mstrListCond & " And " & LblList(intCount).Tag & "='" & strCode & "'"
            End If
        Case "生产批号"
            strTemp = Trim(cboList(intCount).Text)
            If strTemp <> "所有" And strTemp <> "" Then
                If mstrListCond = "" Then
                    mstrListCond = LblList(intCount).Tag & "='" & cboList(intCount).Text & "'"
                Else
                    mstrListCond = mstrListCond & " And " & LblList(intCount).Tag & "='" & cboList(intCount).Text & "'"
                End If
            End If
        Case Else
            If strTemp <> "所有" And strTemp <> "" Then
                If mstrListCond = "" Then
                    Select Case cboList(intCount).Tag
                    Case 5
                        If gclsBase.Trade = "邮电通信" Then
                            mstrListCond = "(" & LblList(intCount).Tag & "='" & strCode & "' Or " & LblList(intCount).Tag & " LIKE '" & strCode & "-%'" & ")"
                        Else
                            mstrListCond = LblList(intCount).Tag & "=" & cboList(intCount).ID
                        End If
                    Case 1, 3, 6, 9, 10, 14, 15, 17, 25 '级次编码
                        mstrListCond = "(" & LblList(intCount).Tag & "='" & strCode & "' Or " & LblList(intCount).Tag & " LIKE '" & strCode & "-%'" & ")"
                    Case Else
                        mstrListCond = LblList(intCount).Tag & "=" & cboList(intCount).ID
                    End Select
                Else
                    Select Case cboList(intCount).Tag
                    Case 5
                        If gclsBase.Trade = "邮电通信" Then
                            mstrListCond = mstrListCond & " And (" & LblList(intCount).Tag & "='" & strCode & "' Or " & LblList(intCount).Tag & " LIKE '" & strCode & "-%'" & ")"
                        Else
                            mstrListCond = mstrListCond & " And " & LblList(intCount).Tag & "=" & cboList(intCount).ID
                        End If
                    Case 1, 3, 6, 9, 10, 14, 15, 17, 25 '级次编码
                        mstrListCond = mstrListCond & " And (" & LblList(intCount).Tag & "='" & strCode & "' Or " & LblList(intCount).Tag & " LIKE '" & strCode & "-%'" & ")"
                    Case Else
                        mstrListCond = mstrListCond & " And " & LblList(intCount).Tag & "=" & cboList(intCount).ID
                    End Select
                End If
            End If
        End Select
    Next intCount
End Sub
'得到过滤条件
Private Sub GetFilter()
Dim strWhere As String
      strWhere = mclsFormFilt.GetCond
      If strWhere <> "" Then
            If mstrGroupCond = "" Then
                mstrGroupCond = strWhere
            Else
                mstrGroupCond = mstrGroupCond & " And " & strWhere
            End If
      End If
End Sub

'得到日期条件
Private Sub GetDateCond()
Dim strSql As String
Dim intYear As Integer, intPeriod As Integer

    Select Case mclsSum.ViewId
    Case 511, 651, 1113, 1117 'WQ
        mstrDateCond = "strDate<='" & Format(detStop.Text, "YYYY-MM-DD") & "'"
    Case 600, 666, 667, 755, 773, 756, 758, 759, 760      '固定资产
        If cboMonth.Text <> "所有" Then
            mstrDateCond = lblTo.Tag & " = '" & cboMonth.Text & "'"
        Else
            mstrDateCond = ""
        End If
    Case 651     '久未交易客户稽查
        If cmbDate.Text = "所有" Or cmbDate.Text = "" Or (Not IsDate(detBegin.Text) And Not IsDate(detEnd.Text)) Then
            mstrDateCond = lblD.Tag & ">='1999-01-01' And " & lblD.Tag & "<='" & Format(gclsBase.BaseDate, "YYYY-MM-DD") & "'"
        ElseIf Not IsDate(detBegin.Text) Then
            mstrDateCond = lblD.Tag & "<='" & detEnd.Text & "'"
        ElseIf Not IsDate(detEnd.Text) Then
            mstrDateCond = lblD.Tag & ">='" & detBegin.Text & "'"
        Else
            mstrDateCond = lblD.Tag & ">='" & detBegin.Text & "' And " & lblD.Tag & "<='" & detEnd.Text & "'"
        End If
    Case Else
        If cmbDate.Text = "所有" Or cmbDate.Text = "" Or (Not IsDate(detBegin.Text) And Not IsDate(detEnd.Text)) Then
            mstrDateCond = ""
        ElseIf Not IsDate(detBegin.Text) Then
            mstrDateCond = lblD.Tag & "<='" & detEnd.Text & "'"
        ElseIf Not IsDate(detEnd.Text) Then
            mstrDateCond = lblD.Tag & ">='" & detBegin.Text & "'"
        Else
            mstrDateCond = lblD.Tag & ">='" & detBegin.Text & "' And " & lblD.Tag & "<='" & detEnd.Text & "'"
        End If
    End Select
End Sub
'得到日期字段名
Private Sub GetDateName(strName As String, strDesc As String)
Dim strSql As String, strType As String
Dim rstName As rdoResultset
     
    strSql = "SELECT strFieldName,strViewFieldDesc,strFieldType FROM ViewField WHERE bytFormat=6 And lngViewID= " & mclsSum.ViewId
    Set rstName = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If rstName.EOF Then
        strName = ""
        strDesc = ""
        detBegin.Visible = False
        detEnd.Visible = False
        cmbDate.Visible = False
        lblFrom.Visible = False
        lblTo.Visible = False
        lblD.Visible = False
    ElseIf UCase(Trim(rstName!strFieldType)) = "DATE" Then
        strName = rstName!strFieldName
        strDesc = rstName!strViewFieldDesc & "(&D)"
        lblFrom.Visible = False
        lblTo.Visible = False
        detEnd.Visible = False
        cmbDate.Visible = False
    Else
        strName = rstName!strFieldName
        strDesc = rstName!strViewFieldDesc & "(&D)"
    End If
    Set rstName = Nothing
End Sub
'初始化表头列表框
Private Sub InitHeadList()
Dim intCount As Integer, intList As Integer
Dim strDesc As String, strSelect As String, strWhere As String, strCond As String
Dim strExtraCond As String, strOrder As String, strDetail As String
Dim strYCTS As String, strJZRQ As String, strQJ As String
Dim strName As String, strCellExtra As String
Dim arrDeal(28) As Boolean
Dim bytCodeShow As Byte
Dim D1 As Date, D2 As Date
    '得到层次汇总类型
    
    If mclsSum.SortColumns = 0 Then
        mintLevelType = 0
        mstrLevelCond = ""
    Else
        intList = mclsSum.SortLoc(0)
        strDesc = Right(mclsSum.ColumnFieldDesc(intList), 2)
        If strDesc = "货位" Then
            mintLevelType = 3
            mstrLevelCond = "Position.intLevel"
            strDetail = "Position.blnIsDetail"
        End If
        If (strDesc = "编码" Or strDesc = "编号") And mclsSum.ChoosedLoc(0) = intList Then
            strDesc = GetNoXString(mclsSum.ColumnFieldDesc(intList), 1, "编")
            Select Case strDesc
            Case "科目"                      '布尔标志:1
                 mintLevelType = 1
                 mstrLevelCond = "Account.intLevel"
                 strDetail = "Account.blnIsDetail"
            Case "部门"                      '布尔标志:3
                 mintLevelType = 2
                 mstrLevelCond = "Department.intLevel"
                 strDetail = "Department.blnIsDetail"
            Case "货位"                      '布尔标志:10
                 mintLevelType = 3
                 mstrLevelCond = "Position.intLevel"
                 strDetail = "Position.blnIsDetail"
            Case "固资类别"                  '布尔标志:17
                 mintLevelType = 4
                 mstrLevelCond = "FixedType.intLevel"
                 strDetail = "FixedType.blnIsDetail"
            Case "单位类别", "单位类型"      '布尔标志:14
                 mintLevelType = 5
                 mstrLevelCond = "CustomerType.intLevel"
                 strDetail = "CustomerType.blnIsDetail"
            Case "商品类别", "商品类型"     '布尔标志:15
                 mintLevelType = 6
                 mstrLevelCond = "ItemType.intLevel"
                 strDetail = "ItemType.blnIsDetail"
            Case "职员类别", "职员类型"     '布尔标志:25
                 mintLevelTyp