frmac_generalresult.frm

一个用VB写的财务软件源码

            m_sSubjName = Mid(cboSubject.text, InStr(1, cboSubject.text, "=") + 1)
            If m_bIncludeNotRecord Then
                Me.ShowResultIncludeNotRec
            Else
                Me.ShowResult
            End If
           cboSubject.SetFocus
        End If
        m_sPreSubject = .text
  End With
End Sub

'调整列宽时触发
Private Sub Cllr_AllowSizeCol(ByVal col As Long, ByVal row As Long, approve As Long)
    Dim vCurColWidth As Variant
    Dim lCurChangeCol As Long
    Dim iTotalPages As Integer
    Dim lCurrentPage As Long
    Dim bChangeColWidth As Boolean
    Dim i As Long
    Dim j As Long
    
    Select Case usAccountFormat
        Case "金额式"
            If col = COL_DEBIT_AMOUNT Or col = COL_DEBIT_FOREIGN Or _
                col = COL_CREDIT_AMOUNT Or col = COL_CREDIT_FOREIGN Or _
                col = COL_BALANCE_AMOUNT Or col = COL_BALANCE_FOREIGN Then
                approve = False
            Else
                approve = True
            End If
        Case "数量金额式"
            If col = COL_DEBIT_FOREIGN Or col = COL_CREDIT_FOREIGN Or _
                col = COL_BALANCE_FOREIGN Then
                approve = False
            Else
                approve = True
            End If
        Case "外币金额式"
            If col = COL_DEBIT_AMOUNT Or col = COL_CREDIT_AMOUNT Or _
                col = COL_BALANCE_AMOUNT Then
                approve = False
            Else
                approve = True
            End If
        Case "数量外币式"
            approve = True
    End Select
    If col = COL_END + 1 Then
        approve = False
    End If
    
    '如果某页某列的列宽改变，则重新设置所有页的该列列宽
    For i = LBound(m_iColWidthTemp) To UBound(m_iColWidthTemp)
    vCurColWidth = Cllr.GetColWidth(1, i, Cllr.GetCurSheet)
        If vCurColWidth <> "" Then
            If vCurColWidth <> m_iColWidthTemp(i) Then
                bChangeColWidth = True
                m_iColWidthTemp(i) = vCurColWidth
                lCurChangeCol = i
            End If
        End If
    Next i

    With Cllr
        If bChangeColWidth Then
            lCurrentPage = .GetCurSheet
            iTotalPages = .GetTotalSheets
            For i = 0 To iTotalPages - 1
                .SetCurSheet i
                .SetColWidth 1, m_iColWidthTemp(lCurChangeCol), lCurChangeCol, i
            Next i
            .SetCurSheet lCurrentPage
        End If
    End With
End Sub

'调整行高时触发
Private Sub cllR_allowsizerow(ByVal col As Long, ByVal row As Long, approve As Long)
    approve = False
End Sub

