frmcgd.frm

petrostation + sysytem

         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   375
      Left            =   5880
      TabIndex        =   7
      Top             =   2640
      Width           =   1335
   End
   Begin VB.Label Label7 
      BackStyle       =   0  'Transparent
      Caption         =   "进    价："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   375
      Left            =   720
      TabIndex        =   6
      Top             =   2640
      Width           =   1335
   End
   Begin VB.Label Label6 
      BackStyle       =   0  'Transparent
      Caption         =   "产    地："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   375
      Left            =   5880
      TabIndex        =   5
      Top             =   1920
      Width           =   1335
   End
   Begin VB.Label Label5 
      BackStyle       =   0  'Transparent
      Caption         =   "单    位："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   375
      Left            =   720
      TabIndex        =   4
      Top             =   1920
      Width           =   1335
   End
   Begin VB.Label Label4 
      BackStyle       =   0  'Transparent
      Caption         =   "包    装："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   375
      Left            =   5880
      TabIndex        =   3
      Top             =   1200
      Width           =   1335
   End
   Begin VB.Label Label3 
      BackStyle       =   0  'Transparent
      Caption         =   "规    格："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   375
      Left            =   720
      TabIndex        =   2
      Top             =   1200
      Width           =   1335
   End
   Begin VB.Label Label2 
      BackStyle       =   0  'Transparent
      Caption         =   "票    号："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   375
      Left            =   5880
      TabIndex        =   1
      Top             =   480
      Width           =   1335
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "油品名称："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   375
      Left            =   720
      TabIndex        =   0
      Top             =   480
      Width           =   1335
   End
End
Attribute VB_Name = "frmCGD"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim connstring As String
Private Sub Form_Load()
    On Error GoTo myerr      '有异常跳转
    adoCGD.CommandType = adCmdText
    adoCGD.RecordSource = "select 油品名称 from PS_Products where 库存>0"
    adoCGD.Refresh
    
    With adoCGD.Recordset
        .MoveFirst
        Do While Not .EOF       '从第一条开始逐条添加到Combo1的子项中
            DoEvents
            Combo1.AddItem (!油品名称)
            .MoveNext
        Loop
    End With
    adoCGD.RecordSource = "select 用户 from PS_Users"
    adoCGD.Refresh
    With adoCGD.Recordset
        .MoveFirst
        Do While Not .EOF      '从第一条开始逐条添加到Combo2的子项中
            DoEvents
            Combo2.AddItem (!用户)
            .MoveNext
        Loop
    End With
    adoCGD.RecordSource = "select 供应商简称 from PS_Suppliers"
    adoCGD.Refresh
    With adoCGD.Recordset
        .MoveFirst
        Do While Not .EOF      '从第一条开始逐条添加到Combo3的子项中
            DoEvents
            Combo3.AddItem (!供应商简称)
            .MoveNext
        Loop
    End With
    adoCGD.RecordSource = "select 票号 from PS_Purchases order by 票号"
    
    adoCGD.Refresh
    With adoCGD.Recordset
        If .RecordCount > 0 Then     '如果已有记录则在原来的序号上递增
            .MoveLast
             If !票号 <> "" Then
                Dim lsph As String
                lsph = Right(Trim(!票号), 3) + 1
                Text3.Text = DateTime.Date$ & "-P-" & Format(lsph, "000")
             End If
        Else                              '如果还没有记录则序号开始为001
            Text3.Text = DateTime.Date$ & "-P-" & "001"
        End If
    End With
        mebDate.Text = DateTime.Date$   '系统当前日期的字符串形式赋值
myerr:
End Sub



Private Sub Form_Unload(Cancel As Integer)
    '将主窗体设置为可用，并将其显示
    frmMain.Enabled = True
    frmMain.Show
End Sub

