frmcashsettle.frm

金算盘软件代码

Private Sub LoadGrdColWidth()
    Dim strSql As String
    Dim recTmp As rdoResultset
    Dim i As Integer
    
    strSql = "SELECT strKey,strSetting FROM Setting WHERE lngModuleID=0 AND strSection='" & Me.Name & "列宽'"
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTmp.BOF And recTmp.EOF Then
        FirstGrdColWidth
    Else
        Do While Not recTmp.EOF
            GrdCol.ColWidth(C2lng(recTmp!strKey)) = C2lng(recTmp!strSetting)
            recTmp.MoveNext
        Loop
    End If
    recTmp.Close
    Set recTmp = Nothing
End Sub
Private Sub FirstGrdColWidth()
    Dim i As Integer
    
    For i = 1 To GrdCol.Cols - 1
        If StrLen(GrdCol.TextMatrix(0, i)) > 4 Then
            GrdCol.ColWidth(i) = IIf(InStr(GrdCol.TextMatrix(0, i), "日期") <> 0, 11, StrLen(GrdCol.TextMatrix(0, i)) + 1) * Me.TextWidth("A")
        Else
            GrdCol.ColWidth(i) = 900
        End If
    Next

End Sub
Private Sub SaveGrdColWidth()
    Dim strSql As String
    Dim recTmp As rdoResultset
    Dim i As Integer
    
    On Error GoTo ErrHandle
    GetLngColNO
    
    gclsBase.BaseWorkSpace.BeginTrans
    
    strSql = " FROM Setting WHERE lngModuleID=0 AND strSection='" & Me.Name & "列宽'"
    gclsBase.BaseDB.Execute "DELETE * " & strSql
        
    strSql = "SELECT *" & strSql
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
    With recTmp
        For i = 1 To GrdCol.Cols - 1
            .AddNew
            !lngModuleID = 0
            !strSection = Me.Name & "列宽"
            !strKey = i
            !strSetting = CStr(IIf(GrdCol.ColWidth(xlngColNo(i)) < 400, 400, GrdCol.ColWidth(xlngColNo(i))))
            !strTypeName = "Long"
            .Update
        Next
    End With
    recTmp.Close
    Set recTmp = Nothing
    gclsBase.BaseWorkSpace.CommitTrans
    Exit Sub
ErrHandle:
    If Not recTmp Is Nothing Then
        recTmp.Close
        Set recTmp = Nothing
    End If
    gclsBase.BaseWorkSpace.RollBacktrans
End Sub

Private Sub cmdokcancel_Click(Index As Integer)
    If Me.MousePointer = vbHourglass Then
        Exit Sub
    End If
    
    Select Case Index
    Case 0  '确定
        If SaveBill() Then
            Unload Me
            Exit Sub
        End If
    Case 1  '取消
        Unload Me
        Exit Sub
    Case 2  '新增
        InsertARow
        cmdOkCancel(3).Enabled = True
        mblnIsChanged = True
    Case 3  '删除
        RemoveARow GrdCol.Row
        If GrdCol.Rows <= 1 Then
            InsertARow
        End If
        mblnIsChanged = True
    End Select
End Sub

Private Function ColName(ByVal lngCol As Long) As String
    Dim strTmp As String
    
    strTmp = GrdCol.TextMatrix(0, lngCol)
    
    If InStr(strTmp, "↑") <> 0 Or InStr(strTmp, "↓") <> 0 Then
        strTmp = Left(strTmp, Len(strTmp) - 1)
    End If
    ColName = strTmp
End Function

Private Sub GetLngColNO()
    Dim i As Integer
    Dim j As Integer
    
    For i = 1 To GrdCol.Cols - 1
        For j = 1 To GrdCol.Cols - 1
            If strColName(i) = ColName(j) Then
                xlngColNo(i) = j
                Exit For
            End If
        Next
    Next
End Sub

Private Sub mclsGrid_AfterColChange(lngSourCol As Long, lngDestCol As Long)
    GetLngColNO
    mclsGrid.TotalRowAdjust
    mclsGrid.DrawTotalBox
    WriteTotalRow
End Sub

Private Sub mclsGrid_AfterSave()
    If GrdCol.Row < 1 Then
        Exit Sub
    End If
    Select Case mlngOldCol
    Case xlngColNo(5)
        If GrdCol.Row >= 1 Then
            mNotSaveInput = True
            If CheckNoJustice(GrdCol.Row) = True Then
