frmbankdetail.frm

金算盘软件代码

End Sub

Private Sub LstInput_Choose()
    If msgBill.TextMatrix(mintRow, 3) <> TxtToDouble(lstInput.TextMatrix(lstInput.ReferRow, 1)) Then
        msgBill.TextMatrix(msgBill.Row, mintCheckCol) = ""
        msgBill.TextMatrix(mintRow, 3) = TxtToDouble(lstInput.TextMatrix(lstInput.ReferRow, 1))
        msgBill.TextMatrix(mintRow, mintPayMethodCol) = lstInput.Text
        msgBill.TextMatrix(mintRow, 1) = "-1"
        mblnIsChanged = True
    End If
End Sub

Private Sub lstInput_Delete()
    If frmPaymentMethodCard.DelCard(msgBill.TextMatrix(mintRow, 3), Me.hwnd) Then
        msgBill.TextMatrix(mintRow, 3) = 0
        msgBill.TextMatrix(mintRow, 1) = "-1"
        msgBill.TextMatrix(mintRow, mintPayMethodCol) = ""
        msgBill.TextMatrix(msgBill.Row, mintCheckCol) = ""
        setlistbox lstInput, 33, msgBill.TextMatrix(mintRow, 3)
        mblnIsChanged = True
    End If
End Sub

Private Sub lstInput_Edit()
    If msgBill.TextMatrix(mintRow, 3) = 0 Then
        ShowMsg hwnd, "请先选择付款方式再进行修改！", vbExclamation, Caption
        Exit Sub
    End If
    frmPaymentMethodCard.EditCard msgBill.TextMatrix(mintRow, 3), vbModal
    setlistbox lstInput, 33, msgBill.TextMatrix(mintRow, 3)
    msgBill.TextMatrix(mintRow, 1) = "-1"
    mblnIsChanged = True
End Sub

Private Sub lstInput_ItemNotExist()
    Dim lngID As Long
    
    If Trim(lstInput.Text) = "" Then Exit Sub
    If frmMsgAdd.MsgAddShow(Caption, "付款方式中没有" & lstInput.Text) = vbOK Then
        lngID = frmPaymentMethodCard.AddCard(lstInput.Text, vbModal)
        If lngID <> 0 Then
            msgBill.TextMatrix(mintRow, 3) = lngID
            msgBill.TextMatrix(msgBill.Row, mintCheckCol) = ""
        End If
        setlistbox lstInput, 33, lngID
    Else
        msgBill.TextMatrix(mintRow, 3) = 0
        msgBill.TextMatrix(mintRow, mintPayMethodCol) = ""
    End If
    msgBill.TextMatrix(mintRow, 1) = "-1"
    mblnIsChanged = True
End Sub

Private Sub lstInput_KeyUp(KeyCode As Integer, Shift As Integer)
    Dim i As Integer
    Static blnIsLeft As Boolean
    
'    GetColNO
    Select Case KeyCode
    Case vbKeyReturn
        If mintPayMethodCol < msgBill.Cols - 1 Then
            msgBill.col = mintPayMethodCol + 1
            msgBill.SetFocus
        Else
            msgBill.col = 2
            AddBill
        End If
    Case vbKeyUp
'        For i = msgBill.Row - 1 To 1 Step -1
'            If msgBill.RowHeight(i) > 0 Then Exit For
'        Next i
'        If msgBill.CellTop < msgBill.top + msgBill.RowHeight(0) Then msgBill.SetFocus
'        If i > 0 Then msgBill.Row = i
'        msgBill_Click
    Case vbKeyDown
'        For i = msgBill.Row + 1 To msgBill.Rows - 1
'            If msgBill.RowHeight(i) > 0 Then Exit For
'        Next i
'        If i < msgBill.Rows Then
''            msgBill.SetFocus
'            msgBill.Row = i
'            msgBill_Click
'        End If
    Case vbKeyLeft
        If lstInput.SelStart = 0 Then
            If Not blnIsLeft Then
                blnIsLeft = True
            Else
                msgBill.SetFocus
                BKKEY msgBill.hwnd, vbKeyLeft
                blnIsLeft = False
            End If
        End If
    Case vbKeyRight
        If lstInput.SelStart = Len(lstInput.Text) Then
            msgBill.SetFocus
            BKKEY msgBill.hwnd, vbKeyRight
        End If
    End Select
End Sub

Private Sub lstInput_LostFocus()
    If Me.ActiveControl.Name <> "lstInput" Then
        lstInput.Move -50000
    End If
End Sub

Private Sub mclsGrid_AfterColChange(lngSourCol As Long, lngDestCol As Long)
    dteInput.Left = -50000
    lstInput.Left = -50000
    GetColNO
End Sub

Private Sub mclsMainControl_EditColumn()
    setColumn
End Sub

Private Sub mclsMainControl_EditDel()
    On Error GoTo ErrHandle
    If frmMain.mnuListEditMenu(1).Enabled Then
        DeleteBill
    End If
