frmaccountinit.frm

金算盘软件代码

    For Each vntMessage In mclsMainControl.Messages
        '接收到科目期初改变消息
        If vntMessage = Message.msgAccount Or vntMessage = Message.msgAccountInit Then
            'mblnIsInput = False
            mGrid.FixedCols = 0
            mGrid.Cols = 2
            mGrid.Redraw = False
            GetList
            SetFlexGrid
            mGrid.Redraw = True
            '清除科目期初改变消息
            mclsMainControl.Messages.Remove CStr(vntMessage)
        End If
    Next
    mclsMainControl.Messages.Clear
    gclsSys.CurrFormName = Me.hwnd
    frmMain.mnuEditFilter.Enabled = True
    frmMain.mnuFilePrint.Enabled = True
    frmMain.mnuToolRefresh.Enabled = True
    frmMain.SetToolBar
    
    If mGrid.Rows > 2 Then
       If mGrid.Row < 2 Then
          mGrid.Row = 2
          mGrid.col = 6
       End If
    End If
    
    'mGrid.col = mintCol
End Sub

Private Sub Form_Deactivate()
    frmMain.mnuEditFilter.Enabled = False
    frmMain.mnuToolRefresh.Enabled = False
End Sub


Private Sub Form_Resize()
    RedrawForm
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim intCount As Integer
    
    On Error Resume Next
    With mclsListSet
        For intCount = 1 To .Columns
            .ColumnWidth(intCount) = mGrid.ColWidth(intCount) * Screen.TwipsPerPixelX
        Next
        .SaveList
    End With
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
    Set mclsListSet = Nothing
End Sub

Private Sub mclsMainControl_ChildActive()
    Form_Activate
End Sub

Private Sub mclsMainControl_EditFilter()
    cmdAccountInit_Click 0
End Sub

Private Sub mclsMainControl_FilePrint()
    Dim myPrintclass As PrintClass
    'mclsMainControl_ToolRefresh
    Set myPrintclass = New PrintClass
    myPrintclass.PrintNewList1 gclsBase.BaseDB, mrstData, mGrid.TableHandle, 72, Me.Caption & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    Set myPrintclass = Nothing
End Sub

Private Sub mclsMainControl_FilePrintSetup()
    Dim myPrintclass As PrintClass
    Set myPrintclass = New PrintClass
    myPrintclass.PrintNewSetUp1 gclsBase.BaseDB, mGrid.TableHandle, , , , 72, Me.Caption & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    Set myPrintclass = Nothing
End Sub

'改变科目方向
Private Function ChangeDirect(ByVal AccountID As Long, ByVal Direct As Integer, Optional ChangeBan As Boolean = False)
  Dim strSql As String
    strSql = "Update Account Set intDirection=" & Direct & " Where lngAccountID=" & AccountID
    gclsBase.BaseDB.Execute strSql
End Function

'科目是否有单位等辅助核算
Private Function AccountIsAided(ByVal AccountID As Long) As Boolean
  Dim strSql As String
  Dim rstAccount As rdoResultset
    
    AccountIsAided = False
    strSql = "Select (blnIsCustomer+blnIsDepartment+blnIsEmployee+blnIsClass1+blnIsClass2) As lngAided From Account Where lngAccountID=" & AccountID
    Set rstAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With rstAccount
       If Not .EOF Then
          If !lngAided <> 0 Then
             AccountIsAided = True
          End If
       End If
    End With
End Function

Private Sub msgAccountInit_GotFocus(Index As Integer)
    If mGrid.Rows > 1 Then
        If mintOldRow < mGrid.Rows Then
           mGrid.Row = mintOldRow
        Else
           mGrid.Row = mGrid.Rows - 1
        End If
    End If
End Sub

Private Sub mclsMainControl_ToolRefresh()
    RefreshData
End Sub

Private Sub mGrid_AfterWindowProc(ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long)
    If Message = WM_VSCROLL Then
       SetCellColor mGrid.TopRow, mGrid.BottomRow
    End If
End Sub

Private Sub mGrid_BeforeEdit(ByVal Row As Long, ByVal col As Integer, Cancel As Long)
  Dim BackColor As OLE_COLOR
  
    If mblnClose Then
       Cancel = True
       Exit Sub
    End If
    
    If Trim(mGrid.CellValue(Row, col)) = "-" Or col <= 5 Then
       Cancel = True
       Exit Sub
    End If
    
    mrstData.AbsolutePosition = Row - 1
    If mrstData.rdoColumns(mrstData.rdoColumns.Count - 1) = -1 Then
       Cancel = True
       Exit Sub
    End If
    
    mGrid.GetCellPattern Row, col, -1, BackColor, -1, -1
    If BackColor = RGB(128, 128, 128) Then
       Cancel = True
       Exit Sub
    End If
    
    If mintCol = 6 Or mintCol = 9 Or mintCol = 12 Then
         mGrid.SetCellDataType mlngRow, mintCol, mlngRow, mintCol, 1, 1, mGrid.CellValue(mlngRow, 18), -1
    End If