'                blnCancel = True
                mNotSaveInput = False
                Exit Sub
            End If
            mNotSaveInput = False
        End If
    Case xlngColNo(6) '原币金额
        GrdCol.TextMatrix(GrdCol.Row, xlngColNo(6)) = Format(C2Dbl(GrdCol.TextMatrix(GrdCol.Row, xlngColNo(6))), strCurrDec)
        GrdCol.TextMatrix(GrdCol.Row, xlngColNo(7)) = Format(C2Dbl(GrdCol.TextMatrix(GrdCol.Row, xlngColNo(6))) * mdblCurrRate, FormatString(gclsBase.NaturalCurDec))
        WriteTotalRow
    Case xlngColNo(7) '本币金额
        GrdCol.TextMatrix(GrdCol.Row, xlngColNo(7)) = Format(C2Dbl(GrdCol.TextMatrix(GrdCol.Row, xlngColNo(7))), FormatString(gclsBase.NaturalCurDec))
        GrdCol.TextMatrix(GrdCol.Row, xlngColNo(6)) = Format(C2Dbl(GrdCol.TextMatrix(GrdCol.Row, xlngColNo(7))) / mdblCurrRate, strCurrDec)
        WriteTotalRow
    Case xlngColNo(8) '原币金额
        GrdCol.TextMatrix(GrdCol.Row, xlngColNo(8)) = Format(C2Dbl(GrdCol.TextMatrix(GrdCol.Row, xlngColNo(8))), strCurrDec)
        GrdCol.TextMatrix(GrdCol.Row, xlngColNo(9)) = Format(C2Dbl(GrdCol.TextMatrix(GrdCol.Row, xlngColNo(8))) * mdblCurrRate, FormatString(gclsBase.NaturalCurDec))
        WriteTotalRow
    Case xlngColNo(9) '本币金额
        GrdCol.TextMatrix(GrdCol.Row, xlngColNo(9)) = Format(C2Dbl(GrdCol.TextMatrix(GrdCol.Row, xlngColNo(9))), FormatString(gclsBase.NaturalCurDec))
        GrdCol.TextMatrix(GrdCol.Row, xlngColNo(8)) = Format(C2Dbl(GrdCol.TextMatrix(GrdCol.Row, xlngColNo(9))) / mdblCurrRate, strCurrDec)
        WriteTotalRow
    Case xlngColNo(1) '日期
        GetNewNO
    End Select
End Sub

Private Sub mclsGrid_BeforeEdit(blnCancel As Boolean)
    If mblnMayChange = False Then '不可修改
        blnCancel = True
        Exit Sub
    End If
    If GrdCol.Row < 1 Then
        blnCancel = True
        Exit Sub
    End If
    GetLngColNO
    mlngOldCol = GrdCol.col
    Select Case GrdCol.col
    Case xlngColNo(1)  'Date
        If Trim(GrdCol.TextMatrix(GrdCol.Row, GrdCol.col)) = "" Then
            dtmInput.Text = Format(gclsBase.BaseDate, "YYYY-MM-DD")
        End If
    Case xlngColNo(2)  'Text
        If gclsBase.AutoNo Then
            blnCancel = True
            Exit Sub
        End If
        txtInput.MaxLength = 10
    Case xlngColNo(3), xlngColNo(4), xlngColNo(10), xlngColNo(11), xlngColNo(12), xlngColNo(13) 'Refer
        setRefer 3
    Case xlngColNo(6), xlngColNo(8) '原币金额
        curInput.Digits = lngCurrDec
    Case xlngColNo(7), xlngColNo(9) '本币金额
        curInput.Digits = gclsBase.NaturalCurDec
    Case xlngColNo(5)
        txtInput.MaxLength = 16
    End Select
End Sub

Private Sub mclsGrid_BeforeSave(blnCancel As Boolean)
    If GrdCol.Row < 1 Then
        blnCancel = True
        Exit Sub
    End If
    Dim strMsg As String
