frm出库登记.frm

来自「适合于中小型企业管理」· FRM 代码 · 共 1,020 行 · 第 1/3 页

    End If
    
    '添加至列表
        Set ItmX = ListView1.ListItems.Add(, , Combo2.Text)
        ItmX.SubItems(1) = Text1(1).Text
        ItmX.SubItems(2) = Text1(0).Text
        ItmX.SubItems(3) = combo1.Text
        ItmX.SubItems(4) = Text2.Text
        ItmX.SubItems(5) = Text3.Text
        ItmX.SubItems(6) = Text4.Text
        ItmX.SubItems(7) = Xtczy
        ItmX.SubItems(8) = Date
        ListView1.Refresh
    Text2.Text = ""
    Text3.Text = ""
    Text4.Text = ""
    LBindex.Caption = ""
    LSindex.Caption = ""
    LSString = ""
    Exit Sub
Errline:
    MsgBox "数据产生错误!"
End Sub

Private Sub CmdPrint_Click()
    Dim FormName As String
    
    FormName = Mid(cmbPaperSizes.Text, 1, InStr(1, cmbPaperSizes.Text, " -") - 1)
    Me.UseForm FormName
    
    CmdPrint.Enabled = False
End Sub

Private Sub CmdSave_Click()
On Error GoTo Errline
    Dim i As Integer
    '检测票据编号是否已经存在或空
    If Trim(RKTxt.Text) = "" Then
        MsgBox "票据编号不能为空!", vbCritical, "请重新填写!"
        Exit Sub
    Else
        Set RsPJBH = New ADODB.Recordset
        RsPJBH.Open "select * from FL_辅料出库表 where 票据编号='" & Trim(RKTxt.Text) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic, adCmdText
        If ListView1.ListItems.Count = 0 Then Exit Sub
        If RsPJBH.BOF And RsPJBH.EOF Then
            For i = 0 To ListView1.ListItems.Count - 1
                RsPJBH.AddNew
                    RsPJBH!票据编号 = RKTxt.Text
                    RsPJBH!部门名称 = ListView1.ListItems.Item(i + 1)
                    RsPJBH!类别名称 = ListView1.ListItems.Item(i + 1).SubItems(1)
                    RsPJBH!物资编号 = ListView1.ListItems.Item(i + 1).SubItems(2)
                    RsPJBH!仓库名称 = ListView1.ListItems.Item(i + 1).SubItems(3)
                    RsPJBH!单价 = ListView1.ListItems.Item(i + 1).SubItems(4)
                    RsPJBH!数量 = ListView1.ListItems.Item(i + 1).SubItems(5)
                    RsPJBH!金额 = ListView1.ListItems.Item(i + 1).SubItems(6)
                    RsPJBH!出库时间 = ListView1.ListItems.Item(i + 1).SubItems(8)
                    RsPJBH!业务员 = ListView1.ListItems.Item(i + 1).SubItems(7)
                    RsPJBH!打印状态 = 0
                    RsPJBH!票据状态 = 0
                    RsPJBH!备注 = " "
                RsPJBH.Update
            Next i
            CmdSave.Enabled = False
            CmdPrint.Enabled = True
            RKTxt.Enabled = False
            Command1.Enabled = False
            CmdAdd.Enabled = False
            combo1.Enabled = False
            Combo2.Enabled = False
            MsgBox "票据信息存储完毕!"
        Else
            MsgBox "此票据编号已经存在!", vbCritical, "请重新填写!"
            Exit Sub
        End If
    End If
    RsPJBH.Close
    Set RsPJBH = Nothing
Exit Sub

Errline:
    MsgBox "请记住票据编号等相关信息,以便修正!", vbCritical, "异常错误"
    Exit Sub
End Sub

Private Sub CmdSec_Click()
    Frm选择物资编号.Show 1
End Sub

Private Sub Command1_Click()
    If LSindex.Caption = "" Then Exit Sub
    '删除列表
        ListView1.ListItems.Remove (CInt(LSindex.Caption))
End Sub

Private Sub Command4_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    
    SecWz = 2
    FLCount = 2
    Dim RsCk As ADODB.Recordset
    Set RsCk = New ADODB.Recordset
    RsCk.Open "SELECT MAX(票据编号) + 1 AS interID FROM Fl_辅料出库表", Cw_DataEnvi.DataConnect, adOpenStatic, adLockPessimistic, adCmdText
    RKTxt.Text = IIf(IsNull(RsCk!interID) = True, "1000000001", RsCk!interID)
    RsCk.Close
    
    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
    If combo1.ListCount > 0 Then combo1.ListIndex = 0
    RsCk.Close
    
    Set RsCk = New ADODB.Recordset
    RsCk.Open "select * from Bs_部门分类 order by 部门名称", Cw_DataEnvi.DataConnect, adOpenStatic, adLockPessimistic, adCmdText
    Combo2.Clear
    Do While Not RsCk.EOF
        Combo2.AddItem RsCk!部门名称
        RsCk.MoveNext
    Loop
    If Combo2.ListCount > 0 Then Combo2.ListIndex = 0
    RsCk.Close