End Sub

Private Sub picInit_KeyPress(KeyAscii As Integer)
    
    On Error GoTo ErrHandle
    With mGrid
        If .Row > 0 Then
            If Not mblnClose Then
                If Not ((.CellValue(.Row, 19) = "3" Or .CellValue(.Row, 19) = "6") _
                    And .col <= 14 And .CellValue(.Row, .col) <> "-" And .CellValue(.Row, 21) = 0) Then
                    
                    If KeyAscii = vbKeySpace Then
                       picInit_DblClick
                    End If
                End If
            End If
        End If
        
    End With
ErrHandle:
End Sub

Private Sub msgAccountInit_LostFocus(Index As Integer)
    mintOldRow = mlngRow
End Sub

Private Sub mGrid_AfterColChange(ByVal col As Integer)
    mintCol = mGrid.col
End Sub

Private Sub mGrid_AfterRowChange(ByVal Row As Long)
  Dim intFindCol As Integer, intLen As Integer
    
    mlngRow = mGrid.Row
    intFindCol = cboFind.ListIndex + 1
    mblnNotFind = True
    If mGrid.Rows > 1 And mGrid.Row > 0 Then
        intLen = Len(txtFind.Text)
        txtFind.Text = mGrid.CellValue(mGrid.Row, intFindCol)
        txtFind.SelStart = intLen
        If Len(txtFind.Text) - intLen > 0 Then
           txtFind.SelLength = Len(txtFind.Text) - intLen
        End If
    Else
        txtFind.Text = ""
    End If
    mlngLastPosition = mGrid.Row
    mblnNotFind = False
    
End Sub

Private Sub mGrid_BeforeChange(Val As String, Cancel As Long)
  Dim BackColor As OLE_COLOR
  Dim Row As Long, col As Integer
  
    If mblnClose Then
       Cancel = True
       Exit Sub
    End If
    
    Row = mGrid.Row
    col = mGrid.col
    If Trim(mGrid.CellValue(Row, col)) = "-" Or col <= 5 Then
       Cancel = True
       Exit Sub
    End If
    
    mrstData.AbsolutePosition = Row - 1
    If mrstData.rdoColumns(mrstData.rdoColumns.Count - 1) = -1 Then
       Cancel = True
       Exit Sub
    End If
    
    mGrid.GetCellPattern Row, col, -1, BackColor, -1, -1
    If BackColor = RGB(128, 128, 128) Then
       Cancel = True
       Exit Sub
    End If
    If Not InputFinish(Val) Then
       Cancel = True
    End If
End Sub

Private Sub picInit_DblClick()
    Dim intCount As Integer
    Dim strDirect As String
    Dim intCol As Integer, lngRow As Long, strType As String
    
    'mGrid.MouseCell lngRow, intCol
    
    If mGrid.col = 3 Then
        With mGrid
            If mrstData.RowCount = 0 Then
               Exit Sub
            End If
            mlngRow = .Row
            If AccountIsAided(.CellValue(mlngRow, 0)) Then
               strType = "2"
            Else
               strType = .CellValue(.Row, .Cols - 4)
            End If
            If .CellValue(mlngRow, 3) = "借" Then
               .CellFormula(mlngRow, 3) = "贷"
               If strType = "2" Then
                  ChangeDirect CDbl(.CellValue(mlngRow, 0)), -1, True
               Else
                  ChangeDirect CDbl(.CellValue(mlngRow, 0)), -1
               End If
            Else
               .CellFormula(mlngRow, 3) = "借"
               If strType = "2" Then
                  ChangeDirect CDbl(.CellValue(mlngRow, 0)), 1, True
               Else
                  ChangeDirect CDbl(.CellValue(mlngRow, 0)), 1
               End If
            End If
            
            Select Case strType
              Case "4"
                For intCol = 6 To 8
                    mintCol = intCol
                    If IsNumeric(.CellValue(mlngRow, mintCol)) Then
                       If Left(.CellValue(mlngRow, mintCol), 1) = "-" Then
                          .CellFormula(mlngRow, mintCol) = Mid(.CellValue(mlngRow, mintCol), 2)
                       Else
                          .CellFormula(mlngRow, mintCol) = "-" & .CellValue(mlngRow, mintCol)
                       End If
                    End If
                Next intCol
                For intCol = 15 To 17
                    mintCol = intCol
                    If IsNumeric(.CellValue(mlngRow, mintCol)) Then
                       If Left(.CellValue(mlngRow, mintCol), 1) = "-" Then
                          .CellFormula(mlngRow, mintCol) = Mid(.CellValue(mlngRow, mintCol), 2)
                       Else
                          .CellFormula(mlngRow, mintCol) = "-" & .CellValue(mlngRow, mintCol)
                       End If
                    End If