ErrHandle:
End Sub

Private Sub mclsMainControl_EditNew()
    AddBill
End Sub

Private Sub mclsMainControl_FilePrint()
    FilePrint
End Sub

Private Sub mclsMainControl_FilePrintSetup()
    Dim MyPrintSet As PrintClass
    Dim intListPrintID As Integer
    
    Set MyPrintSet = New PrintClass
    MyPrintSet.PrintSetUp gclsBase.BaseDB, msgBill, , , , 68, Caption & Chr(1) _
            & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName & Chr(1) & "科目:" _
            & cboBill(0).Text & SpaceNum & "币种:" & cboBill(1).Text
    Set MyPrintSet = Nothing
End Sub

Private Sub mclsMainControl_ListEditMenu(ByVal intIndex As Integer)
    Dim i As Integer
    
    Select Case intIndex
    Case 0
        AddBill
    Case 1
        DeleteBill
'    Case 3
'        Dim strSql As String
'        If mclsGrid.ListSet.ListID < 1 Then mclsGrid.ListSet.SaveList
'        strSql = Filter.ShowFilter(mclsGrid.ListSet.ListID, 1)
''        If Trim(strSql) <> "" Then
'            If mblnIsChanged Then
'                If ShowMsg(hwnd, "筛选要刷新显示，您要保存对帐单数据吗？", _
'                    vbQuestion + vbYesNo, Caption) = vbYes Then
'                    SaveData
'                End If
'            End If
'            InitGrid strSql
'            Form_Resize
'        End If
    Case 3
        setColumn
    Case 5
        FilePrint
    End Select
End Sub

Private Sub FilePrint()
    Dim myPrintclass As PrintClass
    Set myPrintclass = New PrintClass
    myPrintclass.PrintList gclsBase.BaseDB, msgBill, 68, Caption & Chr(1) _
        & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName & Chr(1) & "科目:" _
        & cboBill(0).Text & SpaceNum & "币种:" & cboBill(1).Text
End Sub

Private Function SpaceNum() As String
    Dim i As Integer, lWidth As Long, strX As String
    
    For i = 0 To msgBill.Cols - 1
        lWidth = lWidth + msgBill.ColWidth(i)
    Next i
    lWidth = lWidth - TextWidth("科目:" & cboBill(0).Text & "币种:" & cboBill(1).Text)
    While TextWidth(strX) < lWidth * 7 / 10
        strX = strX & " "
    Wend
    SpaceNum = strX
End Function

Private Sub mclsMainControl_ListReportMenu(ByVal intIndex As Integer)
    If mblnIsChanged Then
        If ShowMsg(hwnd, "您要保存对帐单的数据吗?", vbQuestion + vbYesNo, Caption) = vbYes Then
            Me.Hide
            MsgForm.PleaseWait
            mblnIsHide = True
            SaveData
            InitGrid
            mblnIsHide = False
            Unload MsgForm
            Me.Show
        End If
        mblnIsChanged = False
    End If
    Report.ShowStandardReport 591, 540
End Sub

Private Sub mclsMainControl_ToolRefresh()
    Dim blnOK As Boolean
    
    mblnIsHide = True
    dteInput.Move -50000
    lstInput.Move -50000
    If txtInput.Visible Then txtInput.Visible = False
    If txtCal.Visible Then txtCal.Visible = False
    If mblnIsChanged Then
        blnOK = (ShowMsg(hwnd, "要保存本次对帐单编辑的结果吗?", vbQuestion + vbYesNo, Caption) = vbYes)
    End If
    MsgForm.PleaseWait
    If blnOK Then SaveData
    InitGrid
    Unload MsgForm
    mblnIsHide = False
End Sub

Private Sub mclsSubClassForm_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    Dim MinMax As MINMAXINFO

    If Msg = WM_GETMINMAXINFO Then
        CopyMemory MinMax, ByVal lParam, Len(MinMax)

        MinMax.ptMinTrackSize.x = 350
        MinMax.ptMinTrackSize.y = 260

        CopyMemory ByVal lParam, MinMax, Len(MinMax)
        Result = 0
    End If
End Sub

Private Sub Paste()
    Dim iLeft As Integer, i As Integer
    
    On Error Resume Next
    If mblnIsHide Then Exit Sub
'    GetColNO
'    If mintRow = 1 Then Exit Sub
    If msgBill.TextMatrix(msgBill.Row, 2) = "9" Then Exit Sub
    With msgBill
        If .col = mintPayMethodCol Then
            dteInput.Move -50000
            lstInput.Text = .TextMatrix(mintRow, mintPayMethodCol)
            lstInput.Move .Left + .CellLeft, .top + .CellTop, .ColWidth(mintPayMethodCol), .RowHeight(mintRow)
            If .TextMatrix(mintRow, 3) > "0" Then lstInput.SeekId .TextMatrix(mintRow, 3)
            lstInput.SetFocus
        Else
            lstInput.Move -50000
        '    iLeft = 0
        '    For i = 1 To mintDateCol - 1
        '        If .ColIsVisible(i) Then
        '            iLeft = iLeft + .ColWidth(i)
        '        End If
        '    Next i
            dteInput.Text = Trim$(.TextMatrix(mintRow, mintDateCol))
            dteInput.Move .Left + .CellLeft, .top + .CellTop, .ColWidth(mintDateCol), .RowHeight(mintRow)
        '    dteInput.Move .Left + iLeft, .top + .CellTop, .ColWidth(mintDateCol)
            If Not mblnIsInit Then dteInput.SetFocus
        End If
    End With
    mintPRow = msgBill.Row