Dim NumForms As Long, i As Long
Dim FI1 As FORM_INFO_1
Dim aFI1() As FORM_INFO_1           ' Working FI1 array
Dim Temp() As Byte                  ' Temp FI1 array
Dim BytesNeeded As Long
Dim PrinterName As String           ' Current printer
Dim PrinterHandle As Long           ' Handle to printer
Dim FormItem As String              ' For ListBox
Dim RetVal As Long
Dim FormSize As SIZEL               ' Size of desired form

        'For jsqte = 0 To -1
        '    DyjCombo.AddItem Printer.DeviceName
        'Next jsqte

If OpenPrinter(PrinterName, PrinterHandle, 0&) Then
    With FormSize   ' Desired page size
        .cx = 121000
        .cy = 76500
    End With
    ReDim aFI1(1)
    RetVal = EnumForms(PrinterHandle, 1, aFI1(0), 0&, BytesNeeded, _
             NumForms)
    ReDim Temp(BytesNeeded)
    ReDim aFI1(BytesNeeded / Len(FI1))
    RetVal = EnumForms(PrinterHandle, 1, Temp(0), BytesNeeded, _
             BytesNeeded, NumForms)
    Call CopyMemory(aFI1(0), Temp(0), BytesNeeded)
    For i = 0 To NumForms - 1
        With aFI1(i)
            ' List name and size including the count (index).
            FormItem = PtrCtoVbString(.pName) & " - " & .Size.cx / 1000 & _
               " mm X " & .Size.cy / 1000 & " mm   (" & i + 1 & ")"
            cmbPaperSizes.AddItem FormItem
        End With
    Next i
    ClosePrinter (PrinterHandle)
    cmbPaperSizes.ListIndex = cmbPaperSizes.ListCount - 1
    
End If
    DoList1
End Sub

Private Sub ListView1_Click()
    If Not ListView1.ListItems.Count < 1 Then
        LSindex = ListView1.SelectedItem.Index
        LSString = ListView1.SelectedItem.Text
    End If
End Sub


Private Sub RKTxt_KeyPress(KeyAscii As Integer)
    If Not IsNumeric(Chr(KeyAscii)) Then
       KeyAscii = 0
    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

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
        Text1(1).Text = ""
        Text1(2).Text = ""
        Text1(3).Text = ""
        Text1(4).Text = ""
        Text1(5).Text = ""
        Text1(6).Text = ""
        MovingText1.MsgChar = "欢迎您选用《宇迪资源管理系统》     作者：倪德根 13301481112   2008.4"
       MsgBox "没有此物资可用信息！"
    Else
        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 Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If CmdPrint.Enabled = False And CmdSave.Enabled = False Then Exit Sub
        Dim SureQ As Integer
        SureQ = MsgBox("真的退出出库单据填写么(Y/N)？    ", vbYesNo + 32, "请确认...")
          If SureQ = 6 Then
             Cancel = 0
             Else
             Cancel = -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 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 Text5_DblClick()
    Frm选择供货单位.Show 1
End Sub

Private Sub DoList1()
    Dim ItmX As ListItem
    ListView1.ColumnHeaders.Clear
    ListView1.ColumnHeaders.Add , , "部门名称", Len("部门名称") * 100 + 550
    ListView1.ColumnHeaders.Add , , "类别名称", Len("类别名称") * 100 + 550
    ListView1.ColumnHeaders.Add , , "物资编号", Len("物资编号") * 100 + 550
    ListView1.ColumnHeaders.Add , , "仓库名称", Len("仓库名称") * 100 + 550
    ListView1.ColumnHeaders.Add , , "单价", Len("单价") * 100 + 550
    ListView1.ColumnHeaders.Add , , "数量", Len("数量") * 100 + 550
    ListView1.ColumnHeaders.Add , , "金额", Len("金额") * 100 + 550
    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


Public Sub UseForm(FormName As String)
Dim RetVal As Integer

RetVal = SelectForm(FormName, Me.hwnd)
Select Case RetVal
    Case FORM_NOT_SELECTED   ' 0
        ' Selection failed!
        MsgBox "Unable to retrieve From name", vbExclamation, _
           "Operation halted!"
    Case FORM_SELECTED   ' 1
            PrintTest1
    Case FORM_ADDED   ' 2
        ' Form added and selected.
        Form_Load     ' by rebuilding the list.
End Select
End Sub