frm期初初始化.frm

适合于中小型企业管理

      Top             =   755
      Width           =   135
   End
End
Attribute VB_Name = "Frm期初初始化"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim LConRs As ADODB.Recordset
Dim Rstmp As ADODB.Recordset
Dim RsADD As ADODB.Recordset
Dim CmdUpdate As ADODB.Command
Dim TxtSqlbj As String
Dim SqlSctmp As String
Dim LSString As String

Private Sub DoList()
 SqlSctmp = "select * from Fl_物资信息表 order by 物资编号"

Dim ItmX As ListItem
lstContracts.ColumnHeaders.Clear
lstContracts.ColumnHeaders.Add , , "编号", Len("物资编号") * 100 + 300
lstContracts.ColumnHeaders.Add , , "类别", Len("类别编码") * 100 + 200
lstContracts.ColumnHeaders.Add , , "名称", Len("物资名称") * 100 + 900
lstContracts.ColumnHeaders.Add , , "物资型号", Len("物资型号") * 300 + 300
lstContracts.ColumnHeaders.Add , , "单位", Len("计量单位") * 100 + 200
    Set LConRs = New ADODB.Recordset
    LConRs.Open SqlSctmp, Cw_DataEnvi.DataConnect, adOpenStatic, adLockReadOnly, adCmdText
    If Not LConRs.BOF Then LConRs.MoveFirst
    lstContracts.ListItems.Clear
    Do While Not LConRs.EOF
        Set ItmX = lstContracts.ListItems.Add(, , LConRs!物资编号)
         ItmX.SubItems(1) = LConRs!类别编码
         ItmX.SubItems(2) = LConRs!物资名称
         ItmX.SubItems(3) = LConRs!物资型号
         ItmX.SubItems(4) = LConRs!计量单位
        LConRs.MoveNext
    Loop
    If Not LConRs.EOF Then LConRs.MoveFirst
    lstContracts.Refresh
End Sub

Private Sub DoList1()
    Dim ItmX As ListItem
    ListView1.ColumnHeaders.Clear
    ListView1.ColumnHeaders.Add , , "物资编号", Len("物资编号") * 100 + 550
    ListView1.ColumnHeaders.Add , , "类别", Len("类别名称") * 100 + 200
    ListView1.ColumnHeaders.Add , , " 单价", Len("单价") * 100 + 550
    ListView1.ColumnHeaders.Add , , " 数量", Len("数量") * 100 + 550
    ListView1.ColumnHeaders.Add , , " 金额", Len("金额") * 100 + 700
    ListView1.ColumnHeaders.Add , , "业务员", Len("业务员") * 100 + 550
    ListView1.ColumnHeaders.Add , , "仓库名称", Len("仓库名称") + 550 * 2
    ListView1.ColumnHeaders.Add , , "备注", Len("备注") + 550 * 4

    ListView1.ListItems.Clear


    ListView1.Refresh
End Sub

Private Sub CmdAdd_Click()
On Error GoTo Errline
   Dim i As Integer
   Dim ItmX As ListItem
    '检测是否符合要求
        If RKTxt.Text = "" Or Text4.Text = "" Or Text5.Text = "" Or combo1.ListIndex < 0 Then Exit Sub
        Text4.Text = Text2.Text * Text3.Text * 1
    For i = 1 To ListView1.ListItems.Count
        If ListView1.ListItems(i).Text = RKTxt.Text Then
            MsgBox "重复物资编号!"
            Exit Sub
        End If
    Next i
    '添加至列表
        Set ItmX = ListView1.ListItems.Add(, , Text1(0).Text)
        ItmX.SubItems(1) = Text1(1).Text
        ItmX.SubItems(2) = Text2.Text
        ItmX.SubItems(3) = Text3.Text
        ItmX.SubItems(4) = Text4.Text
        ItmX.SubItems(5) = Xtczy
        ItmX.SubItems(6) = combo1.Text
        ItmX.SubItems(7) = Text5.Text
        ListView1.Refresh
                    
            Set CmdUpdate = New ADODB.Command
            CmdUpdate.ActiveConnection = Cw_DataEnvi.DataConnect
            CmdUpdate.CommandText = "insert into FL_采购票据表 (申请编号,物资编号,类别名称,单价,数量,金额,业务员,仓库名称,供货单位,采购时间) values ('" _
            & "YD" & Year(Date) & Month(Date) & Day(Date) & Hour(Time) & Minute(Time) & Second(Time) & "','" & RKTxt.Text & "','" & Text1(1).Text & "'," & Text2.Text & ",'" & Text3.Text & "'," & Text2.Text * 1 * Text3.Text & ",'" & Xtczy & "','" & combo1.Text & "','" & Text5.Text & "','2005-01-01')"
            
            CmdUpdate.Execute
            RKTxt.Text = ""
            Text2.Text = ""
            Text3.Text = ""
            Text4.Text = ""
        ListPlay
    Exit Sub
