frmmattype.frm

一套简易的MIS系统。带SQLServer数据库。供参考。

Private Sub cmdOK_Click()
    
    Dim iIndex                      As Integer
    On Error GoTo ErrInfo
    
    For iIndex = 0 To 2
        If txtMat(iIndex).Text = "" Then
            MsgBox "错误的信息！", vbInformation, "提示："
            txtMat(iIndex).SetFocus
            SendKeys "{Home}+{End}"
            Exit Sub
        End If
    Next
    
    With uShareInfo
        .strCode = txtMat(0).Text
        .strName = txtMat(1).Text
        .strShare1 = txtMat(2).Text
        .strShare = txtMat(3).Text
        .dInDate = Format(inDate.Value, "YYYY-MM-DD")
        .intFlag = tString(cmbState.Text, "[", "]", 0)
    End With
    
    If tMatType(uShareInfo, iAdd_Update) = False Then
        MsgBox "数据处理失败！", vbInformation, "提示："
        Exit Sub
    End If
    iAdd_Update = 0
    MsgBox "数据处理成功完成！", vbInformation, "提示："
    For iIndex = 0 To txtMat.Count - 1
        txtMat(iIndex).Text = ""
    Next
    If txtMat(0).Locked = True Then txtMat(0).Locked = False
    '初始化
    getMatHead
    getMatData ""
    txtMat(0).SetFocus
    SendKeys "{Home}+{End}"
    Exit Sub
ErrInfo:
    MsgBox Err.Description, vbInformation, "提示："
    
End Sub

Private Sub cmdQuery_Click()
    
    getMatData Trim(txtMat(0).Text)
    
End Sub

Private Sub cmdUpdate_Click()
    
    Call cmdOK_Click
    
End Sub

Private Sub Form_Load()

    '计算窗体显示位置
    tFormSpace frmMain, Me, uWindows
    '初始化
    getMatHead
    getMatData ""
    inDate.Value = Format(tServerDate, "YYYY年MM月DD日")
    
    With cmbState
        .Clear
        .AddItem "正常[0]"
        .AddItem "作废[1]"
        .Text = .List(0)
    End With

End Sub


'显示表头
Private Sub getMatHead()
    
    With lstMatInfo
        .ListItems.Clear
        .FullRowSelect = True
        .GridLines = True
        .View = lvwReport
        .LabelEdit = lvwManual
        With .ColumnHeaders
            .Clear
            .Add , , "@", 0
            .Add , , "商品编码", 1400
            .Add , , "商品名称", 2100
            .Add , , "规格", 1400
            .Add , , "单位", 1400
            .Add , , "录入日期", 1600
            .Add , , "状态", 1400
        End With
    End With
    
End Sub

'显示数据
Private Function getMatData(strInfo As String)
    
    Dim rsTemp                 As New ADODB.Recordset
    Dim strSQL                 As String
    Dim iIndex                 As Integer
    strSQL = " Where Goods_id Like '" & strInfo & "%' or Goods_name Like '" & strInfo & "%' Or Goods_unit Like '" & strInfo & "%' Or Goods_spec Like '" & strInfo & "%' "
    Set rsTemp = DBCN.Execute("Select Goods_id,Goods_name,Goods_unit,Goods_spec,Oper_date,Instate from tbCCGoods " & strSQL & " Order By Goods_id ")
    If rsTemp.EOF = False Then
        iIndex = 1
        lstMatInfo.ListItems.Clear
        Do Until rsTemp.EOF
            lstMatInfo.ListItems.Add iIndex, , iIndex
            With lstMatInfo.ListItems(iIndex)
                .SubItems(1) = IIf(IsNull(rsTemp.Fields("GoodS_ID")), "", rsTemp.Fields("GoodS_ID"))
                .SubItems(2) = IIf(IsNull(rsTemp.Fields("Goods_name")), "", rsTemp.Fields("Goods_name"))
                .SubItems(3) = IIf(IsNull(rsTemp.Fields("Goods_spec")), "", rsTemp.Fields("Goods_spec"))
                .SubItems(4) = IIf(IsNull(rsTemp.Fields("Goods_unit")), "", rsTemp.Fields("Goods_unit"))
                .SubItems(5) = IIf(IsNull(rsTemp.Fields("Oper_date")), "", rsTemp.Fields("Oper_date"))
                If rsTemp.Fields("Instate") = 0 Then
                    .SubItems(6) = "正常[" & rsTemp.Fields("Instate") & "]"
                Else
                    .SubItems(6) = "作废[" & rsTemp.Fields("Instate") & "]"
                End If
                Dim iRedList                 As Integer
                For iRedList = 1 To lstMatInfo.ColumnHeaders.Count - 1
                    If rsTemp.Fields("Instate") = 1 Then
                        .ListSubItems(iRedList).ForeColor = vbRed
                    End If
                Next
            End With
            rsTemp.MoveNext
            iIndex = iIndex + 1
        Loop
    Else
        MsgBox "没有符合条件的信息！", vbInformation, "提示："
    End If
    
