frmin_pztempletdesign.frm

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

                        Case 0              '处于第零列(“摘要”)，移到第一列(“科目”)
                            .Col = 1
                            .SetFocus
                        Case 1              '处于第一列，调用编辑文本框的按键事件，触发回车(KeyAscii=13)，以跳到 vaSpread 上
                            Call txtEdit_KeyPress(13)
                    End Select
                End If
                
            Case vbKeyUp            '按下上箭头
                If .Row = 1 Then
                    '如果第一行的参照值不是凭证数据数组的第一个值的话，重填数据且移动滚动条；否则维持现状（无操作）
                    If m_aryRefer(1) > LBound(m_aryVoucher) Then
                        '重填数据
                        Call ReFillGrid(m_aryRefer(1) - 1)
                        '移动滚动条
                        m_bManualScroll = True
                        tempVal = vSb.value - 1
                        vSb.value = IIf(tempVal < vSb.Min, vSb.Min, tempVal)
                        m_bManualScroll = False
                    End If
                '不是第一行，则跳到当前行的上一行
                Else
                    .Row = .Row - 1
                    .SetFocus
                End If
                
            Case vbKeyDown          '按下下箭头
                If .Row = .Rows - 1 Then
                    '如果最后一行的参照值不是凭证数据数组的最后一个值，重填数据且移动滚动条；否则无操作
                    If m_aryRefer(.Rows - 1) < UBound(m_aryVoucher) Then
                        '重填数据
                        Call ReFillGrid(m_aryRefer(1) + 1)
                        '移动滚动条
                        m_bManualScroll = True
                        tempVal = vSb.value + 1
                        vSb.value = IIf(tempVal > vSb.Max, vSb.Max, tempVal)
                        m_bManualScroll = False
'                        '手工更新文本框
'                        txtEdit.Text = .Text
                    End If
                '不是最后一行，则移到下一行
                Else
                    .Row = .Row + 1
                    .SetFocus
                End If
                
        End Select
    End With
    
End Sub


Private Sub cmdHelp_Click()
        
    With mFg
        Select Case .Col
            Case 0
                Dim frmHelp As New frmUSU_KmHelp
                
                frmHelp.Show 1
                If frmHelp.SubjectCode <> "" Then
                    txtEdit.text = frmHelp.SubjectCode
                End If
                Unload frmHelp
                txtEdit.SetFocus
                
            Case 1
                On Error Resume Next
                frmH_Summ.usKmdm = m_aryVoucher(m_aryRefer(.Row)).SubjectCode
                frmH_Summ.ubSelectStatus = True
                Load frmH_Summ
                frmH_Summ.Show 1
                If frmH_Summ.usName <> "" Then
                    txtEdit.text = frmH_Summ.usName
                End If
                Unload frmH_Summ
                txtEdit.SetFocus
        End Select
    End With
    
End Sub



Private Sub txtFJZS_KeyDown(KeyCode As Integer, Shift As Integer)
    '上下翻页
    If KeyCode = 33 And Shift = 0 Then
        PageUp
    End If
    If KeyCode = 34 And Shift = 0 Then
        PageDown
    End If
    '名称与代码切换 F8
    If KeyCode = 119 And Shift = 0 Then
        m_IsUseKmmc = Not m_IsUseKmmc
        Call ReFillGrid(vSb.value + 1)
    End If
End Sub

Private Sub txtPZBH_KeyDown(KeyCode As Integer, Shift As Integer)
    '上下翻页
    If KeyCode = 33 And Shift = 0 Then
        PageUp
    End If
    If KeyCode = 34 And Shift = 0 Then
        PageDown
    End If
    '名称与代码切换 F8
    If KeyCode = 119 And Shift = 0 Then
        m_IsUseKmmc = Not m_IsUseKmmc
        Call ReFillGrid(vSb.value + 1)
    End If
End Sub

'移动滚动条
Private Sub vSb_Change()
    Dim tempVal As Integer
    
    '如果是程序中调整滚动陶唆性时触发了本事件，则不进行操作
    
    If Not m_bManualScroll Then
         '重填数据
        If NoEmptyVoucherRow(mFg.Rows - 1) = 0 Then
            Call ReFillGrid(vSb.value + 1)
        
        '转移焦点，以避免滚动棒的闪烁
            picTotal.SetFocus
        Else
            MsgBox "前面包含空行,不能滚动!", vbInformation, ""
        End If
    End If
End Sub





'用数组的数据重填表格
'   StartRow：从数组的哪一行开始填充
Private Sub ReFillGrid(ByVal StartRow As Long)
    Dim i As Long, j As Long
    Dim OldRow As Long, oldcol As Long
    Dim FontColor As Long
    
