main_jhgl_jh.frm

完整的物资管理系统源码

      Left            =   930
      TabIndex        =   15
      Top             =   5595
      Width           =   690
   End
   Begin VB.Label Lbl1 
      BackStyle       =   0  'Transparent
      Caption         =   "进货数量:          进货金额:"
      Height          =   225
      Index           =   4
      Left            =   75
      TabIndex        =   16
      Top             =   5595
      Width           =   2610
   End
   Begin VB.Menu edit 
      Caption         =   "编辑"
      Visible         =   0   'False
      Begin VB.Menu delone 
         Caption         =   "清除当前记录"
      End
   End
End
Attribute VB_Name = "main_jhgl_jh"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rs1 As New ADODB.Recordset, rs2 As New ADODB.Recordset     '定义数据集对象
Dim i As Integer, j As Integer
Sub EditKeyCode(MSHFlexGrid As Control, Edt As Control, KeyCode As Integer, Shift As Integer)
  '标准编辑控件处理。
  Select Case KeyCode
    Case 27     'ESC:隐藏焦点并将其返回 MSFlexGrid
      Edt.Visible = False
      MSHFlexGrid.SetFocus
    Case 13     'ENTER 将焦点返回 MSFlexGrid。
      MSHFlexGrid.SetFocus
      DoEvents
      If MSHFlexGrid.Col < MSHFlexGrid.Cols - 1 Then
        MSHFlexGrid.Col = MSHFlexGrid.Col + 1
      Else
        If MSHFlexGrid.Col = MSHFlexGrid.Cols - 1 Then
           MSHFlexGrid.Row = MSHFlexGrid.Row + 1
           MSHFlexGrid.Col = 1
        End If
      End If
    Case 38        '向上
      MSHFlexGrid.SetFocus
      DoEvents
      If MSFlexGrid.Row > MSFlexGrid.FixedRows Then
        MSFlexGrid.Row = MSFlexGrid.Row - 1
      End If
  End Select
End Sub
Sub view_DP()
  If flex1.Col = 6 Or flex1.Col = 7 Or flex1.Col = 8 Then
     flex1.TextMatrix(flex1.Row, 7) = Format(flex1.TextMatrix(flex1.Row, 7), "0.00")
     flex1.TextMatrix(flex1.Row, 8) = Val(flex1.TextMatrix(flex1.Row, 6)) * Val(flex1.TextMatrix(flex1.Row, 7))
     flex1.TextMatrix(flex1.Row, 8) = Format(flex1.TextMatrix(flex1.Row, 8), "0.00")
  End If
  Dim A, B As Single     '声明单精度浮点型变量
  On Error Resume Next
  For i = 1 To flex1.Rows - 1
    If flex1.TextMatrix(i, 1) <> "" And flex1.TextMatrix(i, 6) <> "" And flex1.TextMatrix(i, 7) <> "" Then
       A = Val(flex1.TextMatrix(i, 8)) + A     '求合计金额
       B = Val(flex1.TextMatrix(i, 6)) + B     '求合计数量
    End If
  Next i
  lblCount = B
  lblSum = Format(A, "0.00")   '格式化合计金额
End Sub
Sub SetButtons(bVal As Boolean)  '定义设置控件有效或无效的过程
  cmdRegister.Enabled = Not bVal
  cmdSave.Enabled = bVal
  cmdCancel.Enabled = bVal
  flex1.Enabled = bVal
  Frame1.Enabled = bVal
End Sub
Private Sub Form_Load()
  Me.Caption = text
  Dim i As Integer
  '使第一列较窄。
  flex1.ColWidth(0) = flex1.ColWidth(0) / 2
 '初始化编辑框
  txtEdit = ""
  flex1.Rows = 101
  flex1.Cols = 12
  '设置列标头。
  s$ = "^|^物资名称             |^物资编号|^规格型号   |^计量单位|^材质   |^数量  |^单价   |^金额       |^批/炉号|^外观质量   |^随货技术证件 |^备注               "
  flex1.FormatString = s$
  Adodc4.RecordSource = "tb_kw"
  Adodc4.Refresh
  If Adodc4.Recordset.RecordCount > 0 Then
    Adodc4.Recordset.MoveFirst
    DataCombo1.text = Adodc4.Recordset.Fields("仓库名称")
  End If
