frmitemlistcard.frm

金算盘软件代码

        Select Case Me.ActiveControl.Name
        Case "lstItem"
'            lstItem_Choose Me.ActiveControl.Index
            lstItem_KeyUp Me.ActiveControl.Index, vbKeyReturn, 0
            Exit Sub
        Case "cboInput"
            cboInput_KeyUP vbKeyReturn, 0
            Exit Sub
        Case "msgItem"
            msgItem_KeyUp vbKeyReturn, 0
            Exit Sub
        Case "txtInput"
            txtInput_KeyUp vbKeyReturn, 0
            Exit Sub
        Case "msgUnit"
            msgUnit_KeyPress vbKeyReturn
            Exit Sub
        Case "txtUnit"
            txtUnit_KeyUp vbKeyReturn, 0
            Exit Sub
        End Select
    End If
    Select Case Index
    Case 0
        If SaveCard Then Unload Me
    Case 1
        Unload Me
    Case 2
        If SaveCard Then
'            mlngItemID = 0
            mblnIsNew = True
'            mblnIsChanged = True
            strNextCode = GetNextCode(txtItem(0).Text)
            InitCard 0
            txtItem(0).Text = strNextCode
            SSTab1.Tab = 0
            txtItem(0).SetFocus
            txtItem(0).SelStart = 0
            txtItem(0).SelLength = Len(txtItem(0).Text)
        End If
    Case 3
        mstrNotes = frmNotePad.EditCard("商品劳务", txtItem(0).Text, _
            txtItem(1).Text, mstrNotes)
    Case 4
        frmDefineSetCard.EditCard
        InitCustom
    End Select
End Sub

Private Function CheckUnit() As Boolean
    Dim l As Long, strMess As String
    
    CheckUnit = False
    strMess = ""
    For l = 1 To msgUnit.Rows - 2
        If msgUnit.RowHeight(l) > 0 Then
            If Trim(msgUnit.TextMatrix(l, 3)) = "" Then
                strMess = "计量单位不能为空！"
                msgUnit.Row = l
                msgUnit.col = 3
                Exit For
            End If
            If TxtToDouble(msgUnit.TextMatrix(l, 4)) = 0 Then
                strMess = "换算比例不能为空！"
                msgUnit.Row = l
                msgUnit.col = 4
                Exit For
            End If
        End If
    Next l
    If strMess <> "" Then
        ShowMsg hwnd, strMess, vbExclamation, Caption
    Else
        CheckUnit = True
    End If
End Function
'检查录入 1--正确  -1--编码重复  -2--名称重复
Private Function CodeCheck() As Integer
    Dim recItem As rdoResultset, strSql As String
    
    strSql = "SELECT * FROM Item WHERE (strItemCode='" & txtItem(0).Text _
        & "' Or strItemName='" & txtItem(1).Text & "') AND lngItemID <>" _
        & IIf(mblnIsNew, 0, mlngItemID)
    Set recItem = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    If Not recItem.EOF Then
        If recItem!strItemCode = txtItem(0).Text Then
            CodeCheck = -1
            mlngDItemID = recItem!lngItemID
'        ElseIf recItem!strItemName = txtItem(1).Text Then
'            CodeCheck = -2
        End If
    Else
        CodeCheck = 1
    End If
    recItem.Close
End Function

