⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 frminput.frm

📁 此为我2001年为东莞建发楦头开发的企业管理软件他们使用至今,望斑竹指教! 其他会员最好不要随意下载,需经斑竹同意或我本人同意,谢谢!
💻 FRM
📖 第 1 页 / 共 3 页
字号:
🔍
123 
         Case 1
            vcDate.value = adoPrimaryRS.Fields(i)
         Case Else
            txtfields(i) = adoPrimaryRS.Fields(i)
        End Select
      Next
  End If

  mbGridFlag = True
  
  If mbGridFlag = True Then

    Dim k, l As Integer

    Dim source1 As String
    source1 = "select material_no,material_type,material_name,input_qty,material_unit,material_price  from input where input_no='" & txtfields(0) & "'"

    Set adoSecondRS = New Recordset
    adoSecondRS.Open source1, db, adOpenStatic, adLockOptimistic

    adoSecondRS.MoveFirst
    If adoSecondRS.BOF And adoSecondRS.EOF Then
        Msfg.Rows = 100
        MsfgInit
        adoSecondRS.Close
        Exit Sub
    End If

    k = 1
    Do Until adoSecondRS.EOF
        Msfg.Row = k
        For l = 1 To 6
            Msfg.Col = l - 1
            If l > 2 Then Msfg.Text = Format(adoSecondRS.Fields(l - 1), "###0.00") Else Msfg.Text = adoSecondRS.Fields(l - 1)
        Next
        adoSecondRS.MoveNext
        k = k + 1
    Loop
    adoSecondRS.Close
  End If
    
      mbDataChanged = False
    
      Exit Sub
DeleteErr:
      MsgBox err.Description
    
End Sub

Private Sub cmdEdit_Click()
  'On Error GoTo EditErr
  On Error Resume Next
  
   so = InputBox("请输入进料单号", "进料单", txtfields(0).Text)
   
  If Len(so) = 0 Then
   Exit Sub
  End If
      
   Set rs = New Recordset
   rs.Open "select sum(output_qty) from input where input_no='" & so & "'", db, adOpenStatic, adLockOptimistic
    
    If rs.RecordCount < 1 Then
        msg = MsgBox("此进料单元不存在或已经出料！", vbOKOnly + vbCritical, "进料单")
        rs.Close
        Set rs = Nothing
        Exit Sub
    ElseIf rs.Fields(0) > 0 Then
        msg = MsgBox("此进料单元已经出料！", vbOKOnly + vbCritical, "进料单")
        rs.Close
        Set rs = Nothing
        Exit Sub
    
    End If
        
    rs.Close
    Set rs = Nothing
        
  Set rs = New Recordset
  rs.Open "select distinct input_no,input_date,remark from input where input_no='" & so & "'", db, adOpenStatic, adLockOptimistic
    
  If Not rs.BOF Then rs.MoveFirst
  
      For i = 0 To rs.Fields.Count - 1
       Select Case i
         Case 1
            vcDate.value = rs.Fields(i)
         Case Else
            txtfields(i) = rs.Fields(i)
        End Select
      Next
  
  rs.Close
  Set rs = Nothing
  
  With adoPrimaryRS
  If Not (.BOF And .EOF) Then
      mvBookMark = .Bookmark
  End If
  End With
    
  lblStatus.Caption = " 编辑记录"
  mbEditFlag = True
  SetButtons False
  txtfields(2).SetFocus
  
'显示记录
  mbGridFlag = True
  
  If mbGridFlag = True Then

    Dim k, l As Integer

    Dim source1 As String
    source1 = "select material_no,material_type,material_name,input_qty,material_unit,material_price from input where input_no='" & so & "'"

    Set adoSecondRS = New Recordset
    adoSecondRS.Open source1, db, adOpenStatic, adLockOptimistic

    adoSecondRS.MoveFirst
    If adoSecondRS.BOF And adoSecondRS.EOF Then
        Msfg.Rows = 100
        MsfgInit
        adoSecondRS.Close
        Exit Sub
    End If

    k = 1
    Do Until adoSecondRS.EOF
        Msfg.Row = k
        For l = 1 To 3
            Msfg.Col = l - 1
            If l > 2 Then Msfg.Text = Format(adoSecondRS.Fields(l - 1), "###0.00") Else Msfg.Text = adoSecondRS.Fields(l - 1)
        Next
        adoSecondRS.MoveNext
        k = k + 1
    Loop
    adoSecondRS.Close
  End If
    
  Exit Sub


EditErr:
  MsgBox err.Description

End Sub

