frmjy.frm

不错的药房管理系统

      Caption         =   "总金额："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   7620
      TabIndex        =   27
      Top             =   6030
      Width           =   975
   End
   Begin VB.Label Label6 
      Caption         =   "日期:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Index           =   0
      Left            =   4710
      TabIndex        =   12
      Top             =   6090
      Width           =   615
   End
   Begin VB.Label Label5 
      Caption         =   "批次:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   11
      Top             =   6780
      Width           =   735
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "数量："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   2400
      TabIndex        =   9
      Top             =   6030
      Width           =   720
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "进价："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   120
      TabIndex        =   7
      Top             =   6000
      Width           =   720
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "供应商名称:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   3810
      TabIndex        =   4
      Top             =   5310
      Width           =   1320
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "药品名称:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   120
      TabIndex        =   3
      Top             =   5280
      Width           =   1080
   End
End
Attribute VB_Name = "frmJY"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim strMedcineCode As String
Dim SearchRst As New ADODB.Recordset
Const strSQL_SELECT = "SELECT  进药.ID,供应商.供应商名称,药品.药品名称,药品.简称,进药.数量, " & _
                    "进药.批次,进药.日期,进药.进价,进药.已入库 " & _
                    "FROM 供应商,药品,进药 WHERE 供应商.供应商编号=进药.供应商编号 " & _
                    "AND 药品.药品编号=进药.药品编号 "

Private Sub cboMedcine_Change()
Dim MedcineRst As New ADODB.Recordset
    MedcineRst.Source = "SELECT * FROM 药品 WHERE 药品.药品名称 Like '%" & Trim(cboMedcine) & "%'"
    MedcineRst.Open , Gado, adOpenStatic, adLockReadOnly
    Do While Not MedcineRst.EOF
        cboMedcine.AddItem MedcineRst!药品名称 & ""
        MedcineRst.MoveNext
    Loop
     RefreshList
End Sub

Private Sub cboQueryType_Click()
    Select Case cboQueryType.ListIndex
        Case 0, 1, 2:
            Me.lblValue1.Caption = "输入:"
            Me.lblValue2.Visible = False
            Me.txtQueryValue1.Visible = True
        Case 3:
            Me.lblValue1.Caption = "起始"
            Me.txtQueryValue1.Visible = False
    End Select
End Sub

Private Sub cboSuplyer_Change()
Dim SuplyRst As New ADODB.Recordset
    SuplyRst.Source = "SELECT * FROM 供应商 WHERE 供应商.供应商名称 Like '%" & Trim(cboSuplyer) & "%'"
    SuplyRst.Open , Gado, adOpenStatic, adLockReadOnly
    Do While Not SuplyRst.EOF
        cboSuplyer.AddItem SuplyRst!供应商名称 & ""
        SuplyRst.MoveNext
    Loop
     RefreshList
End Sub

Private Sub cmdAddNew_Click()
On Error Resume Next

 If Trim(cboMedcine) = "" Or Trim(cboSuplyer) = "" Or Trim(txtPrice) = "" Or Trim(txtCount) = "" Or Trim(txtNumber) = "" Then
            MsgBox "请输入相应内容！", vbCritical
            Exit Sub
        End If


    Dim strSQL As String
    
    Dim MedcineRst As New ADODB.Recordset
    MedcineRst.Source = "SELECT * FROM 药品 WHERE 药品名称='" & Trim(cboMedcine) & "'"
    MedcineRst.Open , Gado, adOpenStatic, adLockReadOnly
    If MedcineRst.EOF = False Then
        strMedcineCode = MedcineRst!药品编号 & ""
    End If
    Set MedcineRst = Nothing
    
    Dim SuplyRst As New ADODB.Recordset
    SuplyRst.Source = "SELECT * FROM 供应商 WHERE 供应商名称='" & Trim(cboSuplyer) & "'"
    SuplyRst.Open , Gado, adOpenStatic, adLockReadOnly
    If SuplyRst.EOF = False Then
        strsuplyCode = SuplyRst!供应商编号 & ""
    End If
    Set SuplyRst = Nothing
    
    
    strSQL = "INSERT INTO 进药(药品编号,数量,进价,批次,日期,供应商编号,已入库,编辑) " & _
                            " VALUES('" & Trim(strMedcineCode) & "','" & txtCount.Text & "', '" & _
                            " " & txtPrice & " ','" & txtNumber.Text & "','" & txtTime.Text & "','" & _
                            "" & Trim(strsuplyCode) & " ','否','是')"
    Gado.Execute strSQL
    RefreshList
    
     txtTotal = CSng(txtAll) + CSng(Val(txtTotal))
    
    
     txtPrice.Text = ""
     txtNumber.Text = ""
     txtCount.Text = ""
     Me.cboMedcine.Text = ""
     Me.cboSuplyer = ""