End Sub

Private Sub msgBill_Click()
'    GetColNO
    mintRow = msgBill.Row
    UpdateMenuStatus
    If msgBill.col = mintDateCol Or msgBill.col = mintPayMethodCol Then Paste
End Sub

Private Sub msgBill_DblClick()
    If msgBill.col = mintCheckCol Or msgBill.col = mintPayMethodCol Or Not mblnRowValid Then Exit Sub
    If CellAllowEdit Then EditGrid 0 'vbKeyEnd
End Sub

Private Sub msgBill_EnterCell()
    
'    GetColNO
    UpdateMenuStatus
    If dteInput.Left > 0 And Trim(dteInput.Text) = "" Then Exit Sub
    If txtInput.Visible Then txtInput_LostFocus
    If mintRow = 0 Or msgBill.Row = 0 Or msgBill.RowHeight(msgBill.Row) = 0 Or mblnIsSort Then Exit Sub
'    If mblnIsAdd And mintRow = msgBill.Row Then Exit Sub   ?
    If mintRow <> msgBill.Row Then mblnIsAdd = False
'    BillIsValid
'    If Not mblnValueOK And mintRow <> msgBill.Row Then Exit Sub
'    If mintRow <> msgBill.Row Then Exit Sub
    mintCol = msgBill.col
'    mintPRow = mintRow
    mintRow = msgBill.Row
    If msgBill.col = mintDateCol Or msgBill.col = mintPayMethodCol Then
        Paste
    Else
        If Trim(dteInput.Text) = "" Then Exit Sub
        dteInput.Move -50000
        lstInput.Move -50000
    End If
End Sub

Private Sub GetColNO()
    Dim i As Integer
    
    mintCheckCol = 5
    mintDateCol = -1
    mintRemarkCol = -1
    mintBillNOCol = -1
    mintDebitCol = -1
    mintCreditCol = -1
    mintPayMethodCol = -1
    mintBalCol = -1
    With msgBill
        For i = 1 To .Cols - 1
            If .TextMatrix(0, i) = mstrCheckCol Then
                mintCheckCol = i
            ElseIf .TextMatrix(0, i) = mstrDateCol Then
                mintDateCol = i
            ElseIf .TextMatrix(0, i) = mstrRemarkCol Then
                mintRemarkCol = i
            ElseIf .TextMatrix(0, i) = mstrBillNOCol Then
                mintBillNOCol = i
            ElseIf .TextMatrix(0, i) = mstrDebitCol Then
                mintDebitCol = i
            ElseIf .TextMatrix(0, i) = mstrCreditCol Then
                mintCreditCol = i
            ElseIf .TextMatrix(0, i) = mstrBalCol Then
                mintBalCol = i
            ElseIf .TextMatrix(0, i) = mstrPayMethodCol Then
                mintPayMethodCol = i
            End If
        Next i
    End With
'    With mclsGrid.ListSet
'    For i = 1 To mclsGrid.ListSet.Columns
'        If InStr(.ColumnFieldName(i), "对帐") > 0 Then
'            mintCheckCol = i + 3
'        ElseIf InStr(.ColumnFieldName(i), "日期") > 0 Then
'            mintDateCol = i + 3
'        ElseIf InStr(.ColumnFieldName(i), "摘要") > 0 Then
'            mintRemarkCol = i + 3
'        ElseIf InStr(.ColumnFieldName(i), "票据号") > 0 Then
'            mintBillNOCol = i + 3
'        ElseIf InStr(.ColumnFieldName(i), "借方") > 0 Then
'            mintDebitCol = i + 3
'        ElseIf InStr(.ColumnFieldName(i), "贷方") > 0 Then
'            mintCreditCol = i + 3
'        ElseIf InStr(.ColumnFieldName(i), "余额") > 0 Then
'            mintBalCol = i + 3
'        End If
'    Next i
'    End With
End Sub

Private Function MakeSQL(ByVal iRow As Integer, ByVal isAdd As Boolean, AcnID As Long, CurID As Long) As String
    Dim strSql1 As String, strsql2 As String
    
    With msgBill
    If isAdd Then
        strSql1 = "INSERT INTO BankDetail(lngBankDetailID,lngAccountID,lngCurrencyID,lngPaymentMethodID," _
            & "strDate,intDirection,dblAmount,dblBalance,lngOperatorID"