'双击单元格
Private Sub cllR_mousedclick(ByVal col As Long, ByVal row As Long)
    Dim frmR As frmAC_DetailResult
    Dim frmD As frmAC_BookResult
    Dim sMonth As Variant
    Dim i As Integer
    Dim rstRec As New ADODB.Recordset
    Dim bRjz As Boolean
    Dim sSQL As String
    
    sMonth = Cllr.GetCellString(1, row, Cllr.GetCurSheet)
    
    If sMonth <> "" Then
        '当所在行在本月合计和本年累计时, 调用明细账查询
        If IsNumeric(sMonth) Then
            If CInt(sMonth) >= 1 And CInt(sMonth) <= 12 Then
                For i = 0 To Forms.Count - 1
                    If Forms(i).Tag = m_sSubjCode & "," & sMonth Then
                        Forms(i).ZOrder
                        Exit Sub
                    End If
                Next i
                '存放当前查询科目到tag, 作为明细账联查的依据
                Me.Tag = m_sSubjCode
                sSQL = "select isRjz from tzw_km" & glo.sOperateYear & " where kmdm='" & m_sSubjCode & "'"
                With rstRec
                   .Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
                   If Not (.EOF And .BOF) Then
                     bRjz = .Fields("isrjz").value
                   End If
                   .Close
                End With
                Set rstRec = Nothing
                
                If bRjz Then
                    Set frmD = New frmAC_BookResult
                    frmD.usYear = glo.sOperateYear
                    frmD.usFromMonth = Format(sMonth, "00")
                    frmD.usToMonth = Format(sMonth, "00")
                    frmD.usFromDate = GetPeriodFrom(CInt(sMonth))
                    frmD.usToDate = GetPeriodTo(CInt(sMonth))
                    frmD.usSubjectCode = m_sSubjCode
                    frmD.usSubjectName = m_sSubjName
                    frmD.usSubjectIndex = -1
                    frmD.usIncludeNotRecord = True
                    If m_bIncludeNotRecord Then
                        frmD.usIncludeNotRecord = True
                    Else
                        frmD.usIncludeNotRecord = False
                    End If
                    frmD.ShowResult
               Else
                    Set frmR = New frmAC_DetailResult
                    frmR.usYear = glo.sOperateYear
                    frmR.usFromMonth = sMonth
                    frmR.usToMonth = sMonth
                    frmR.usSubjectCodeStart = m_sSubjCode
                    frmR.usSubjectNameStart = m_sSubjName
                    frmR.usNRFlag = m_bIncludeNotRecord
                    frmR.usSubjectCodeEnd = m_sSubjCode
                    frmR.usSubjectCurName = m_sSubjName
                    frmR.ubBlankKm = True
                    frmR.Kmmc_set
                    frmR.Tag = m_sSubjCode & "," & sMonth
                    If m_bIncludeNotRecord Then
                       frmR.ShowResultbak
                    Else
                       frmR.ShowResult
                    End If
             End If
           End If
      End If
  End If
End Sub

'右击单元格触发
Private Sub cllR_MouseRClick(ByVal col As Long, ByVal row As Long, ByVal updn As Long)
    If updn = False Then
        m_iCol = col
        m_iRow = row
        fMainForm.mnuBalanceResult.Visible = False
        fMainForm.mnuDetailResult.Visible = True
        fMainForm.mnuVoucherResult.Visible = False
        fMainForm.mnuDailyResult.Visible = False
        Me.PopupMenu fMainForm.mnuQueryAccount
    End If
End Sub
Private Sub Form_Activate()
TbrControl False
End Sub

Private Sub Form_Deactivate()
TbrControl True
End Sub
Private Sub form_load()
    Dim i As Long, j As Long
    TbrControl False
    m_bFormLoad = True
    
'    Me.Caption = "总账查询 - “" & m_sSubjCode & "=" & m_sSubjName & "”"
    usAccountType = "总账"
    usAccountFormat = "金额式"
    
    Select Case usAccountFormat
        Case "金额式"
            m_sDefaultColWidth = COLWIDTH_MONEY
        Case "数量金额式"
            m_sDefaultColWidth = COLWIDTH_AMOUNT
        Case "外币金额式"
            m_sDefaultColWidth = COLWIDTH_FOREIGN
        Case "数量外币式"
            m_sDefaultColWidth = COLWIDTH_AMOUNT_FOREIGN
    End Select
    
    '求出各列的宽度
    m_iColWidth = GetColWidth(usAccountType, usAccountFormat, m_sDefaultColWidth)
    m_iColWidthTemp = m_iColWidth
    
    
    Call Kmmc_set
 
     
    For i = LBound(arySubDetail) + 1 To UBound(arySubDetail)
        cboSubject.AddItem arySubDetail(i).sSubjectCode & "=" & arySubDetail(i).sSubjectName
    Next i
    If cboSubject.ListCount <> 0 Then
        cboSubject.ListIndex = 0
    End If
  With Cllr
        .Login "南京伊康计算机工程公司", "11010504", "0060-1733-7722-3004"
        If .OpenFile(App.Path & "\CellFiles\General.cll", "") = -1 Then
            MsgBox "CELL文件不存在！", vbOKOnly
        End If
        .SetDefaultFont .FindFontIndex("宋体", 1), 10        '字体; 9号字, 0=粗体, 宋体
        .WorkbookReadonly = True                                   '表格只读
        .AllowSizeColInGrid = True

  End With
    
  m_bFormLoad = False
End Sub


Private Sub Form_Resize()
    On Error Resume Next
    Cllr.Width = Me.ScaleWidth - 100
    Cllr.Height = Me.ScaleHeight - 200
End Sub