End Sub
Private Sub DataCombo1_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyReturn Then
     flex1.Col = 1
     flex1.Row = 1
     flex1.SetFocus
  End If
End Sub
Private Sub DataGrid2_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyReturn Then
    With Adodc2.Recordset
        '赋值给flex1表格
        If .Fields("物资名称") <> "" Then flex1.TextMatrix(flex1.Row, 1) = Trim(.Fields("物资名称"))
        If .Fields("物资编号") <> "" Then flex1.TextMatrix(flex1.Row, 2) = Trim(.Fields("物资编号"))
        If .Fields("规格型号") <> "" Then flex1.TextMatrix(flex1.Row, 3) = Trim(.Fields("规格型号"))
        If .Fields("计量单位") <> "" Then flex1.TextMatrix(flex1.Row, 4) = Trim(.Fields("计量单位"))
        If .Fields("材质") <> "" Then flex1.TextMatrix(flex1.Row, 5) = Trim(.Fields("材质"))
        flex1.TextMatrix(flex1.Row, 7) = .Fields("单价")
    End With
    flex1.Col = 6
    flex1.SetFocus
    DataGrid2.Visible = False     'DataGrid2不可见
  End If
  If KeyCode = vbKeyEscape Then     '按ESC键DataGrid2不可见
     DataGrid2.Visible = False
     txtEdit.SetFocus     'txtEdit获得焦点
  End If
End Sub
Private Sub DataGrid3_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyReturn Then
     txt1(1) = Adodc3.Recordset.Fields("经手人姓名")
     DataCombo1.SetFocus
     DataGrid3.Visible = False
  End If
End Sub
Private Sub delone_Click()   '单击“清除当前记录”菜单命令
   For i = 1 To flex1.Cols - 1
      flex1.TextMatrix(flex1.Row, i) = ""
   Next i
   view_DP
End Sub
Private Sub flex1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  '利用PopupMenu方法创建右键弹出菜单
  If Button And vbRightButton Then
     PopupMenu edit    '弹出菜单
  End If
End Sub
Private Sub flex1_KeyPress(KeyAscii As Integer)
  If flex1.Col >= 6 Or flex1.Col = 1 Then
     MSHFlexGridEdit flex1, txtEdit, KeyAscii
  End If
End Sub
'添加下列例程以初始化文本框，并将焦点从 Hierarchical FlexGrid 传递到 TextBox 控件：
Sub MSHFlexGridEdit(MSHFlexGrid As Control, Edt As Control, KeyAscii As Integer)

  '使用已输入的字符。
  Select Case KeyAscii
  
    '空格表示编辑当前的文本。
  Case 0 To 32
    Edt = MSHFlexGrid
    Edt.SelStart = 1000
    
    '其它所有字符表示取代当前的文本。
  Case Else
    Edt = Chr(KeyAscii)
    Edt.SelStart = 1
  End Select
  
  '在合适的位置显示 Edt。
  Edt.Move MSHFlexGrid.Left + MSHFlexGrid.CellLeft - 15, _
  MSHFlexGrid.Top + MSHFlexGrid.CellTop - 15, _
  MSHFlexGrid.CellWidth, _
  MSHFlexGrid.CellHeight
  Edt.Visible = True
  
  '启动工作。
  Edt.SetFocus
End Sub
Private Sub flex1_DblClick()
  If flex1.Col >= 6 Or flex1.Col = 1 Then
     MSHFlexGridEdit flex1, txtEdit, 32            '模拟一个空格。
  End If