Errline:
    MsgBox "数据产生错误!"
    
End Sub

Private Sub Command1_Click()
    If LSindex.Caption = "" Then Exit Sub
    '删除列表
    ListView1.ListItems.Remove (CInt(LSindex.Caption))
            Set CmdUpdate = New ADODB.Command
            CmdUpdate.ActiveConnection = Cw_DataEnvi.DataConnect
            CmdUpdate.CommandText = "delete from FL_采购票据表 where 供货单位='期初入库' and 物资编号='" & LSString & "'"
            CmdUpdate.Execute
    ListPlay
    LSindex.Caption = ""
    LSString = ""
End Sub


Private Sub Command2_Click()
    KF_FrmStartFinish.Show 1
End Sub

Private Sub Command4_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    DoList
    DoList1
    ListPlay
    
    Dim RsCk As ADODB.Recordset
    Set RsCk = New ADODB.Recordset
    RsCk.Open "Fl_辅料仓库表", Cw_DataEnvi.DataConnect, adOpenStatic, adLockPessimistic, adCmdTable
    combo1.Clear
    Do While Not RsCk.EOF
        combo1.AddItem RsCk!仓库名称
        RsCk.MoveNext
    Loop
    RsCk.Close

End Sub

Private Sub ListPlay()
    Dim ItmX As ListItem
    Set RsADD = New ADODB.Recordset
    RsADD.Open "select * from Fl_采购票据表 where 供货单位='期初入库' order by 物资编号 ", Cw_DataEnvi.DataConnect, adOpenStatic, adLockReadOnly, adCmdText
    '添加至列表
    If RsADD.BOF And RsADD.EOF Then Exit Sub
        ListView1.ColumnHeaders.Clear
        DoList1
    Do While Not RsADD.EOF
        Set ItmX = ListView1.ListItems.Add(, , RsADD!物资编号)
        ItmX.SubItems(1) = RsADD!类别名称
        ItmX.SubItems(2) = RsADD!单价
        ItmX.SubItems(3) = RsADD!数量
        ItmX.SubItems(4) = RsADD!金额
        ItmX.SubItems(5) = RsADD!业务员
        ItmX.SubItems(6) = RsADD!仓库名称
        ItmX.SubItems(7) = "" & RsADD!备注
        RsADD.MoveNext
    Loop
        ListView1.Refresh
    RsADD.Close
End Sub

Public Sub WZlist(TxtBHStr As String)
          
    TxtSqlbj = "select * from Fl_物资信息表 where 物资编号= '" & TxtBHStr & "'"
    Set Rstmp = New ADODB.Recordset
    Rstmp.Open TxtSqlbj, Cw_DataEnvi.DataConnect, adOpenStatic, adLockReadOnly, adCmdText
    
    If Rstmp.BOF And Rstmp.EOF Then
        RKTxt.Text = ""
        Text1(1).Text = ""
        Text1(2).Text = ""
        Text1(3).Text = ""
        Text1(4).Text = ""
        Text1(5).Text = ""
        MovingText1.MsgChar = "欢迎您选用《宇迪资源管理系统》     作者：倪德根 13301481112   2008.4"
       MsgBox "没有此物资可用信息！"
    Else
        RKTxt.Text = Rstmp!物资编号
        Text1(0).Text = Rstmp!物资编号
        Text1(1).Text = Rstmp!类别编码
        Text1(2).Text = Rstmp!物资名称
        Text1(3).Text = Rstmp!物资型号
        Text1(4).Text = Rstmp!计量单位
        Text2.Text = Rstmp!参考价格
        Text1(5).Text = " " & Rstmp!备注信息
        MovingText1.MsgChar = "物资：" & Rstmp!物资名称 & "    现库存数量为：  "
    End If
    Rstmp.Close
    Set Rstmp = Nothing