Restart:
    Select Case mlngOldCol
    Case xlngColNo(3)
        If refInput.Text <> "" And refInput.ID = 0 Then
            strMsg = "科目" & refInput.Text & "不存在，是否新增？"
            GoTo ErrH
        End If
        RowDatas(GrdCol.RowData(GrdCol.Row)).lngAccountID = refInput.ID
    Case xlngColNo(4)
        If refInput.Text <> "" And refInput.ID = 0 Then
            strMsg = mstrDoing & "方式" & refInput.Text & "不存在，是否新增？"
            GoTo ErrH
        End If
        RowDatas(GrdCol.RowData(GrdCol.Row)).lngPaymentMethodID = refInput.ID
    Case xlngColNo(10)
        If refInput.Text <> "" And refInput.ID = 0 Then
            strMsg = "部门" & refInput.Text & "不存在，是否新增？"
            GoTo ErrH
        End If
        If (Not RowDatas(GrdCol.RowData(GrdCol.Row)).lngDepartmentID = refInput.ID) And refInput.ID > 0 Then
            RowDatas(GrdCol.RowData(GrdCol.Row)).lngEmployeeID = 0
            GrdCol.TextMatrix(GrdCol.Row, xlngColNo(11)) = ""
        End If
        RowDatas(GrdCol.RowData(GrdCol.Row)).lngDepartmentID = refInput.ID
    Case xlngColNo(11)
        If refInput.Text <> "" And refInput.ID = 0 Then
            strMsg = "职员" & refInput.Text & "不存在，是否新增？"
            GoTo ErrH
        End If
        RowDatas(GrdCol.RowData(GrdCol.Row)).lngEmployeeID = refInput.ID
    Case xlngColNo(12)
        If refInput.Text <> "" And refInput.ID = 0 Then
            strMsg = "统计" & refInput.Text & "不存在，是否新增？"
            GoTo ErrH
        End If
        RowDatas(GrdCol.RowData(GrdCol.Row)).lngClassID1 = refInput.ID
    Case xlngColNo(13)
        If refInput.Text <> "" And refInput.ID = 0 Then
            strMsg = "项目" & refInput.Text & "不存在，是否新增？"
            GoTo ErrH
        End If
        RowDatas(GrdCol.RowData(GrdCol.Row)).lngClassID2 = refInput.ID
    End Select
    mblnIsChanged = True
    mNotSaveInput = False
    Exit Sub
ErrH:
    mNotSaveInput = True
    If ShowMsg(Me.hwnd, strMsg, MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, Me.Caption) = IDYES Then
        refInput_AddNew
        If refInput.Text <> "" And refInput.ID = 0 Then
            refInput.Text = ""
        End If
        GoTo Restart
    Else
        refInput.Text = ""
        GoTo Restart
    End If
    mNotSaveInput = False
    blnCancel = True
End Sub

Private Sub mclsGrid_DataValid(blnCancel As Boolean)
    'tmp
End Sub

Private Sub cMsgBox(ByVal strText As String, Optional ByVal strTitle As String = "提示信息")
    ShowMsg Me.hwnd, strText, MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, strTitle
End Sub

Private Sub setRefer(ByVal lngIndex As Long)
    Dim strSql As String
    
    Select Case lngIndex
    Case 0  '收款模板
        strSql = "SELECT lngTemplateID,strTemplateName FROM Template " & _
            " WHERE blnIsInActive = 0 And blnBusinessActivity = 1 And lngReceiptTypeID = "
        If mlngReceiptTypeID < 12 Then
            strSql = strSql & 39
        Else
            strSql = strSql & 40
        End If
        strSql = strSql & " ORDER BY blnIsSys,lngTemplateID "
        refHead(0).SQL = strSql
        Set refHead(0).Recordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        refHead(0).AddRefer "<新增>"
        refHead(0).AddRefer "<修改>"
        refHead(0).AddRefer "<删除>"
    Case 1  '折扣模板
        strSql = "SELECT lngTemplateID,strTemplateName FROM Template " & _
            "WHERE blnIsInActive = 0 And lngReceiptTypeID = "
        If mlngReceiptTypeID < 12 Then
            strSql = strSql & 35
        Else
            strSql = strSql & 37
        End If
        strSql = strSql & " ORDER BY blnIsSys,lngTemplateID "
        refHead(1).SQL = strSql
        Set refHead(1).Recordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        refHead(1).AddRefer "<新增>"
        refHead(1).AddRefer "<修改>"
        refHead(1).AddRefer "<删除>"
    Case 2  '折扣科目   '非存货、非现金银行、无辅助核算
        strSql = "SELECT lngAccountID,strAccountCode,strAccountName FROM Account " & _
            " WHERE blnIsInActive=0 " & _
            " ORDER BY strAccountCode "
        refHead(2).SQL = strSql
        Set refHead(2).Recordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        refHead(2).AddRefer "<新增>"
        refHead(2).AddRefer "<修改>"
        refHead(2).AddRefer "<删除>"
    Case 3  '表体项目
        GoTo GridRef
    End Select
    GoTo EndProc
GridRef:
    Dim strTmp As String
    
    strTmp = GrdCol.TextMatrix(0, GrdCol.col)
    If Right(strTmp, 1) = "↑" Or Right(strTmp, 1) = "↓" Then
        strTmp = Left(strTmp, Len(strTmp) - 1)
    End If
    Select Case strTmp
    Case "现金/银行科目"
        mlngMsgNO = Message.msgAccount
        strSql = "SELECT lngAccountID,strAccountCode,strAccountName FROM Account " & _
            " WHERE lngAccountNatureID IN (1,2) " & _
            " AND blnIsInActive=0 " & _
            " ORDER BY strAccountCode "
    Case "收款方式"
        mlngMsgNO = Message.msgPaymentMethod
        strTmp = "PaymentMethod"