End Sub
Private Sub txt1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyReturn And Index = 0 Then
    Adodc1.RecordSource = "tb_gys where 供应商编号 like +'%'+'" + txt1(0) + "'+'%'or 供应商全称 like +'%'+'" + txt1(0) + "'+'%'or 简称 like +'%'+'" + txt1(0) + "'+'%'"
    Adodc1.Refresh
    If Adodc1.Recordset.RecordCount > 0 Then
       DataGrid1.Visible = True
       DataGrid1.SetFocus
    Else
       Adodc1.RecordSource = "tb_gys"
       Adodc1.Refresh
       If Adodc1.Recordset.RecordCount > 0 Then
         DataGrid1.Visible = True
         DataGrid1.SetFocus
       Else
         MsgBox "无可选的供应商信息，请首先录入供应商数据！", , "提示窗口"
       End If
    End If
  End If
  If KeyCode = vbKeyReturn And Index = 1 Then
    Adodc3.RecordSource = "tb_jsr where 经手人编号 like +'%'+'" + txt1(1) + "'+'%'or 经手人姓名 like +'%'+'" + txt1(1) + "'+'%'"
    Adodc3.Refresh
    If Adodc3.Recordset.RecordCount > 0 Then
       DataGrid3.Visible = True
       DataGrid3.SetFocus
    Else
       Adodc3.RecordSource = "tb_jsr"
       Adodc3.Refresh
       If Adodc3.Recordset.RecordCount > 0 Then
         DataGrid3.Visible = True
         DataGrid3.SetFocus
       Else
         MsgBox "无可选的经手人信息，请首先录入经手人数据！", , "提示窗口"
       End If
    End If
  End If
End Sub
Private Sub DataGrid1_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyReturn Then
     txt1(0) = Adodc1.Recordset.Fields("供应商全称")
     txt1(1).SetFocus
     DataGrid1.Visible = False
  End If
End Sub
Private Sub txtEdit_KeyPress(KeyAscii As Integer)
  '删除回车符，以消除嘟嘟声。
  If KeyAscii = Asc(vbCr) Then KeyAscii = 0
End Sub
Private Sub txtEdit_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyReturn And flex1.Col = 1 Then
    Adodc2.RecordSource = "tb_kc where 物资编号 like +'%'+'" + txtEdit + "'+'%' or 物资名称 like +'%'+'" + txtEdit + "'+'%'"
    Adodc2.Refresh
    If Adodc2.Recordset.RecordCount > 0 Then
       DataGrid2.Visible = True
       DataGrid2.SetFocus
    Else
       Adodc2.RecordSource = "tb_kc"
       Adodc2.Refresh
       If Adodc2.Recordset.RecordCount > 0 Then
         DataGrid2.Visible = True
         DataGrid2.SetFocus
       Else
         MsgBox "无可选的商品信息，请首先录入商品数据！", , "提示窗口"
       End If
    End If
  End If
  '只有TextBox控件在“数量”单元格时，才使用以下过程
  If flex1.Col >= 6 Then
    EditKeyCode flex1, txtEdit, KeyCode, Shift
  End If
End Sub
'当输入数据并按下 ENTER 键，或用鼠标单击MSHFlexGrid 控件中的另一个单元时，
'焦点将返回此控件。这时 TextBox 中的文本被复制到活动单元中
Private Sub flex1_GotFocus()
  If txtEdit.Visible = False Then Exit Sub
  flex1 = txtEdit
  txtEdit.Visible = False
  view_DP
End Sub
Private Sub flex1_LeaveCell()
  If txtEdit.Visible = False Then Exit Sub
  flex1 = txtEdit
  txtEdit.Visible = False
End Sub
Private Sub cmdCancel_Click()
  For i = 1 To flex1.Rows - 1
      For j = 1 To flex1.Cols - 1
          flex1.TextMatrix(i, j) = ""
      Next j
  Next i
  SetButtons False
  txtEdit.Visible = False
  view_DP