End Sub

Private Sub cmdCancelQuery_Click()
   RefreshList
End Sub

'Private Sub cmdDelete_Click()
'    Dim nRow As Long
'    nRow = CLng(Me.fgMedcineList.TextMatrix(Me.fgMedcineList.Row, 1))
'    Gado.Execute "DELETE FROM 进药 WHERE ID = " & nRow
'    RefreshList
'End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub CmdInto_Click()
'On Error Resume Next
    If fgMedcineList.TextMatrix(1, 4) = "" Then
      MsgBox "请选择入库内容！", vbCritical
       Exit Sub
    End If

    Dim strCode As String
    Dim strCode1 As String
    Dim nCount As Long
    Dim avgprice As Long

    Dim Rst As New ADODB.Recordset
    Dim Rst1 As New ADODB.Recordset
    Dim Rst2 As New ADODB.Recordset
    Dim Rst3 As New ADODB.Recordset
    Dim Rst4 As New ADODB.Recordset
    Dim strSQL As String
    
    
    
    
    
    nCount = CLng(fgMedcineList.TextMatrix(Me.fgMedcineList.Row, 5))
    Rst.Source = "SELECT * FROM 药品 WHERE 药品名称='" & fgMedcineList.TextMatrix(Me.fgMedcineList.Row, 2) & "'"
    Rst.Open , Gado, adOpenStatic, adLockReadOnly
    strCode = Rst!药品编号
    Set Rst = Nothing
    
    Rst1.Source = "SELECT * FROM 库存 WHERE 药品编号='" & strCode & "'"
    Rst1.Open , Gado, adOpenDynamic, adLockOptimistic
    Rst1!库存数量 = Rst1!库存数量 + nCount
    Rst1.Update
    Set Rst1 = Nothing
    
    avgprice = CLng(fgMedcineList.TextMatrix(Me.fgMedcineList.Row, 7))
    Rst2.Source = "SELECT * FROM 药品 WHERE 药品名称='" & fgMedcineList.TextMatrix(Me.fgMedcineList.Row, 2) & "'"
    Rst2.Open , Gado, adOpenStatic, adLockReadOnly
    strCode1 = Rst2!药品编号
    Set Rst2 = Nothing

    Rst3.Source = "SELECT * FROM 库存 WHERE 药品编号='" & strCode1 & "'"
    Rst3.Open , Gado, adOpenDynamic, adLockOptimistic
    Rst3!平均进价 = (Rst3!平均进价 * Rst3!库存数量 + avgprice * nCount) / Rst3!库存数量 + nCount
    Rst3.Update
    Set Rst3 = Nothing

    Gado.Execute "UPDATE 进药 SET 已入库 = '是' WHERE ID=" & CLng(fgMedcineList.TextMatrix(Me.fgMedcineList.Row, 0))
    RefreshList
End Sub

Private Sub cmdPrint_Click()
    JYreport.ShowMe SearchRst
End Sub

Private Sub cmdSearch_Click()
'On Error Resume Next
If Trim(cboQueryType) = "" Then
    MsgBox "请选择查询条件！", vbCritical
       Exit Sub
End If
If Trim(cboQueryType) = "药品名称" And Trim(txtQueryValue1) = "" Then
       MsgBox "请输入查询内容！", vbCritical
       Exit Sub
End If
If Trim(cboQueryType) = "药品简称" And Trim(txtQueryValue1) = "" Then
       MsgBox "请输入查询内容！", vbCritical
       Exit Sub
End If
If Trim(cboQueryType) = "供应商名称" And Trim(txtQueryValue1) = "" Then
       MsgBox "请输入查询内容！", vbCritical
       Exit Sub
End If

    Dim strDate1 As String, strDate2 As String

    If SearchRst.State = adStateOpen Then SearchRst.Close
    Select Case cboQueryType.ListIndex
        Case 0:
            SearchRst.Source = strSQL_SELECT & " AND 药品.药品名称 Like '%" & Trim(txtQueryValue1) & "%'"
        Case 1:
            SearchRst.Source = strSQL_SELECT & " AND 药品.简称 Like '%" & Trim(txtQueryValue1) & "%'"
        Case 2:
            SearchRst.Source = strSQL_SELECT & " AND 供应商.供应商名称 Like '%" & Trim(txtQueryValue1) & "%'"
        Case 3:
            If "" <> Me.DTPicker1.Value & "" Then strDate1 = " AND 进药.日期 >='" & Format(DTPicker1, "YYYY-MM-DD") & "'"
            If "" <> Me.DTPicker2.Value & "" Then strDate2 = " AND 进药.日期 <='" & Format(DTPicker2, "YYYY-MM-DD") & "'"
            SearchRst.Source = strSQL_SELECT & strDate1 & strDate2
    End Select
    
    
    
    SearchRst.Open , Gado, adOpenStatic, adLockReadOnly
    Set Me.fgMedcineList.DataSource = SearchRst
    fgMedcineList.ColWidth(0) = 0
    
    If SearchRst.RecordCount <= 0 Then
        MsgBox "找不到查询内容！", vbCritical
        txtQueryValue1.Text = ""
       Exit Sub
    End If
    
    txtQueryValue1.Text = ""
