frminvoiceselect.frm

金算盘软件代码

        Next
        If y > .RowHeight(0) Then
            If (x < .ColWidth(1) And mblnBillCanNotChange = False) Or (x > .ColPos(i) And x < .ColPos(i) + .ColWidth(i)) Then
                If y > .RowPos(.Rows - 1) + .RowHeight(.Rows - 1) Then
                    .MousePointer = flexDefault
                Else
                    .MousePointer = 99
                End If
            Else
                .MousePointer = flexDefault
            End If
        Else
            .MousePointer = flexDefault
        End If
    End With
End Sub

Private Sub GrdCol_Mouseup(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim i As Integer
    Dim j As Long
    Dim lngRowBak As Long
    
    If Button = vbRightButton Then
        Exit Sub
    End If
    If y < GrdCol.RowHeight(0) Then
        GrdCol.Redraw = False
        For i = 0 To GrdCol.Cols - 1
            If x > GrdCol.ColPos(i) And x < GrdCol.ColPos(i) + GrdCol.ColWidth(i) Then
                lngRowBak = GrdCol.RowData(GrdCol.MouseRow)
                GrdCol.Row = 0
                GrdCol.col = i
                If GrdCol.ColAlignment(i) = flexAlignRightCenter Then
                    If InStr(GrdCol.TextMatrix(0, i), "金额") <> 0 Then
                        For j = 1 To GrdCol.Rows - 1
                            GrdCol.TextMatrix(j, i) = C2Dbl(GrdCol.TextMatrix(j, i))
                        Next
                    End If
                    If InStr(GrdCol.TextMatrix(0, i), "↑") <> 0 Then
                        GrdCol.TextMatrix(0, i) = ColName(i) & "↓"
                        
                        GrdCol.Sort = flexSortNumericDescending
                    Else
                        GrdCol.TextMatrix(0, i) = ColName(i) & "↑"
                        
                        GrdCol.Sort = flexSortNumericAscending
                    End If
                    If InStr(GrdCol.TextMatrix(0, i), "金额") <> 0 Then
                        For j = 1 To GrdCol.Rows - 1
                            GrdCol.TextMatrix(j, i) = Format(C2Dbl(GrdCol.TextMatrix(j, i)), strCurrDec)
                        Next
                    End If
                Else
                    If InStr(GrdCol.TextMatrix(0, i), "↑") <> 0 Then
                        GrdCol.TextMatrix(0, i) = ColName(i) & "↓"
                        
                        GrdCol.Sort = flexSortStringNoCaseDescending
                    Else
                        GrdCol.TextMatrix(0, i) = ColName(i) & "↑"
                        
                        GrdCol.Sort = 5
                    End If
                End If
                For j = 1 To GrdCol.Rows - 1
                    If GrdCol.RowData(j) = lngRowBak Then
                        GrdCol.Row = j
                        If Not GrdCol.RowIsVisible(j) Then
                            GrdCol.TopRow = j
                        End If
                        Exit For
                    End If
                Next
            Else
                GrdCol.TextMatrix(0, i) = ColName(i)
            End If
        Next
        GrdCol.Redraw = True
    Else
        If y <= GrdCol.RowPos(GrdCol.Rows - 1) + GrdCol.RowHeight(GrdCol.Rows - 1) Then
            If GrdCol.MouseRow >= GrdCol.FixedRows Then
                Select Case GrdCol.TextMatrix(0, GrdCol.col)
                Case "本次开票数量", "本次开票金额"
                Case "关闭"
                    If GrdCol.TextMatrix(GrdCol.MouseRow, GrdCol.col) = "" Then
                        SetCloseRow GrdCol.MouseRow, True
                    Else
                        SetCloseRow GrdCol.MouseRow, False
                    End If
                Case Else
                    If GrdCol.MouseCol = 1 Then
                        GetLngColNO
                        If GrdCol.TextMatrix(GrdCol.MouseRow, xlngColNo(11)) = "" Then
                            If GrdCol.TextMatrix(GrdCol.MouseRow, 1) = "" Then
                                SetSelectRow GrdCol.MouseRow, True
                            Else
                                SetSelectRow GrdCol.MouseRow, False
                            End If
                        Else
                            If GrdCol.TextMatrix(GrdCol.MouseRow, 1) <> "" Then
                                SetSelectRow GrdCol.MouseRow, False
                            End If
                        End If
                    End If
                End Select
            End If
        End If
    End If
End Sub

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='" & Left(Me.Name, 14) & CStr(lngReceiptTypeID) & "列宽'"
    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
        GrdCol.ColWidth(i) = IIf(InStr(GrdCol.TextMatrix(0, i), "日期") <> 0, 11, StrLen(GrdCol.TextMatrix(0, i)) + 1) * Me.TextWidth("A")
    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='" & Left(Me.Name, 14) & CStr(lngReceiptTypeID) & "列宽'"
    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 = Left(Me.Name, 14) & CStr(lngReceiptTypeID) & "列宽"
            !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)
    Dim i As Long
    
    If Me.MousePointer = vbHourglass Then Exit Sub
    Select Case index
    Case 0
        Me.MousePointer = vbHourglass
        GetLngColNO
        For i = 1 To GrdCol.Rows - 1
            If C2Dbl(GrdCol.TextMatrix(i, xlngColNo(9))) = 0 And C2Dbl(GrdCol.TextMatrix(i, xlngColNo(10))) = 0 Then
                GrdCol.TextMatrix(i, 1) = ""
            End If
        Next
        blnCancelOK = False
        If curInput.Visible = True Then
            GrdCol.col = xlngColNo(2)
        End If
        If blnCancelOK Then
            Me.MousePointer = vbDefault
            Exit Sub
        End If
        If mblnBillCanNotChange Then
            SetRowClose
        Else
            If cmdOK_Click() = False Then
                Me.MousePointer = vbDefault
                Exit Sub
            End If
            frmName.WriteTotalRow
            blnSucceed = True
        End If
        Me.MousePointer = vbDefault
        Unload Me
    Case 1
        blnSucceed = False
        Unload Me
    Case 2
        GetLngColNO
        For i = 1 To GrdCol.Rows - 1
            If GrdCol.TextMatrix(i, xlngColNo(11)) = "" Then
                SetSelectRow i, True
            End If
        Next
    Case 3
        For i = 1 To GrdCol.Rows - 1
            If GrdCol.TextMatrix(i, 1) <> "" Then
                SetSelectRow i, False
            End If
        Next
    End Select
End Sub

Private Function cmdOK_Click() As Boolean
    Dim i As Long
    Dim j As Long
    
    blnSucceed = False
    '清除
    With frmName
        If .GrdCol.Rows > 1 Then
            If ChangeSelected() = True Then
                gclsBase.BaseWorkSpace.BeginTrans
                If OldBillClearSelect(False, False) = False Then
                    gclsBase.BaseWorkSpace.RollBacktrans
                    Exit Function
                End If
                If UBound(ObtendData) <> 0 Then
                    If WriteObtendToBase() = False Then
                        gclsBase.BaseWorkSpace.RollBacktrans
                        cMsgBox "更新开票信息失败，不能存盘！", "保存单据"
                        Exit Function
                    End If
                    frmName.TextOfGrid(mlngRowNO, 47) = "True"
                Else
                    frmName.TextOfGrid(mlngRowNO, 47) = "False"
                End If
                SetRowClose
                gclsBase.BaseWorkSpace.CommitTrans
                cmdOK_Click = True
                Exit Function
            End If
            Exit Function
        End If
        For i = 1 To GrdCol.Rows - 1
            If GrdCol.TextMatrix(i, 1) <> "" Then
                Exit For
            End If
        Next
        If i = GrdCol.Rows Then
            .FormRefresh False
            .GrdCol.Redraw = False
    
            For i = .GrdCol.Rows - 1 To 1 Step -1
                If UCase(.TextOfGrid(i, 47)) = "TRUE" Or C2lng(.TextOfGrid(i, 28)) = 0 Then
                    .blnDeleteARow i
                End If
            Next
            .GrdCol.Redraw = True
            .FormRefresh True
    
            If .getID = 0 Then
                If SetRowClose Then
                    blnSucceed = True
                    cmdOK_Click = True
                End If
                Exit Function
            Else
                If OldBillClearSelect(False, True) = True Then
                    If SetRowClose Then
                        blnSucceed = True
                        cmdOK_Click = True
                    End If
                End If
                Exit Function
            End If
        End If
        
        .FormRefresh False
        .GrdCol.Redraw = False
    
        gclsBase.BaseWorkSpace.BeginTrans
        If .getID <> 0 Then
            If OldBillClearSelect(False, False) = False Then
                gclsBase.BaseWorkSpace.RollBacktrans