Private Sub Picture1_Click()
    On Error GoTo err
    '首先检查油品名称字段。如果为空，则提示不能为空，然后将焦点转移到Combo1上
    If Trim(Combo1.Text) = "" Then
        If MsgBox("油品名称字段是必须要输入的！", vbExclamation, "提示！") = vbOK Then
        Combo1.SetFocus
        End If
    Else
        '检查数量字段。如果为空，则提示不能为空，然后将焦点转移到Text8上
        If Text8.Text = "" Then
             If MsgBox("数量字段是必须要输入的！", vbExclamation, "提示！") = vbOK Then
                Text8.SetFocus
            End If
        Else
            '检查进价字段。如果为空，则提示不能为空，然后将焦点转移到Text6上
            If Text6.Text = "" Then
                If MsgBox("进价字段是必须要输入的！", vbExclamation, "提示！") Then
                    Text6.SetFocus
                End If
            Else
                '检查供应商字段。如果为空，则提示不能为空，然后将焦点转移到Combo3上
                If Trim(Combo3.Text) = "" Then
                     If MsgBox("供应商字段是必须要输入的！", _
                            vbExclamation, "提示！") = vbOK Then
                        Combo3.SetFocus
                    End If
                Else
                    '检查经手人字段。如果为空，则提示不能为空，然后将焦点转移到Combo2上
                    If Trim(Combo2.Text) = "" Then
                        If MsgBox("经手人字段是必须要输入的！", _
                                vbExclamation, "提示！") = vbOK Then
                            Combo2.SetFocus
                        End If
                    Else
                        '输入检测无误后可以提交数据
                        connstring = "Provider=SQLOLEDB.1;Password=ecc;Persist Security " _
                        & "Info=True;User ID=sa;Initial Catalog=PetrolStation System;Server=(local)"
                        If conn.State <> 1 Then            '打开数据库
                            conn.Open (connstring)
                        End If
                        Dim sql As String
                        sql = "insert into PS_Purchases (油品名称," & _
                                "数量,进价,金额,备注,供应商,日期,经手人,票号) " & _
                                "values ('" & Trim(Combo1.Text) & "'," _
                                & Trim(Text8.Text) & "," & Trim(Text6.Text) & "," _
                                & Trim(Text7.Text) & ",'" & Trim(Text9.Text) & "','" & _
                                Trim(Combo3.Text) & "','" & Trim(mebDate.Text) & _
                                "','" & Trim(Combo2.Text) & "','" & Trim(Text3.Text) & "')"
                        conn.Execute (sql)           '执行插入操作
                        conn.Close
                        '如果没有发生异常就表明插入操作成功，提示用户，然后退出本窗口
                        If MsgBox("采购单成功生成！", vbInformation, "提示") = vbOK Then
                            Unload Me
                        End If
                    End If
                End If
            End If
        End If
    End If
err:
End Sub

Private Sub Text6_LostFocus()
   On Error GoTo myerr
        If Text6.Text <> "" And Text8.Text <> "" Then
            '  只有两个文本框中都输入了内容时才能计算金额
            Text7.Text = Trim(Text6.Text) * Trim(Text8.Text)
        End If
    Exit Sub
myerr:     If MsgBox("价格必须是数值，数量必须是整数！", vbInformation, "提示！") Then GoTo myerr1
myerr1:
End Sub

Private Sub Combo1_lostfocus()
    connstring = "Provider=SQLOLEDB.1;Password=ecc;Persist Security Info=True;User ID=sa;" _
                & "Initial Catalog=PetrolStation System;Server=(local)"
    If conn.State <> 1 Then           '连接数据库
        conn.Open (connstring)
    End If
   
    Set rs = conn.Execute("select 产地,规格,包装,单位,库存 from PS_Products where 油品名称='" _
                          & Trim(Combo1.Text) & "'")
    With rs
        .MoveFirst
        Do While Not .EOF                '将检索结果在相应的控件上显示出来
            DoEvents
            Text1.Text = !规格
            Text4.Text = !包装
            Text2.Text = !单位
            Text5.Text = !产地
            Text8.Text = !库存
            .MoveNext
        Loop
    End With
End Sub

Private Sub Text8_LostFocus()
   On Error GoTo myerr
  
            If Text6.Text <> "" And Text8.Text <> "" Then
                '  只有两个文本框中都输入了内容时才能计算金额
                Text7.Text = Trim(Text6.Text) * Trim(Text8.Text)
            End If
    Exit Sub
myerr: If MsgBox("价格必须是数值，数量必须是整数！", vbInformation, "提示！") Then GoTo myerr1
     
myerr1:
End Sub