End Sub

Private Sub Form_Load()
    Gado.Execute "UPDATE 进药 SET 进药.编辑='否'"
'    RefreshList
    txtTime = Format(Date, "YYYY-MM-DD")
    Me.DTPicker1 = Format(Date, "YYYY-MM-DD")
    Me.DTPicker2 = Format(Date, "YYYY-MM-DD")
    
    Dim MedcineRst As New ADODB.Recordset
    MedcineRst.Source = "SELECT * FROM 药品"
    MedcineRst.Open , Gado, adOpenStatic, adLockReadOnly
    Do While Not MedcineRst.EOF
        cboMedcine.AddItem MedcineRst!药品名称 & ""
        MedcineRst.MoveNext
    Loop
'    cboMedcine.ListIndex = 0
    
    Dim SuplyRst As New ADODB.Recordset
    SuplyRst.Source = "SELECT * FROM 供应商"
    SuplyRst.Open , Gado, adOpenStatic, adLockReadOnly
    Do While Not SuplyRst.EOF
        cboSuplyer.AddItem SuplyRst!供应商名称 & ""
        SuplyRst.MoveNext
    Loop
'    cboSuplyer.ListIndex = 0
    
    Set SuplyRst = Nothing
    Set MedcineRst = Nothing
    
    cboQueryType.AddItem "药品名称"
    cboQueryType.AddItem "简称"
    cboQueryType.AddItem "供应商名称"
    cboQueryType.AddItem "日期"
    
  '  fgMedcineList.ColWidth(0) = 0
'    fgMedcineList.Rows = 1
    RefreshList
End Sub

Private Sub RefreshList()
    If SearchRst.State = adStateOpen Then SearchRst.Close
'    Set SearchRst = Nothing
    SearchRst.Source = strSQL_SELECT & " AND 进药.编辑='是'"
    SearchRst.Open , Gado, adOpenStatic, adLockReadOnly
    If SearchRst.EOF = False Then
        Set Me.fgMedcineList.DataSource = SearchRst
    Else
        fgMedcineList.Clear
        fgMedcineList.Rows = 2
        fgMedcineList.TextMatrix(0, 1) = "供应商名称"
        fgMedcineList.TextMatrix(0, 2) = "药品名称"
        fgMedcineList.TextMatrix(0, 3) = "简称"
        fgMedcineList.TextMatrix(0, 4) = "数量"
        fgMedcineList.TextMatrix(0, 5) = "批次"
        fgMedcineList.TextMatrix(0, 6) = "日期"
        fgMedcineList.TextMatrix(0, 7) = "进价"
        fgMedcineList.TextMatrix(0, 8) = "已入库"
    End If
    fgMedcineList.ColWidth(0) = 0
End Sub

Private Sub txtCount_Change()
 If Trim(txtPrice) = "" Or Trim(txtCount) = "" Then
        txtAll = ""
        Exit Sub
    End If
    txtAll = CSng(txtCount) * CSng(txtPrice)
End Sub

Private Sub txtCount_KeyPress(KeyAscii As Integer)
    InputControl txtCount, KeyAscii, OnlySingle
End Sub

Private Sub txtNumber_KeyPress(KeyAscii As Integer)
    InputControl txtNumber, KeyAscii, OnlyInteger
End Sub

Private Sub txtPrice_KeyPress(KeyAscii As Integer)
    InputControl txtPrice, KeyAscii, OnlySingle
End Sub
Private Sub fgMedcineList_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
    Dim strCode As String
    Dim JyRst As New ADODB.Recordset
    strCode = Me.fgMedcineList.TextMatrix(Me.fgMedcineList.Row, 0)
    JyRst.Source = "SELECT * FROM 药品  WHERE 药品编号='" & strCode & "'"
    JyRst.Open , Gado, adOpenStatic, adLockReadOnly
    
    Set JyRst = Nothing
End Sub