End Sub

Private Sub ListView1_Click()
    If Not ListView1.ListItems.Count < 1 Then
        LSindex = ListView1.SelectedItem.Index
        LSString = ListView1.SelectedItem.Text
        WZlist Trim(ListView1.SelectedItem.Text)
        Text3.Text = ListView1.SelectedItem.ListSubItems.Item(3).Text
    End If
End Sub

Private Sub ListView1_KeyUp(KeyCode As Integer, Shift As Integer)
    If Not ListView1.ListItems.Count < 1 Then
        LSindex = ListView1.SelectedItem.Index
        LSString = ListView1.SelectedItem.Text
        Text3.Text = ListView1.SelectedItem.ListSubItems.Item(3).Text
        WZlist Trim(ListView1.SelectedItem.Text)
    End If
End Sub

Private Sub lstContracts_Click()
    WZlist Trim(lstContracts.SelectedItem.Text)
    Text3.Text = ""
End Sub

Private Sub lstContracts_KeyUp(KeyCode As Integer, Shift As Integer)
    WZlist Trim(lstContracts.SelectedItem.Text)
    Text3.Text = ""
End Sub

Private Sub RKTxt_KeyPress(KeyAscii As Integer)
    If Not IsNumeric(Chr(KeyAscii)) Then
       KeyAscii = 0
    End If
End Sub

Private Sub RKTxt_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then WZlist Trim(RKTxt.Text)
End Sub

Private Sub RKTxt_LostFocus()
WZlist Trim(RKTxt.Text)
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)

        '小数点只允许输入一次
        If KeyAscii = 190 Then
            If InStr(Trim(Text2), ".") = 0 Then
                If Len(Trim(Text2)) > 0 Then
                    Text2.Locked = False
                Else
                    Text2.Locked = True
                End If
            Else
                Text2.Locked = True
            End If
            Exit Sub
        End If
        '非数字不能输入
        If KeyAscii > 57 Or KeyAscii < 48 Then
            Text2.Locked = True
        Else
            Text2.Locked = False
        End If
        '允许Backspace
        If KeyAscii = 8 Then
            Text2.Locked = False
        End If
        'Delete键
        If KeyAscii = 46 Then
            Text2.Locked = False
        End If
End Sub

Private Sub Text2_LostFocus()
On Error Resume Next
    If Len(Text2.Text) < 1 Or Len(Text3.Text) < 1 Then
        Exit Sub
    Else
        Text4.Text = Text2.Text * Text3.Text * 1
    End If
End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)

        '小数点只允许输入一次
        If KeyAscii = 190 Then
            If InStr(Trim(Text3), ".") = 0 Then
                If Len(Trim(Text3)) > 0 Then
                    Text3.Locked = False
                Else
                    Text3.Locked = True
                End If
            Else
                Text3.Locked = True
            End If
            Exit Sub
        End If
        '非数字不能输入
        If KeyAscii > 57 Or KeyAscii < 48 Then
            Text3.Locked = True
        Else
            Text3.Locked = False
        End If
        '允许Backspace
        If KeyAscii = 8 Then
            Text3.Locked = False
        End If
        'Delete键
        If KeyAscii = 46 Then
            Text3.Locked = False
        End If
End Sub

Private Sub Text3_LostFocus()
On Error Resume Next
    If Len(Text2.Text) < 1 Or Len(Text3.Text) < 1 Then
        Exit Sub
    Else
        Text4.Text = Text2.Text * Text3.Text * 1
    End If
    
End Sub