frmaccountinit.frm

金算盘软件代码

                Next intCol
                mlngRow = mlngRow + 1
                Do While Trim(.CellValue(mlngRow, 1)) = ""
                    For intCol = 6 To 8
                        'mblnIsInput = True
                        mintCol = intCol
                        
                        If IsNumeric(.CellValue(mlngRow, mintCol)) Then
                           InputFinish -CDbl(.CellValue(mlngRow, mintCol)), False
                           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
                    mlngRow = mlngRow + 1
                Loop
              Case "1", "2"
                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
                Next intCol
                If strType = "2" Then
                    mlngRow = mlngRow + 1
                    Do While Trim(.CellValue(mlngRow, 1)) = ""
                        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
                        Next intCol
                        mlngRow = mlngRow + 1
                    Loop
                End If
              Case Else
                For intCol = 6 To 8
                    'mblnIsInput = True
                    mintCol = intCol
                    
                    If IsNumeric(.CellValue(mlngRow, mintCol)) Then
                       InputFinish -CDbl(.CellValue(mlngRow, mintCol)), False
                       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
            End Select
            'mblnIsInput = False
        End With
        Exit Sub
    End If
    
    With mGrid
        If .Rows < 2 Then Exit Sub
        If (.CellValue(.Row, .Cols - 4) = "2" Or .CellValue(.Row, .Cols - 4) = "5") Then
            If Trim(.CellValue(.Row, 3)) = "" Then
                intCount = 0
                Do
                    intCount = intCount + 1
                Loop Until Trim(.CellValue(.Row - intCount, 3)) <> ""
                strDirect = .CellValue(.Row - intCount, 3)
            Else
                strDirect = .CellValue(.Row, 3)
            End If
            Me.MousePointer = vbHourglass
            
            mlngRow = .Row
            mintCol = .col
            If Not IsNull(.CellValue(.Row, .Cols - 1)) Then
                frmAccountInitDetail.ShowDetail mintYear, mbytPeriod, strDirect, mstrDate, mstrQuantityDec, mstrDec, _
                    .CellValue(.Row, 0), IIf(Trim(.CellValue(.Row, .Cols - 1)) = "", 1, .CellValue(.Row, .Cols - 1)), mblnClose
            End If
            Me.MousePointer = vbDefault
            Me.SetFocus
        End If
    End With
End Sub

Private Sub txtFind_Change()
    FindText txtFind.Text
End Sub

Private Sub txtFind_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim intSelLen As Integer
    
    If KeyCode = 8 Then
        If txtFind.SelStart > 0 Then
            intSelLen = txtFind.SelLength
            txtFind.SelStart = txtFind.SelStart - 1
            txtFind.SelLength = intSelLen + 1
        End If
    End If
End Sub

'表格颜色设置
Private Sub SetCellColor(ByVal BeginRow As Long, ByVal EndRow As Long)
  Dim lngRow As Long, intCol As Integer
  Dim blnMutiCurr As Boolean
    
    With mGrid
        For lngRow = BeginRow To EndRow
            If mbytPeriod > 1 Then
                For intCol = .Cols - 8 To .Cols - 6
                    .SetCellForeColor lngRow, intCol, lngRow, intCol, RGB(255, 255, 255)
                    .SetCellPattern lngRow, intCol, lngRow, intCol, 0, RGB(128, 128, 128), -1, -1
                Next intCol
            End If
            If .CellValue(lngRow, .Cols - 4) = "2" Or .CellValue(lngRow, .Cols - 4) = "4" Or .CellValue(lngRow, .Cols - 4) = "5" Then
                If mbytPeriod = 1 Then
                    For intCol = 1 To .Cols - 9
                        .SetCellPattern lngRow, intCol, lngRow, intCol, 0, RGB(255, 255, 226), -1, -1
                    Next
                Else
                    For intCol = 1 To .Cols - 9
                        .SetCellPattern lngRow, intCol, lngRow, intCol, 0, RGB(255, 255, 226), -1, -1
                    Next
                End If
                .RowControl(lngRow) = 0
            End If
            If .CellValue(lngRow, .Cols - 4) = "1" Then
                If mbytPeriod = 1 Then
                    For intCol = 1 To .Cols - 9
                        .SetCellPattern lngRow, intCol, lngRow, intCol, 0, RGB(128, 255, 255), -1, -1
                    Next
                Else
                    For intCol = 1 To .Cols - 9
                        .SetCellPattern lngRow, intCol, lngRow, intCol, 0, RGB(128, 255, 255), -1, -1
                    Next
                End If
                .RowControl(lngRow) = 0
            End If
            If .CellValue(lngRow, .Cols - 4) = "5" Or .CellValue(lngRow, .Cols - 4) = "6" Then
                If blnMutiCurr Then
                    .CellFormula(lngRow, 2) = ""
                    .CellFormula(lngRow, 3) = ""
                    .CellFormula(lngRow, 1) = ""
                End If
            Else
                If .CellValue(lngRow, .Cols - 4) = "4" Then
                    blnMutiCurr = True
                Else
                    blnMutiCurr = False
                End If
            End If
        Next lngRow
    End With
