frmitemdisclistcard.frm

金算盘软件代码

    For i = 1 To msgGrid2.Rows - 1
        msgGrid2.TextMatrix(i, 2) = IIf(blnIsSel, "√", "")
    Next i
End Sub

Private Sub AdjustOrder(ByVal blnIsUp As Boolean)
    If blnIsUp Then
        If mlngOrderRow > 1 Then
            ExchangeRow mlngOrderRow, mlngOrderRow - 1
            mlngOrderRow = mlngOrderRow - 1
        End If
    Else
        If mlngOrderRow < 4 Then
            ExchangeRow mlngOrderRow, mlngOrderRow + 1
            mlngOrderRow = mlngOrderRow + 1
        End If
    End If
    mblnOrderIsChanged = True
    msgGrid3.Row = mlngOrderRow
    msgGrid3.ColSel = 2
    SetButton
End Sub

Private Sub ExchangeRow(ByVal iRow1 As Long, iRow As Long)
    Dim strName As String, strStart As String
    
    strName = msgGrid3.TextMatrix(iRow1, 1)
    strStart = msgGrid3.TextMatrix(iRow1, 2)
    msgGrid3.TextMatrix(iRow1, 1) = msgGrid3.TextMatrix(iRow, 1)
    msgGrid3.TextMatrix(iRow1, 2) = msgGrid3.TextMatrix(iRow, 2)
    msgGrid3.TextMatrix(iRow, 1) = strName
    msgGrid3.TextMatrix(iRow, 2) = strStart
End Sub

Private Function DateIsValid(ByVal iRow As Long, Optional strDate1 As String, Optional ByVal iRow2 As Long) As Boolean
    Dim strDate As String, strStartDate As String, strEndDate As String
    Dim recSale As rdoResultset, strSql As String
    
    If iRow > 0 Then
        strDate = msgGrid0.TextMatrix(iRow2, 2)
        strStartDate = msgGrid0.TextMatrix(iRow, 2)
        strEndDate = msgGrid0.TextMatrix(iRow, 3)
        DateIsValid = Not (strDate >= strStartDate And strDate <= strEndDate)
        If DateIsValid Then
            strDate = msgGrid0.TextMatrix(iRow2, 3)
            strStartDate = msgGrid0.TextMatrix(iRow, 2)
            strEndDate = msgGrid0.TextMatrix(iRow, 3)
            DateIsValid = Not (strDate >= strStartDate And strDate <= strEndDate)
        End If
    Else
        strSql = "SELECT * FROM ItemSaleDisc WHERE strStartDate<='" & strDate _
            & "' AND strEndDate>='" & strDate1 & "' AND lngItemSaleDiscID<>" _
            & mlngLstID(1)
        Set recSale = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        DateIsValid = recSale.EOF
        recSale.Close
    End If
End Function

Private Sub AddPayDiscDate()
    Dim i As Integer
    
    With msgGrid0
        For i = 1 To .Rows - 1
            If .RowHeight(i) > 0 Then
                If .TextMatrix(i, 2) = "" Or .TextMatrix(i, 3) = "" Then Exit For
            End If
        Next i
        If i < .Rows Then
            .Row = i
            If .TextMatrix(i, 2) = "" Then
                .col = 2
            Else
                Do While i > 0
                    If .RowHeight(i) > 0 Then
                        .TextMatrix(i, 3) = DateAdd("d", 1, CDate(Trim$(.TextMatrix(i, 2))))
                        Exit Do
                    End If
                    i = i - 1
                Loop
                .col = 3
            End If
        Else
            .Rows = .Rows + 1
            .Row = .Rows - 1
            If .Row = 1 Then
                .TextMatrix(.Row, 2) = Format(gclsBase.BaseDate, "yyyy-mm-dd")
            ElseIf .TextMatrix(.Row - 1, 3) <> "" Then
                For i = .Row - 1 To 1 Step -1
                    If .RowHeight(i) > 0 Then Exit For
                Next i
                If IsDate(.TextMatrix(i, 3)) Then
                    .TextMatrix(.Row, 2) = DateAdd("d", 1, CDate(.TextMatrix(i, 3)))
                End If
            End If
            .TextMatrix(.Row, 4) = "100.00"
            .col = 2
        End If
        Paste
    End With
End Sub

Private Sub DelPayDiscDate()
    With msgGrid0
        If .Row = 0 Then Exit Sub
        If ShowMsg(hWnd, "确实要删除从" & .TextMatrix(.Row, 2) & "到" & .TextMatrix(.Row, 3) _
            & "之间的贴息折扣吗?", vbQuestion + vbYesNo + vbDefaultButton2, Caption) = vbYes Then
            .TextMatrix(.Row, 1) = "-5"
            .RowHeight(.Row) = 0
            dteInput.Left = -50000
            mblnPayIsChanged = True
        End If
    End With