'    OldRow = vSd.row
'    oldcol = vSd.col
    
    mFg.Redraw = False
    
    For i = 1 To VOUCHER_VIEWROWS
        '重置参照她组
        If UBound(m_aryRefer) < i Then Exit Sub
        m_aryRefer(i) = StartRow + i - 1
        '逐行填凭证数据
                '''
        mFg.TextMatrix(i, COL_SUBJECT) = ""
        mFg.TextMatrix(i, 1 - COL_SUBJECT) = ""
        If m_aryRefer(i) <= UBound(m_aryVoucher) Then
            If m_IsUseKmmc = True Then
                mFg.TextMatrix(i, COL_SUBJECT) = GetSubjectFullPath(glo.sAccountID, m_aryVoucher(m_aryRefer(i)).SubjectCode)
            Else
                mFg.TextMatrix(i, COL_SUBJECT) = m_aryVoucher(m_aryRefer(i)).SubjectCode
            End If
            mFg.TextMatrix(i, 1 - COL_SUBJECT) = m_aryVoucher(m_aryRefer(i)).Summary
        End If
    Next i
    
'    vSd.row = OldRow
'    vSd.col = oldcol
    
    mFg.Redraw = True
    
    '手工更新编辑框数据
    If m_aryRefer(mFg.Row) <= UBound(m_aryVoucher) Then
        If mFg.Col = 0 Then
            txtEdit.text = m_aryVoucher(m_aryRefer(mFg.Row)).SubjectCode
        Else
            txtEdit.text = m_aryVoucher(m_aryRefer(mFg.Row)).Summary
        End If
    End If
End Sub



Private Sub SaveDesign()
    Dim adoCmd As ADODB.Command
    Dim rSt As ADODB.Recordset
    Dim i As Long
    
'先删除
    Set adoCmd = New ADODB.Command
    adoCmd.ActiveConnection = glo.cnnMain
    adoCmd.CommandType = adCmdText
    adoCmd.CommandText = "delete from tZW_TempletDetail" & glo.sOperateYear & _
            " where cCode='" & m_sTempletCode & "'"
    adoCmd.Execute
    
    '保存最后可能对编辑文本框进行的修改(待细化)
    If txtEdit.Visible Then
        Call mFg_LeaveCell
    End If
    
'添加记录到数据集
    Set rSt = New ADODB.Recordset
    With rSt
        .CursorLocation = adUseClient
        .Open "select * from tZW_TempletDetail" & glo.sOperateYear, _
                    glo.cnnMain, adOpenStatic, adLockOptimistic
        For i = LBound(m_aryVoucher) To UBound(m_aryVoucher)
            If Trim$(m_aryVoucher(i).SubjectCode) <> "" Then
                .AddNew
                .Fields("Ccode").value = m_sTempletCode
                .Fields("jlhm").value = i               '会计分录序号
                
                '以下为与每条分录的值
                .Fields("pzzy").value = m_aryVoucher(i).Summary
                .Fields("kmdm").value = m_aryVoucher(i).SubjectCode
                .Fields("kmmc").value = m_aryVoucher(i).SubjectName
                
                .Update
            End If
        Next i
        .Close
    End With
    
End Sub

'将一条凭证记录导入数组
'   会计期间
'   凭证种类
'   凭证编号
Private Sub FillArray_Voucher()
    Dim sSQL As String
    Dim rstTemp As ADODB.Recordset
    Dim i As Integer
    Dim tempVal As Integer
    
    sSQL = "select * from tZW_TempletDetail" & glo.sOperateYear & " where Ccode='" & m_sTempletCode & _
                "' order by jlhm"
    Set rstTemp = New ADODB.Recordset
    With rstTemp
        .CursorLocation = adUseClient
        .Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
        If .RecordCount <> 0 Then
            If .RecordCount > VOUCHER_VIEWROWS Then
                ReDim m_aryVoucher(.RecordCount)
                '设置滚动条
                m_bManualScroll = True
                vSb.Min = 0
                vSb.Max = IIf(UBound(m_aryVoucher) - VOUCHER_VIEWROWS > 0, UBound(m_aryVoucher) - VOUCHER_VIEWROWS, 0)
                vSb.SmallChange = 1
                vSb.LargeChange = VOUCHER_VIEWROWS
                m_bManualScroll = False
            Else
                ReDim m_aryVoucher(VOUCHER_VIEWROWS)
                m_bManualScroll = True
                vSb.Min = 0
                vSb.Max = 0
                m_bManualScroll = False
            End If
            .MoveFirst
            For i = 1 To .RecordCount
                m_aryVoucher(i).Summary = Trim$("" & .Fields("pzzy").value)      '摘要
                m_aryVoucher(i).SubjectCode = Trim$("" & .Fields("kmdm").value)  '科目代码
                m_aryVoucher(i).SubjectCodeOLD = Trim$("" & .Fields("kmdm").value)
                m_aryVoucher(i).SubjectName = Trim$("" & .Fields("kmmc").value)  '科目名称
                .MoveNext
            Next i
        End If
        .Close
    End With
    
End Sub



Private Function Valid() As Boolean
    Valid = True
End Function
Public Sub PageUp()
vSb.value = IIf(vSb.value - VOUCHER_VIEWROWS < vSb.Min, vSb.Min, vSb.value - VOUCHER_VIEWROWS)
End Sub

Public Sub PageDown()
vSb.value = IIf(vSb.value + VOUCHER_VIEWROWS > vSb.Max, vSb.Max, vSb.value - VOUCHER_VIEWROWS)
End Sub

Private Sub vSd_KeyDown(KeyCode As Integer, Shift As Integer)
    '上下翻页
    If KeyCode = 33 And Shift = 0 Then
        PageUp
    End If
    If KeyCode = 34 And Shift = 0 Then
        PageDown
    End If
    '名称与代码切换 F8
    If KeyCode = 119 And Shift = 0 Then
        m_IsUseKmmc = Not m_IsUseKmmc
        Call ReFillGrid(vSb.value + 1)
    End If
End Sub

Public Sub PzPrint(ByVal IsPrint As Boolean, Optional ByVal CellFile As String)
Dim v As New clsVoucher
Dim iGlo As New GlobalInterface.clsGlobal
Dim iGlosys As New GlobalInterface.clsGlobalSys
InitGloInface iGlo, iGlosys
v.iGlo = iGlo
v.iGlosys = iGlosys
v.dTotalMoney = 0#
v.iVoucherAffix = Val(txtFJZS.text)
v.sBillMan = txtZDr.text
v.sCheckMan = txtFHr.text
v.sEnterprise = GetEnterpriseName("")
v.sMasterMan = txtZGr.text
v.sVoucherDate = Format(glo.sOperateDate, "yyyy-mm-dd")
v.sVoucherNumber = txtPZBH.text
v.sVoucherType = cboPZZL.text
Dim iTm As clsVoucherData
Dim i As Integer
For i = LBound(m_aryVoucher) To UBound(m_aryVoucher)
    Set iTm = New clsVoucherData
    iTm.bCollect = m_aryVoucher(i).bCollect
    iTm.bHelpInputed = m_aryVoucher(i).bHelpInputed
    iTm.CollectSubjectCode = m_aryVoucher(i).CollectSubjectCode
'    itm.DBLcredit = m_aryVoucher(i).DBLcredit
'    itm.DBLdebit = m_aryVoucher(i).DBLdebit
'    itm.SGNcredit = m_aryVoucher(i).SGNcredit
'    itm.SGNdebit = m_aryVoucher(i).SGNdebit
    iTm.SubjectCode = m_aryVoucher(i).SubjectCode
    iTm.SubjectName = m_aryVoucher(i).SubjectName
    iTm.Summary = m_aryVoucher(i).Summary
    iTm.zAmount = m_aryVoucher(i).zAmount
    iTm.zBillNo = m_aryVoucher(i).zBillNo
    iTm.zBillType = m_aryVoucher(i).zBillType
'    itm.zCBDcode = m_aryVoucher(i).zCBDcode
'    itm.zCBDname = m_aryVoucher(i).zCBDname
    iTm.zCountModeCode = m_aryVoucher(i).zCountModeCode
    iTm.zCountModeName = m_aryVoucher(i).zCountModeName
'    itm.zCustomerCode = m_aryVoucher(i).zCustomerCode
'    itm.zCustomerName = m_aryVoucher(i).zCustomerName
'    itm.zDepartmentCode = m_aryVoucher(i).zDepartmentCode
'    itm.zDepartmentName = m_aryVoucher(i).zDepartmentName
    iTm.zForeignMoney = m_aryVoucher(i).zForeignMoney
'    itm.zItemCode = m_aryVoucher(i).zItemCode
'    itm.zItemName = m_aryVoucher(i).zItemName
'    iTm.zOccurDate = m_aryVoucher(i).zOccurDate
'    itm.zPersonCode = m_aryVoucher(i).zPersonCode
'    itm.zPersonName = m_aryVoucher(i).zPersonName
    iTm.zPrice = m_aryVoucher(i).zPrice
'    itm.zVendorCode = m_aryVoucher(i).zVendorCode
'    itm.zVendorName = m_aryVoucher(i).zVendorName
    v.DataSet.Add iTm
Next
Load frmPz_Print
frmPz_Print.pz.Copy v
frmPz_Print.CellFile = CellFile
frmPz_Print.CellShow
If IsPrint = False Then
    frmPz_Print.Show 1
Else
    frmPz_Print.uPrint
    Unload frmPz_Print
End If
End Sub