Private Sub SetForm(ByVal iVer As Integer)
    Dim i As Integer
    
    Select Case iVer
    Case 4
        SSTab1.TabVisible(3) = False
        chkItem(1).Visible = False
        chkItem(1).TabStop = False
        Frame1(2).Visible = False
        lblNote(20).Visible = False
        txtItem(5).Visible = False
        txtItem(5).TabStop = False
        Frame1(0).Width = 6165
        OptItem(0).Left = 990
        OptItem(1).Left = 4620
    Case 16
        Me.Height = 4545
        Me.Width = 7785
        SSTab1.Height = 3945
        SSTab1.Width = 6195
        msgUnit.Height = 3345
        msgUnit.Width = 5955
        SSTab1.TabVisible(2) = False
        SSTab1.TabVisible(3) = False
        cboItem(0).TabStop = False
        cboItem(1).TabStop = False
        msgItem.TabStop = False
        lstItem(1).Width = 1575
        lstItem(1).Left = 4470
        Frame1(3).Visible = False
        Frame1(4).Visible = False
        lblNote(26).top = 990
        txtItem(0).Left = 1290
        txtItem(0).Width = 1755
        txtItem(1).top = 945
        txtItem(1).Left = txtItem(0).Left
        txtItem(1).Width = 4755
        lblNote(24).Left = 3150
        lblNote(1).Left = lblNote(26).Left
        lblNote(1).top = 1485
        txtItem(2).Left = txtItem(1).Left
        txtItem(2).Width = txtItem(1).Width
        txtItem(2).top = 1455
        lblNote(2).top = 2010
        lstItem(0).Left = txtItem(1).Left
        lstItem(0).Width = txtItem(1).Width
        lstItem(0).top = 1950
        lblNote(4).top = 2483
        lstItem(2).top = 2445
        lstItem(2).Left = txtItem(0).Left
        lstItem(2).Width = txtItem(0).Width
        lblNote(6).Caption = "基本计量单位(&U)"
        lblNote(6).Left = lblNote(24).Left
        lblNote(6).top = 2483
        txtItem(4).top = 2445
        txtItem(4).Left = lstItem(1).Left
        txtItem(4).Width = lstItem(1).Width
        lblNote(3).Left = lblNote(0).Left
        lblNote(3).Caption = "主供应商(&G)"
        lblNote(3).top = 3015
        Set lstItem(4).Container = SSTab1
        lstItem(4).Left = txtItem(1).Left
        lstItem(4).Width = txtItem(1).Width
        lstItem(4).top = 2955
        lblNote(23).Caption = "含税采购价(&P)"
        lblNote(23).Left = lblNote(0).Left
        lblNote(23).top = 3480
        Set txtItem(6).Container = SSTab1
        txtItem(6).Left = txtItem(0).Left
        txtItem(6).Width = txtItem(0).Width
        txtItem(6).top = 3450
        lblNote(5).Caption = "含税销售价(&A)"
        lblNote(5).Left = lblNote(24).Left
        lblNote(5).top = 3510
        Set txtItem(7).Container = SSTab1
        txtItem(7).Left = txtItem(4).Left
        txtItem(7).Width = txtItem(4).Width
        txtItem(7).top = 3450
'        lblNote(23).Visible = False
        lstItem(3).Visible = False
        lstItem(3).TabStop = False
'        lblNote(3).Visible = False
        txtItem(3).Visible = False
        txtItem(3).TabStop = False
        Frame1(0).Visible = False
        OptItem(0).Visible = False
        OptItem(0).TabStop = False
        OptItem(1).Visible = False
        OptItem(1).TabStop = False
        Frame1(2).Visible = False
        chkItem(1).Visible = False
        chkItem(1).TabStop = False
        lblNote(20).Visible = False
        txtItem(5).Visible = False
        txtItem(5).TabStop = False
        lblNote(17).Visible = False
        txtItem(8).Visible = False
        txtItem(8).TabStop = False
        Frame1(5).Visible = False
'        lblNote(7).Visible = False
'        lblNote(8).Visible = False
        For i = 13 To 16
            cmdOK(i - 13).Left = 6390
            lblNote(i).Visible = False
            txtItem(i - 4).Visible = False
            txtItem(i - 4).TabStop = False
        Next i
        chkItem(2).top = 3810
        chkItem(2).Left = 6390
        cmdOK(4).Enabled = False
        lblNote(1).TabIndex = txtItem(1).TabIndex + 1
        txtItem(2).TabIndex = lblNote(1).TabIndex + 1
        lblNote(2).TabIndex = txtItem(2).TabIndex + 1
        lstItem(0).TabIndex = lblNote(2).TabIndex + 1
        lblNote(4).TabIndex = lstItem(0).TabIndex + 1
        lstItem(2).TabIndex = lblNote(4).TabIndex + 1
        lblNote(6).TabIndex = lstItem(2).TabIndex + 1
        txtItem(4).TabIndex = lblNote(6).TabIndex + 1
        lblNote(3).TabIndex = txtItem(4).TabIndex + 1
        lstItem(4).TabIndex = lblNote(3).TabIndex + 1
        lblNote(23).TabIndex = lstItem(4).TabIndex + 1
        txtItem(6).TabIndex = lblNote(23).TabIndex + 1
        lblNote(5).TabIndex = txtItem(6).TabIndex + 1
        txtItem(7).TabIndex = lblNote(5).TabIndex + 1
    End Select
End Sub

Private Sub Form_Activate()
    mclsMainControl_ChildActive
    frmMain.mnuEditShowList = True
    gclsSys.CurrFormName = Me.hwnd
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If SSTab1.Tab = 1 Or SSTab1.Tab = 2 Then
        If Shift = 4 Then
            If KeyCode = vbKeyD Then mnuDel_Click
            If KeyCode = vbKeyA Then mnuNew_Click
        End If
    ElseIf SSTab1.Tab = 3 Then
        If Shift = 4 And KeyCode = vbKeyD Then cmdOK(4).Value = True
    End If