End Sub

Private Sub CalcRate()
    Dim i As Long, strMode As String
    
    With msgGrid2
        For i = 1 To .Rows - 1
            If .TextMatrix(i, 2) = "√" Then
                If Right(txtDisc(1).Text, 1) = "%" Then
                    If Left(txtDisc(1).Text, 1) = "-" Then
                        .TextMatrix(i, 6) = Txt2Num(.TextMatrix(i, 6)) - Txt2Num(.TextMatrix(i, 6)) * Txt2Num(txtDisc(1).Text) / 100
                    Else
                        .TextMatrix(i, 6) = Txt2Num(.TextMatrix(i, 6)) + Txt2Num(.TextMatrix(i, 6)) * Txt2Num(txtDisc(1).Text) / 100
                    End If
                Else
                    If Left(txtDisc(1).Text, 1) = "-" Then
                        .TextMatrix(i, 6) = IIf((Txt2Num(.TextMatrix(i, 6)) - Txt2Num(txtDisc(1).Text)) > 0, Txt2Num(.TextMatrix(i, 6)) - Txt2Num(txtDisc(1).Text), "100")
                    Else
                        .TextMatrix(i, 6) = Txt2Num(.TextMatrix(i, 6)) + Txt2Num(txtDisc(1).Text)
                    End If
                End If
                If C2Dbl(.TextMatrix(i, 6)) > 100 Then
                    .TextMatrix(i, 6) = "100.00"
                ElseIf C2Dbl(.TextMatrix(i, 6)) <= 0 Then
                    .TextMatrix(i, 6) = "0.01"
                End If
                If .TextMatrix(i, 6) <> "" Then
                    .TextMatrix(i, 6) = FormatShow(.TextMatrix(i, 6), 2)
                End If
'                .TextMatrix(i, 1) = "3"
                mblnSaleIsChanged = True
            End If
        Next i
    End With
End Sub

Private Sub ClearItem(ByVal index As Integer)
    Dim i As Integer, strSql As String
    
    If index = 1 Then
        strSql = "DELETE FROM ItemPayDiscDetail WHERE lngItemPayDiscID=" & mlngLstID(0)
    Else
        strSql = "DELETE FROM ItemSaleDiscDetail WHERE lngItemSaleDiscID=" & mlngLstID(1)
    End If
    gclsBase.ExecSQL strSql
    
    If index = 1 Then
        msgGrid1.Rows = 2
        For i = 0 To msgGrid1.Cols - 1
            msgGrid1.TextMatrix(1, i) = ""
        Next i
        msgGrid1.RowHeight(1) = 0
    Else
        msgGrid2.Rows = 2
        For i = 0 To msgGrid2.Cols - 1
            msgGrid2.TextMatrix(1, i) = ""
        Next i
        msgGrid2.RowHeight(1) = 0
    End If
End Sub

Private Function Txt2Num(ByVal strValue As String) As Single

    On Error GoTo ErrHandle
    If Right(strValue, 1) = "%" Then strValue = Left(strValue, Len(strValue) - 1)
    Txt2Num = Abs(CSng(strValue))
    Exit Function
ErrHandle:
    Txt2Num = 0
End Function

Private Sub cmdOK_Click(index As Integer)
    Select Case index
    Case 0: AddPayDiscDate
    Case 1: DelPayDiscDate
    Case 2: SelPayDiscItem
    Case 3:
        If msgGrid1.Rows > 1 Then
            If ShowMsg(hWnd, "您确实要清除该组贴息折扣的商品吗?", _
                vbQuestion + vbYesNo + vbDefaultButton2, Caption) = vbYes Then
                ClearItem 1
                mblnPayIsChanged = True
            End If
        End If
    Case 4: SelSaleDiscItem
    Case 5:
        If msgGrid2.Rows > 1 Then
            If ShowMsg(hWnd, "您确实要清除该组促销折扣的商品吗?", _
                vbQuestion + vbYesNo + vbDefaultButton2, Caption) = vbYes Then
                ClearItem 2
                mblnSaleIsChanged = True
            End If
        End If
    Case 6: AllSelect True
    Case 7:
        ConSelSaleDisc
        Me.Refresh
    Case 8: AllSelect False
    Case 9: CalcRate
    Case 10: AdjustOrder True
    Case 11: AdjustOrder False
    End Select
End Sub

Private Sub dteDisc_Change(index As Integer)
    If Not mblnIsInit Then mblnSaleIsChanged = True
End Sub

Private Sub dteDisc_KeyUp(index As Integer, KeyCode As Integer, Shift As Integer, bCancel As Long)
    If KeyCode = vbKeySpace Then
        dteDisc(index).DropDownPanel
    End If
End Sub

Private Sub dteDisc_LostFocus(index As Integer)
    If Not DateIsValid(-5, dteDisc(index).Text) Then
        ShowMsg hWnd, "日期无效.", vbExclamation, Caption
        dteDisc(index).SetFocus
    End If
End Sub

Private Sub dteInput_Change()
    If dteInput.Text <> "" Then
        msgGrid0.TextMatrix(msgGrid0.Row, msgGrid0.col) = Format(dteInput.Text, "yyyy-mm-dd")
        mblnPayIsChanged = True
    End If
End Sub

Private Sub dteInput_GotFocus()
    mlngPayRow = msgGrid0.Row
    mlngPayCol = msgGrid0.col
End Sub

Private Sub dteInput_KeyUp(KeyCode As Integer, Shift As Integer, bCancel As Long)
    If KeyCode = vbKeySpace Then
        dteInput.DropDownPanel
    ElseIf KeyCode = vbKeyReturn Then
        msgGrid0.SetFocus
    End If
End Sub

Private Sub dteInput_LostFocus()
    Dim i As Integer
    Dim strStartDate As String, strEndDate As String
    
    If mlngPayRow = 0 Then
        dteInput.Left = -50000
        Exit Sub
    End If
    strStartDate = msgGrid0.TextMatrix(mlngPayRow, 2)
    strEndDate = msgGrid0.TextMatrix(mlngPayRow, 3)
    If msgGrid0.Row <> mlngPayRow Then
        If strStartDate > strEndDate Then
            ShowMsg hWnd, "启用日期不能大于结束日期!", vbExclamation, Caption
            msgGrid0.Row = mlngPayRow
            msgGrid0.col = mlngPayCol
            BKKEY msgGrid0.hWnd
            Exit Sub
        End If
    End If
'    For i = 1 To msgGrid0.Rows - 1
'        If msgGrid0.RowHeight(i) > 0 And i <> mlngPayRow Then
'            If Not DateIsValid(i) Then
'                ShowMsg hwnd, "日期无效!", vbExclamation, Caption
'                msgGrid0.Row = mlngPayRow
'                msgGrid0.col = mlngPayCol
'                BKKEY msgGrid0.hwnd
'                Exit Sub
'            End If
'        End If
'    Next i
    dteInput.Left = -50000
End Sub

Private Sub Form_Activate()
    Static blnX As Boolean
    
    If Not blnX Then
        SetHelpID Me.HelpContextID
        InitPayPage
        setlistbox lstDisc(1), 32, mlngLstID(1)
        If lstDisc(1).Referrows > 3 Then
            lstDisc(1).ReferRow = 4
        End If
        InitSalePage lstDisc(1).ReferRow
        mstrDiscName(0) = lstDisc(0).Text
        mstrDiscName(1) = lstDisc(1).Text
        InitOrderPage
        SetTabIndex
        mblnIsInit = False
        blnX = True
    End If
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim i As Integer
    
    mblnIsRefer = False
    If KeyCode = vbKeyEscape Or KeyCode = vbKeyReturn Then
        For i = 0 To 1
            If lstDisc(i).ReferVisible Then mblnIsRefer = True
        Next i
    End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        If Not mblnIsRefer Then
            Select Case Me.ActiveControl.Name
            Case "txtInput", "msgGrid0", "msgGrid1", "dteInput"
            Case "txtSale", "msgGrid2", "msgGrid3" ', "lstDisc"
            Case Else
                BKKEY Me.ActiveControl.hWnd, vbKeyTab
            End Select
        End If
    ElseIf KeyAscii = vbKeyEscape Then
        If Not mblnIsRefer Then
            mblnCancel = True
            Unload Me
        End If
    End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn And Shift = 2 Then
        Unload Me
    End If
End Sub

Private Sub Form_Load()
    Dim edtErrReturn As ErrDealType
    
    On Error GoTo ErrHandle
    Set mclsGrid0 = New Grid
    Set mclsGrid0.Grid = msgGrid0
    Set mclsGrid0.EditText = txtInput
    Set mclsGrid1 = New Grid
    Set mclsGrid1.Grid = msgGrid1
    Set mclsGrid2 = New Grid
    Set mclsGrid2.Grid = msgGrid2
'    Set mclsGrid2.EditText = txtSale
    Set msgGrid2.MouseIcon = GetFormResPicture(2001, vbResCursor)
    Set msgGrid3.MouseIcon = GetFormResPicture(2001, vbResCursor)
    Utility.LoadFormResPicture Me
    mblnCancel = False
    mlngLstID(0) = 0
    mlngLstID(1) = 0
    mblnPayIsChanged = False