End Sub
Private Sub cmdRegister_Click()
  Dim lsph As Integer     '声明一个整型变量
  '创建入库票号
  rs1.Open "select * from tb_rk order by 进货票号", cnn, adOpenStatic
  If rs1.RecordCount > 0 Then
    If Not rs1.EOF Then rs1.MoveLast
    If rs1.Fields("进货票号") <> "" Then
       lsph = Val(Right(Trim(rs1.Fields("进货票号")), 4)) + 1
       txtph.text = Date & "jh" & Format(lsph, "0000")
    End If
  Else
    txtph.text = Date & "jh" & "0001"
  End If
  rs1.Close
  txtDate.text = Date
  '设置控件有效或无效
  SetButtons True
  For i = 1 To flex1.Rows - 1
      For j = 1 To flex1.Cols - 1
          flex1.TextMatrix(i, j) = ""
      Next j
  Next i
  txt1(0) = ""
  txt1(1) = ""
  txt1(0).SetFocus
  view_DP
End Sub
Private Sub cmdSave_Click()
  Dim js As Integer
   For i = 1 To flex1.Rows - 1
      If flex1.TextMatrix(i, 1) <> "" And flex1.TextMatrix(i, 2) <> "" And flex1.TextMatrix(i, 6) = "" Then
        MsgBox "第" & i & "行录入错误！", , "提示窗口"
        Exit Sub
      End If
      If flex1.TextMatrix(i, 1) = "" Then
         js = js + 1
      End If
   Next i
   If js = flex1.Rows - 1 Then
      MsgBox "没有要保存的数据！", , "提示窗口"
      Exit Sub
   End If
   rs1.Open "select * from tb_rk", cnn, adOpenKeyset, adLockOptimistic
   For i = 1 To flex1.Rows - 1
      If flex1.TextMatrix(i, 1) <> "" And flex1.TextMatrix(i, 2) <> "" And flex1.TextMatrix(i, 3) <> "" Then
       '添加新记录到"tb_rk"中
        rs1.AddNew
        If flex1.TextMatrix(i, 1) <> "" Then rs1.Fields("物资名称") = flex1.TextMatrix(i, 1)
        If flex1.TextMatrix(i, 2) <> "" Then rs1.Fields("物资编号") = flex1.TextMatrix(i, 2)
        If flex1.TextMatrix(i, 3) <> "" Then rs1.Fields("规格型号") = flex1.TextMatrix(i, 3)
        If flex1.TextMatrix(i, 4) <> "" Then rs1.Fields("计量单位") = flex1.TextMatrix(i, 4)
        If flex1.TextMatrix(i, 5) <> "" Then rs1.Fields("材质") = flex1.TextMatrix(i, 5)
        rs1.Fields("数量") = Val(flex1.TextMatrix(i, 6))
        rs1.Fields("进价") = Val(flex1.TextMatrix(i, 7))
        rs1.Fields("金额") = Val(flex1.TextMatrix(i, 8))
        If flex1.TextMatrix(i, 9) <> "" Then rs1.Fields("批号或炉号") = flex1.TextMatrix(i, 9)
        If flex1.TextMatrix(i, 10) <> "" Then rs1.Fields("外观质量") = flex1.TextMatrix(i, 10)
        If flex1.TextMatrix(i, 11) <> "" Then rs1.Fields("随货技术证件") = flex1.TextMatrix(i, 11)
        If flex1.TextMatrix(i, 12) <> "" Then rs1.Fields("备注") = flex1.TextMatrix(i, 12)
        If txt1(0).text <> "" Then rs1.Fields("供货单位") = txt1(0)
        If txt1(1).text <> "" Then rs1.Fields("经手人") = txt1(1)
        rs1.Fields("仓库") = DataCombo1.text
        rs1.Fields("进货票号") = Trim(txtph.text)
        rs1.Fields("进货日期") = txtDate
        rs1.Update
      End If
   Next i
   rs1.Close
   '设置控件有效或无效
   SetButtons False
End Sub
Private Sub cmdQuit_Click()
  Unload Me
End Sub