End Sub

Private Sub Form_Load()
    Dim recBusiness As rdoResultset, strSql As String
    
    Me.Hide
    Me.Left = -30000
    MsgForm.PleaseWait
    SetHelpID hwnd, 30021
    #If conVersionType = 4 Then
        SetForm 4
    #ElseIf conVersionType = 16 Then
        SetForm 16
    #End If
    frmItemList.IsShowCard(1) = True
    Set mclsGrid = New Grid
    Set mclsGrid.Grid = msgItem
    Set mclsGrid.EditText = txtInput
    Set mclsUnitGrid = New Grid
    Set mclsUnitGrid.Grid = msgUnit
'    Set mclsUnitGrid.EditText = txtUnit
    Set msgUnit.MouseIcon = LoadResPicture(2001, vbResCursor)
    strSql = "SELECT * FROM Business"
    Set recBusiness = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    mbytQuantityDec = recBusiness!bytQuantityDec
    mbytPriceDec = recBusiness!bytPriceDec
    recBusiness.Close
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim intMsgReturn As Integer, strMess As String
    
    If UnloadMode <> vbFormControlMenu Then Exit Sub
    If Trim(txtItem(0).Text & txtItem(1).Text) = "" Then Exit Sub
    If mblnIsChanged Then
        If mblnIsNew Then
            strMess = "您要保存新增的商品"
            If txtItem(0).Text <> "" Then
                strMess = strMess & "“" & txtItem(0).Text & "”"
            End If
            If txtItem(1).Text <> "" Then
                strMess = strMess & "“" & txtItem(1).Text & "”"
            End If
            strMess = strMess & "吗？"
        Else
            strMess = "“" & txtItem(0).Text & "”" & " " _
                & "“" & txtItem(1).Text & "”商品已被修改，是否保存？"
        End If
        intMsgReturn = ShowMsg(hwnd, strMess, vbQuestion + vbYesNoCancel, Caption)
        If intMsgReturn = vbYes Then
            Cancel = Not SaveCard
        ElseIf intMsgReturn = vbCancel Then
            Cancel = True
        End If
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    frmItemList.IsShowCard(1) = False
    Set mclsGrid = Nothing
    Set mclsUnitGrid = Nothing
    mblnIsChanged = False
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
End Sub

Private Sub lstItem_AddNew(Index As Integer)
    Dim lngID As Long, lngItemID As Long
    
    Select Case Index
    Case 0
        lngID = frmItemTypeCard.AddCard(, 1)
    Case 1
        lngID = frmItemNatureCard.AddCard(, 1)
        mstrItemCategory = lstItem(1).TextMatrix(lstItem(1).ReferRow, 3)
        SetPosition
    Case 2
        lngID = frmAreaCard.AddCard(, 1)
    Case 3
        lngID = frmPositionCard.AddCard(, 1)
    Case 4
        lngID = frmCustomerCard.AddCard(, 1)
    Case 5, 6, 7, 8, 9, 10
        lngID = frmDefineCard.AddCard(lblNote(23 + Index).Caption, 1)
    Case 11
        lngItemID = TxtToDouble(msgItem.TextMatrix(msgItem.Row, 5))
        lngID = frmItemUnitCard.AddCard(, 1, lngItemID)
'    Case 12
'        lngItemID = msgItem.TextMatrix(mlngRow, 0)
'        lngID = frmItemUnitCard.AddCard(, 1)
    End Select
    If lngID <> 0 Then mlngOldLst(Index) = lngID
    If Index <> 11 Then
        setlistbox lstItem(Index), Index + 16, mlngOldLst(Index)
    Else
        InitPasteLst lngID
    End If
    mblnIsChanged = True
End Sub

Private Sub lstItem_Change(Index As Integer)
    If ContainErrorChar(lstItem(Index).Text, "`~!@#$%^&*=+'"";:,./?|\") Then
        BKKEY lstItem(Index).hwnd
    Else
        If Index = 11 And mlngRow <> 0 Then
            msgItem.TextMatrix(mlngRow, 3) = lstItem(11).Text
        End If
    End If
End Sub

Private Sub lstItem_Delete(Index As Integer)

    Select Case Index
    Case 0
        If frmItemTypeCard.DelCard(mlngOldLst(0), Me.hwnd) Then mlngOldLst(Index) = 0
    Case 1
        If frmItemNatureCard.DelCard(mlngOldLst(1), Me.hwnd) Then
            mstrItemCategory = ""
            mlngOldLst(Index) = 0
        End If
        SetPosition
    Case 2
        If frmAreaCard.DelCard(mlngOldLst(2), Me.hwnd) Then mlngOldLst(Index) = 0