End Function

Private Sub inDate_KeyDown(KeyCode As Integer, Shift As Integer)
    
    If KeyCode = vbKeyReturn Then
        cmbState.SetFocus
        SendKeys "%{Down}"
        Exit Sub
    End If
    
End Sub

Private Sub lstMatInfo_DblClick()
    
    On Error Resume Next
    iAdd_Update = 1
    txtMat(0).Text = lstMatInfo.SelectedItem.SubItems(1)
    txtMat(1).Text = lstMatInfo.SelectedItem.SubItems(2)
    txtMat(2).Text = lstMatInfo.SelectedItem.SubItems(3)
    txtMat(3).Text = lstMatInfo.SelectedItem.SubItems(4)
    inDate.Value = Format(lstMatInfo.SelectedItem.SubItems(5), "YYYY年MM月DD日")
    cmbState.Text = lstMatInfo.SelectedItem.SubItems(6)
    
    txtMat(0).Locked = True
    txtMat(1).SetFocus
    SendKeys "{Home}+{End}"
    
End Sub

Private Sub txtMat_GotFocus(Index As Integer)
    
    txtMat(Index).BackColor = &HC0FFC0
    txtMat(Index).ForeColor = vbRed
    
End Sub

Private Sub txtMat_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    
    Select Case KeyCode
        Case vbKeyDown
            If Index = txtMat.Count - 1 Then Exit Sub
            txtMat(Index + 1).SetFocus
            SendKeys "{Home}+{End}"
            Exit Sub
        Case vbKeyUp
            If Index = 0 Then Exit Sub
            txtMat(Index - 1).SetFocus
            SendKeys "{Home}+{End}"
            Exit Sub
        Case Else
            Exit Sub
    End Select
    
End Sub

Private Sub txtMat_KeyPress(Index As Integer, KeyAscii As Integer)
    
    Select Case KeyAscii
        Case vbKeyReturn
            Select Case Index
                Case 0
                    If txtMat(Index).Text = "" Then
                        If MsgBox("系统将自动生成最大编码？", vbInformation + vbYesNo, "提示：") = vbYes Then
                            txtMat(Index).Text = tBigCode("tbCCGoods", "Goods_ID")
                            txtMat(Index + 1).SetFocus
                            SendKeys "{Home}+{End}"
                            Exit Sub
                        Else
                            txtMat(Index).SetFocus
                            SendKeys "{Home}+{End}"
                            Exit Sub
                        End If
                    End If
                    If tWhileCode("tbCCGoods", "Goods_ID", Format(Trim(txtMat(Index).Text), "0000")) = False Then
                        MsgBox "编码重复！请检查您的输入是否正确？", vbInformation, "提示："
                        txtMat(Index).SetFocus
                        SendKeys "{Home}+{End}"
                        Exit Sub
                    Else
                        txtMat(Index).Text = Format(txtMat(Index).Text, "0000")
                        txtMat(Index + 1).SetFocus
                        SendKeys "{Home}+{End}"
                        Exit Sub
                    End If
                Case 1
                    If txtMat(Index).Text = "" Then
                        txtMat(Index).SetFocus
                        SendKeys "{Home}+{End}"
                        Exit Sub
                    End If
                    If tWhileCode("tbCCGoods", "Goods_Name", Trim(txtMat(Index).Text)) = False Then
                        MsgBox "信息重复！请检查您的输入是否正确？", vbInformation, "提示："
                        txtMat(Index).SetFocus
                        SendKeys "{Home}+{End}"
                        Exit Sub
                    Else
                        txtMat(Index + 1).SetFocus
                        SendKeys "{Home}+{End}"
                        Exit Sub
                    End If
                Case 2
                    txtMat(Index + 1).SetFocus
                    SendKeys "{Home}+{End}"
                    Exit Sub
                Case 3
                    inDate.SetFocus
                    Exit Sub
            End Select
        Case Else
            Exit Sub
    End Select
    
End Sub

Private Sub txtMat_LostFocus(Index As Integer)
    
    txtMat(Index).BackColor = vbWhite
    txtMat(Index).ForeColor = vbBlack
    
End Sub