End Sub

Public Function ShowAcntInit()
   If Me.Visible Then
        Me.ZOrder
   Else
        mblnLoad = False
        MsgForm.PleaseWait
        InitcboFind
        mintOldRow = 1
        mstrWhere = ""
        
        Set mGrid = New WINCTRLLib.DBGridCtrl
        mGrid.hwnd = picInit.hwnd
        mGrid.EnterDirection = 4
        
        Me.HelpContextID = 30003
        Utility.SetHelpID 30003
        Set mclsListSet = New ListSet
        mclsListSet.ViewId = lngViewId
        mstrWhere = mclsListSet.WhereOfSql
        Set mclsMainControl = gclsSys.MainControls.Add(Me)
        
        RefreshData
        mblnLoad = True
        Me.Show
   End If
End Function

Private Sub RefreshData()
    If Not MsgForm.Visible Then
       MsgForm.PleaseWait
    End If
    GetYearPeriod
    GetList
    SetFlexGrid
    If mblnClose Then
        chkAccountInit.Caption = "已结帐标志"
        chkAccountInit.Value = 1
        chkAccountInit.Enabled = False
    End If
    Unload MsgForm
End Sub

Private Function FindText(ByVal strFind As String, Optional FromNow As Boolean = False)
  Dim lngBegin As Long, lngEnd As Long, lngFindRow As Long, lngPrev As Long
  Dim intFindCol As Integer
  Dim strCell As String
  Dim blnFound As Boolean
  Dim lngStopRow As Long, lngCount As Long
  
    If strFind = "" Or mblnNotFind Then
       Exit Function
    End If
    
    intFindCol = cboFind.ListIndex + 1
    If intFindCol = 1 Then
        If FromNow Then
          lngBegin = mlngLastPosition + 1
        Else
          lngBegin = 1
        End If
        lngStopRow = lngBegin
        lngEnd = mrstData.RowCount
    Else
        If FromNow Then
          lngBegin = mlngLastPosition + 1
        Else
          lngBegin = 2
        End If
        lngEnd = mGrid.Rows - 1
    End If
    
    If intFindCol = 1 Then
        With mrstData
            Do While lngEnd - lngBegin >= 0
                .AbsolutePosition = lngBegin + (lngEnd - lngBegin) \ 2
                
                If InStr(.rdoColumns(intFindCol).Value, strFind) = 1 Then
                   lngFindRow = lngBegin + (lngEnd - lngBegin) \ 2
                   If lngFindRow < 10 And lngFindRow > lngStopRow Then
                        lngPrev = lngBegin + (lngEnd - lngBegin) \ 2 - 1
                        If lngPrev >= 0 Then
                            .AbsolutePosition = lngPrev
                            Do While lngPrev >= lngStopRow - 1 And Not .BOF
                               If InStr(.rdoColumns(intFindCol).Value, strFind) <> 1 Then
                                 Exit Do
                               Else
                                 lngFindRow = lngPrev
                                 lngPrev = lngPrev - 1
                                 If Not .EOF Then
                                    .MovePrevious
                                 End If
                               End If
                            Loop
                        End If
                        blnFound = True
                        lngBegin = lngPrev
                        Exit Do
                   End If
                   blnFound = True
                End If
                
                If .rdoColumns(intFindCol).Value >= strFind Then
                     If lngEnd - lngBegin > 1 Then
                        lngEnd = lngBegin + (lngEnd - lngBegin) \ 2
                     Else
                        lngEnd = lngEnd