Private Sub cmdFirst_Click()
  '   On Error GoTo GoFirstError
  On Error Resume Next
    
     Beep
      
     cmdFirst.Enabled = False
     cmdPrevious.Enabled = False
     cmdNext.Enabled = True
     cmdLast.Enabled = True
     
     MsfgInit
     adoPrimaryRS.MoveFirst

    
      
      For i = 0 To adoPrimaryRS.Fields.Count - 1
       Select Case i
         Case 1
            vcDate.value = adoPrimaryRS.Fields(i)
         Case Else
            txtfields(i) = adoPrimaryRS.Fields(i)
        End Select
      Next
           
      SetButtons True
     
      mbDataChanged = False
      
  mbGridFlag = True
  
  If mbGridFlag = True Then

    Dim k, l As Integer

    Dim source1 As String
    source1 = "select material_no,material_type,material_name,input_qty,material_unit,material_price  from input where input_no='" & txtfields(0) & "'"

    Set adoSecondRS = New Recordset
    adoSecondRS.Open source1, db, adOpenStatic, adLockOptimistic

    adoSecondRS.MoveFirst
    If adoSecondRS.BOF And adoSecondRS.EOF Then
        Msfg.Rows = 100
        MsfgInit
        adoSecondRS.Close
        Exit Sub
    End If

    k = 1
    Do Until adoSecondRS.EOF
        Msfg.Row = k
        For l = 1 To 6
            Msfg.Col = l - 1
            If l > 2 Then Msfg.Text = Format(adoSecondRS.Fields(l - 1), "###0.00") Else Msfg.Text = adoSecondRS.Fields(l - 1)
        Next
        adoSecondRS.MoveNext
        k = k + 1
    Loop
    adoSecondRS.Close
  End If
    
      mbDataChanged = False
    
      Exit Sub
      
GoFirstError:
      MsgBox err.Description


End Sub

Private Sub cmdLast_Click()
  'On Error GoTo GoLastError
  On Error Resume Next

    Beep
    cmdFirst.Enabled = True
    cmdPrevious.Enabled = True
    cmdNext.Enabled = False
    cmdLast.Enabled = False
    
    MsfgInit
    adoPrimaryRS.MoveLast

  
      For i = 0 To adoPrimaryRS.Fields.Count - 1
       Select Case i
         Case 1
            vcDate.value = adoPrimaryRS.Fields(i)
         Case Else
            txtfields(i) = adoPrimaryRS.Fields(i)
        End Select
      Next
           
      SetButtons True
     
      mbDataChanged = False
      
  mbGridFlag = True
  
  If mbGridFlag = True Then

    Dim k, l As Integer

    Dim source1 As String
    source1 = "select material_no,material_type,material_name,input_qty,material_unit,material_price  from input where input_no='" & txtfields(0) & "'"

    Set adoSecondRS = New Recordset
    adoSecondRS.Open source1, db, adOpenStatic, adLockOptimistic

    adoSecondRS.MoveFirst
    If adoSecondRS.BOF And adoSecondRS.EOF Then
        Msfg.Rows = 100
        MsfgInit
        adoSecondRS.Close
        Exit Sub
    End If

    k = 1
    Do Until adoSecondRS.EOF
        Msfg.Row = k
        For l = 1 To 6
            Msfg.Col = l - 1
            If l > 2 Then Msfg.Text = Format(adoSecondRS.Fields(l - 1), "###0.00") Else Msfg.Text = adoSecondRS.Fields(l - 1)
        Next
        adoSecondRS.MoveNext
        k = k + 1
    Loop
    adoSecondRS.Close
  End If

  mbDataChanged = False

  Exit Sub

GoLastError:
  MsgBox err.Description

End Sub

Private Sub cmdNext_Click()
  'On Error GoTo GoNextError
  On Error Resume Next
    MsfgInit
    adoPrimaryRS.MoveNext
    
    cmdFirst.Enabled = True
    cmdPrevious.Enabled = True
    
    If adoPrimaryRS.EOF = True And adoPrimaryRS.RecordCount > 0 Then
        
        Beep
        adoPrimaryRS.MoveLast
        
        cmdNext.Enabled = False
        cmdLast.Enabled = False
    End If
    
      For i = 0 To adoPrimaryRS.Fields.Count - 1
       Select Case i
         Case 1
            vcDate.value = adoPrimaryRS.Fields(i)
         Case Else
            txtfields(i) = adoPrimaryRS.Fields(i)
        End Select
      Next
           
      SetButtons True
     
      mbDataChanged = False
      
  mbGridFlag = True
  
  If mbGridFlag = True Then

    Dim k, l As Integer

    Dim source1 As String
    source1 = "select material_no,material_type,material_name,input_qty,material_unit,material_price  from input where input_no='" & txtfields(0) & "'"

    Set adoSecondRS = New Recordset
    adoSecondRS.Open source1, db, adOpenStatic, adLockOptimistic

    adoSecondRS.MoveFirst
    If adoSecondRS.BOF And adoSecondRS.EOF Then
        Msfg.Rows = 100
        MsfgInit
        adoSecondRS.Close
        Exit Sub
    End If

    k = 1
    Do Until adoSecondRS.EOF
        Msfg.Row = k
        For l = 1 To 6
            Msfg.Col = l - 1
            If l > 2 Then Msfg.Text = Format(adoSecondRS.Fields(l - 1), "###0.00") Else Msfg.Text = adoSecondRS.Fields(l - 1)
        Next
        adoSecondRS.MoveNext
        k = k + 1
    Loop
    adoSecondRS.Close
  End If


        
    mbDataChanged = False

    Exit Sub
