Option Explicit
Option Base 1
Dim cr As New CRAServer
Dim Shex(1 To 20) As ShoppingEx
Dim iShexCount As Integer

Private Function AddShex() As Integer
    'On Error GoTo ADDSHEX_ERR
    If iShexCount < 20 Then
        iShexCount = iShexCount + 1
        Set Shex(iShexCount) = cr.CreateShoppingEx
        cmdRemove.Enabled = True
        cmdClear.Enabled = True
        If cmdConnect.Enabled = False Then cmdMakeCheck.Enabled = True
        If iShexCount = 20 Then cmdAdd.Enabled = False
    End If
    AddShex = iShexCount
    lblChosen = iShexCount
    
End Function

Private Function DelShex() As Integer
    If iShexCount > 0 Then
        Set Shex(iShexCount) = Nothing
        iShexCount = iShexCount - 1
        cmdAdd.Enabled = True
        If iShexCount = 0 Then
            cmdRemove.Enabled = False
            cmdClear.Enabled = False
            If cmdConnect.Enabled = False Then cmdMakeCheck.Enabled = False
        End If
    End If
    DelShex = iShexCount
    lblChosen = iShexCount
End Function

Private Sub cmdAdd_Click()
    On Error GoTo ADD_ERR
    Dim iInsIndex As Integer
    iInsIndex = AddShex
    'Наименование
    Shex(iInsIndex).Name = lblName
    'ШК
    Shex(iInsIndex).Barcode = lblBarcode
    'Цена
    Shex(iInsIndex).Price = lblPrice
    'Количество
    Shex(iInsIndex).Quantity = txtQuantity
    'Отдел
    Shex(iInsIndex).Section = lblSection
    'Тип
    Select Case lblType
        Case "весовой"
            Shex(iInsIndex).Type = CRAUTO_GB_WEIGHT
        Case "услуга"
            Shex(iInsIndex).Type = CRAUTO_GB_SERVICE
        Case Else
            Shex(iInsIndex).Type = CRAUTO_GB_COUNT
    End Select
    'Налог
    If optNoTax.Value = True Then Shex(iInsIndex).Tax = 0
    If optTax1.Value = True Then Shex(iInsIndex).Tax = 1
    If optTax2.Value = True Then Shex(iInsIndex).Tax = 2
    If optTax3.Value = True Then Shex(iInsIndex).Tax = 3
    'Наценка
    Shex(iInsIndex).Raise = txtRaise
    'Скидка
    Shex(iInsIndex).Discount = txtDiscount
    
    
    Exit Sub
ADD_ERR:
    MsgBox Err.Description
    DelShex
End Sub

Private Sub cmdClear_Click()
    Dim I As Integer
    For I = LBound(Shex) To iShexCount Step 1
        Set Shex(I) = Nothing
    Next I
    iShexCount = 0
    lblChosen = iShexCount
    cmdClear.Enabled = False
    cmdRemove.Enabled = False
    cmdAdd.Enabled = True
    If cmdConnect.Enabled = False Then cmdMakeCheck.Enabled = False
End Sub

Private Sub cmdConnect_Click()
    On Error GoTo CONNECT_ERR
    MousePointer = vbHourglass
    'Подключаемся
    If optCOM1 = True Then cr.CRInit txtCRNumber, 1 _
    Else cr.CRInit txtCRNumber, 2
    cmdConnect.Enabled = False
    frmAttr.Enabled = True
    If iShexCount <> 0 Then cmdMakeCheck.Enabled = True
    'Налоги
    optTax1.Caption = cr.Names.TaxNames(1)
    optTax2.Caption = cr.Names.TaxNames(2)
    optTax3.Caption = cr.Names.TaxNames(3)
    lblTax1Val = cr.Values.TaxVals(1)
    lblTax2Val = cr.Values.TaxVals(2)
    lblTax3Val = cr.Values.TaxVals(3)
    If cr.Configuration.Tax = True Then frmTax.Enabled = True
    MousePointer = vbDefault
    
    Exit Sub
CONNECT_ERR:
    If (MsgBox(Err.Description, vbCritical + vbRetryCancel)) = vbRetry Then Resume
    MousePointer = vbDefault
End Sub

Private Sub cmdFlushAttr_Click()
    txtQuantity = 1
    txtRaise = 0
    txtDiscount = 0
    optNoTax = True
End Sub

Private Sub cmdMakeCheck_Click()
    On Error GoTo MAKECHECK_ERR
    MousePointer = vbHourglass
    cr.MakeCheckEx (Shex)
    MousePointer = vbDefault
    
    Exit Sub
MAKECHECK_ERR:
    If (MsgBox(Err.Description, vbCritical + vbRetryCancel)) = vbRetry Then Resume
    MousePointer = vbDefault
End Sub

Private Sub cmdRemove_Click()
    DelShex
End Sub

Private Sub Form_Load()
    On Error GoTo Form_LoadError
   
    datGoods.DatabaseName = "Citrus.mdb"
    datGoods.RecordsetType = vbRSTypeTable
    datGoods.RecordSource = "PGT Goods List"
    datGoods.Refresh
    
    lblName.DataField = "Наименование"
    lblSection.DataField = "Отдел"
    lblBarcode.DataField = "Штрих-код"
    lblPrice.DataField = "Цена"
    lblType.DataField = "Тип"
    
    Exit Sub
Form_LoadError:
    'База Citrus.mdb не найдена
    If Err = 3024 Then
        With dlgDialog
            .DialogTitle = "Can't Find Citrus.mdb"
            .Filter = "(*.MDB)|*.mdb"
            .ShowOpen
        End With
        
        If dlgDialog.FileName <> "" Then
            Resume
        Else
            Unload Me
        End If
    ElseIf Err <> 0 Then ' another error
        MsgBox "Unexpected Error: " & Err.Description
        End
    End If
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    cr.CRDestroy
End Sub