'窗体卸载前, 检查账页的列宽是否被调整
Private Sub Form_Unload(Cancel As Integer)
    Cancel = 0
    If IsColChange(Me.Cllr, m_iColWidth) = True Then
        If MsgBox(usAccountFormat & "账簿格式已经改变，是否保存？", _
                    vbQuestion + vbYesNo + vbDefaultButton2) = vbYes Then
            Call SaveColChange(m_iColWidth, usAccountType, usAccountFormat)
        End If
    End If
  TbrControl True
  m_Mutex.DeleteMutexID gloSys.sSubSysId, glo.sAccountID, "mnuAccountGeneral", m_iID
End Sub

Private Sub SetGrid()
    Dim i As Long
    Dim j As Long
    
    '设置表头
    With Cllr
        
        .SetSelectMode .GetCurSheet, 2                         '允许整行选择
        .SetFixedCol COL_START, COL_DAY             '设置不滚动列
        .SetFixedRow ROW_TITLE, ROW_HEAD2           '设置不滚动行
        .ShowSideLabel 0, .GetCurSheet                        '行标不可见
        .ShowTopLabel 0, .GetCurSheet                       '列标不可见
        
    'Title
        '设置单元格中文本对齐方式; &H24=100100 表示水平中线方向对齐,垂直中线方向对齐
        .SetCellAlign COL_START, ROW_TITLE, .GetCurSheet, 32 + 4
        
        '设置指定单元格中文本的字体; 15号字体, 5=粗体加下划线, 黑体
        .SetCellFont COL_START, ROW_TITLE, .GetCurSheet, .FindFontIndex("黑体", 1)
        .SetCellFontSize COL_START, ROW_TITLE, .GetCurSheet, 17
        .SetCellFontStyle COL_START, ROW_TITLE, .GetCurSheet, 10
        
        '合并指定区域内的单元格
        .MergeCells COL_START, ROW_TITLE, COL_END, ROW_TITLE
        
        '设置指定单元格中字符串数据
        .SetCellString COL_START, ROW_TITLE, .GetCurSheet, m_sGenSubjectName & "总账"
        '行高
        .SetRowHeight 1, 40, ROW_TITLE, .GetCurSheet
        
    'Comment
        .MergeCells COL_START, ROW_ACCOUNTFORMAT, COL_END, ROW_ACCOUNTFORMAT
        '如果是数量账或者外币账, 则设置数量单位和外币单位格
        If m_bAmount Or m_bForeign Then
            If m_bAmount And m_bForeign Then
                .MergeCells COL_START, ROW_SUBJCODE, COL_BALANCE_FOREIGN, ROW_SUBJCODE
                .MergeCells COL_BALANCE_MONEY, ROW_SUBJCODE, COL_END, ROW_SUBJCODE
               .SetCellFont COL_BALANCE_MONEY, ROW_SUBJCODE, .GetCurSheet, .FindFontIndex("楷体_GB2312", 1)
                .SetCellFontSize COL_BALANCE_MONEY, ROW_SUBJCODE, .GetCurSheet, 10
                .SetCellFontStyle COL_BALANCE_MONEY, ROW_SUBJCODE, .GetCurSheet, 0
                .SetCellAlign COL_BALANCE_MONEY, ROW_SUBJCODE, .GetCurSheet, 33
            Else
                .MergeCells COL_START, ROW_SUBJCODE, COL_END, ROW_SUBJCODE
            End If
            .MergeCells COL_START, ROW_SUBJNAME, COL_BALANCE_FOREIGN, ROW_SUBJNAME
            .MergeCells COL_BALANCE_MONEY, ROW_SUBJNAME, COL_END, ROW_SUBJNAME
            .SetCellFont COL_BALANCE_MONEY, ROW_SUBJNAME, .GetCurSheet, .FindFontIndex("楷体_GB2312", 1)
            .SetCellFontSize COL_BALANCE_MONEY, ROW_SUBJNAME, .GetCurSheet, 10
            .SetCellFontStyle COL_BALANCE_MONEY, ROW_SUBJNAME, .GetCurSheet, 0
            .SetCellAlign COL_BALANCE_MONEY, ROW_SUBJNAME, .GetCurSheet, 33
        Else
            .MergeCells COL_START, ROW_SUBJCODE, COL_END, ROW_SUBJCODE