GoNextError:
  MsgBox err.Description

End Sub

Private Sub cmdPrevious_Click()
  'On Error GoTo GoPrevError
    On Error Resume Next
    MsfgInit
    adoPrimaryRS.MovePrevious
        
    cmdNext.Enabled = True
    cmdLast.Enabled = True
    If adoPrimaryRS.BOF = True And adoPrimaryRS.RecordCount > 0 Then
        
        Beep
        adoPrimaryRS.MoveFirst
        
        cmdPrevious.Enabled = False
        cmdFirst.Enabled = False
    End If
    
      For i = 0 To adoPrimaryRS.Fields.Count - 1
       Select Case i
         Case 1
            vcDate.value = adoPrimaryRS.Fields(i)
         Case Else
            txtfields(i) = adoPrimaryRS.Fields(i)
        End Select
      Next
           
      SetButtons True
     
      mbDataChanged = False
      
  mbGridFlag = True
  
  If mbGridFlag = True Then

    Dim k, l As Integer

    Dim source1 As String
    source1 = "select material_no,material_type,material_name,input_qty,material_unit,material_price  from input where input_no='" & txtfields(0) & "'"

    Set adoSecondRS = New Recordset
    adoSecondRS.Open source1, db, adOpenStatic, adLockOptimistic

    adoSecondRS.MoveFirst
    If adoSecondRS.BOF And adoSecondRS.EOF Then
        Msfg.Rows = 100
        MsfgInit
        adoSecondRS.Close
        Exit Sub
    End If

    k = 1
    Do Until adoSecondRS.EOF
        Msfg.Row = k
        For l = 1 To 6
            Msfg.Col = l - 1
            If l > 2 Then Msfg.Text = Format(adoSecondRS.Fields(l - 1), "###0.00") Else Msfg.Text = adoSecondRS.Fields(l - 1)
        Next
        adoSecondRS.MoveNext
        k = k + 1
    Loop
    adoSecondRS.Close
  End If

    mbDataChanged = False

    Exit Sub
GoPrevError:
  MsgBox err.Description
End Sub

Private Sub cmdRefresh_Click()
  '只有多用户应用程序需要
  'On Error GoTo RefreshErr
  On Error Resume Next
  MsfgInit
  adoPrimaryRS.Requery
  
  cmdFirst.Enabled = True
  cmdPrevious.Enabled = True
  cmdNext.Enabled = True
  cmdLast.Enabled = True
  
      For i = 0 To adoPrimaryRS.Fields.Count - 1
       Select Case i
         Case 1
            vcDate.value = adoPrimaryRS.Fields(i)
         Case Else
            txtfields(i) = adoPrimaryRS.Fields(i)
        End Select
      Next
           
      SetButtons True
     
      mbDataChanged = False
      
  mbGridFlag = True
  
  If mbGridFlag = True Then

    Dim k, l As Integer

    Dim source1 As String
    source1 = "select material_no,material_type,material_name,input_qty,material_unit,material_price  from input where input_no='" & txtfields(0) & "'"

    Set adoSecondRS = New Recordset
    adoSecondRS.Open source1, db, adOpenStatic, adLockOptimistic

    adoSecondRS.MoveFirst
    If adoSecondRS.BOF And adoSecondRS.EOF Then
        Msfg.Rows = 100
        MsfgInit
        adoSecondRS.Close
        Exit Sub
    End If

    k = 1
    Do Until adoSecondRS.EOF
        Msfg.Row = k
        For l = 1 To 6
            Msfg.Col = l - 1
            If l > 2 Then Msfg.Text = Format(adoSecondRS.Fields(l - 1), "###0.00") Else Msfg.Text = adoSecondRS.Fields(l - 1)
        Next
        adoSecondRS.MoveNext
        k = k + 1
    Loop
    adoSecondRS.Close
  End If

  Exit Sub
RefreshErr:
  MsgBox err.Description

End Sub
123

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -