frminput.frm

医药卫生综合管理系统的一部分.是药品库房管理系统.

      Width           =   900
   End
   Begin VB.Label Label24 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "动态提示："
      ForeColor       =   &H00000000&
      Height          =   180
      Left            =   360
      TabIndex        =   47
      Top             =   120
      Width           =   900
   End
   Begin VB.Label Label23 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      ForeColor       =   &H00000000&
      Height          =   180
      Left            =   1245
      TabIndex        =   46
      Top             =   120
      Width           =   90
   End
End
Attribute VB_Name = "frminput"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public Sub Guolu()
With Adodc1
.RecordSource = "select * from " & frmmain.datas & " where 失效标记=false"
.Refresh
For i = 0 To .Recordset.RecordCount
If Not .Recordset.EOF Then
    If .Recordset.Fields("失效期") <= Date Then
        .Recordset.Fields("失效标记") = True
        .Recordset.Update
    Else
        .Recordset.Fields("失效标记") = False
        .Recordset.Update
    End If
.Recordset.MoveNext
End If
Next
End With
End Sub

Private Sub combo2_Change()
If Combo2.Text <> "西药中成药库" And Combo2.Text <> "中草药库" And Combo2.Text <> "器械材料库" Then
Text1.Enabled = False
Text18.Enabled = False
End If
End Sub

Private Sub Combo2_Click()
Select Case Combo2.Text
Case "西药中成药库"
    frmmain.datas = "kcyp"
    frminput.Caption = "西药和中成药入库登记"
    frmmain.kcode = "ypcode"
    Call Guolu
    Text1.Enabled = True
    Text18.Enabled = True
Case "中草药库"
    frmmain.datas = "caoyao"
    frminput.Caption = "中草药入库登记"
    frmmain.kcode = "cycode"
    Call Guolu
    Text1.Enabled = True
    Text18.Enabled = True
Case "器械材料库"
    frmmain.datas = "qixie"
    frminput.Caption = "医疗器械和材料入库登记"
    frmmain.kcode = "qxcode"
    Call Guolu
    Text1.Enabled = True
    Text18.Enabled = True
Case Else
    Text1.Enabled = False
    Text18.Enabled = False
    frminput.Caption = "库存登记"
End Select
End Sub

Private Sub Command1_Click()
Dim rq1 As String
Dim rq2 As String
Dim rq3 As String
On Error GoTo err1
With Adodc1
.RecordSource = "select * from " & frmmain.datas & " order by ID"
.Refresh
.Recordset.AddNew
.Recordset.Fields("编号") = Text1.Text
.Recordset.Fields("名称") = Text18.Text
.Recordset.Fields("规格") = Text2.Text
.Recordset.Fields("单位") = Combo1.Text
.Recordset.Fields("数量") = Text3.Text
.Recordset.Fields("进价") = Text4.Text
.Recordset.Fields("进价合计") = (Text3.Text) * (Text4.Text)
.Recordset.Fields("零售价") = Text5.Text
.Recordset.Fields("零售合计") = (Text3.Text) * (Text5.Text)
.Recordset.Fields("产地") = Text6.Text
.Recordset.Fields("差额") = (.Recordset.Fields("零售合计")) - (.Recordset.Fields("进价合计"))
.Recordset.Fields("批号") = Text7.Text
rq1 = Text8.Text & "-" & Text9.Text & "-" & Text10.Text
.Recordset.Fields("采购日期") = CDate(rq1)
rq2 = Text11.Text & "-" & Text12.Text & "-" & Text13.Text
.Recordset.Fields("出厂日期") = CDate(rq2)
rq3 = Text14.Text & "-" & Text15.Text & "-" & Text16.Text
.Recordset.Fields("失效期") = CDate(rq3)
.Recordset.Fields("备注") = Text17.Text
.Recordset.UpdateBatch
Command1.Enabled = False
Text1.Enabled = True
Text18.Enabled = True
Label23.Caption = ""
End With
Exit Sub
err1:
MsgBox "登记项目填写不全或数据类型不匹配！"
End Sub

Private Sub Command2_Click()
'库存过期药品必须清理后才能入库
Dim rq1 As String
Dim rq2 As String
Dim rq3 As String
On Error GoTo err2
With Adodc1
.RecordSource = "select * from " & frmmain.datas & " where 编号='" & Text1.Text & "'"
.Refresh
If .Recordset.Fields("失效标记") = False Then
    If .Recordset.AbsolutePosition <> adPosUnknown Then
    .Recordset.Fields("规格") = Text2.Text
    .Recordset.Fields("单位") = Combo1.Text
    .Recordset.Fields("数量") = Text3.Text
    .Recordset.Fields("进价") = Text4.Text
    .Recordset.Fields("进价合计") = (Text3.Text) * (Text4.Text)
    .Recordset.Fields("零售价") = Text5.Text
    .Recordset.Fields("零售合计") = (Text3.Text) * (Text5.Text)
    .Recordset.Fields("产地") = Text6.Text
    .Recordset.Fields("批号") = Text7.Text
    .Recordset.Fields("差额") = (.Recordset.Fields("零售合计")) - (.Recordset.Fields("进价合计"))
    rq1 = Text8.Text & "-" & Text9.Text & "-" & Text10.Text
    .Recordset.Fields("采购日期") = CDate(rq1)
    rq2 = Text11.Text & "-" & Text12.Text & "-" & Text13.Text
    .Recordset.Fields("出厂日期") = CDate(rq2)
    rq3 = Text14.Text & "-" & Text15.Text & "-" & Text16.Text
    .Recordset.Fields("失效期") = CDate(rq3)
    .Recordset.Fields("备注") = Text17.Text
    .Recordset.UpdateBatch
    End If
    Command2.Enabled = False
    Text1.Enabled = True
    Text18.Enabled = True
    Label23.Caption = ""
Else
    MsgBox "该库存药品已经失效，须清理后才能入库！"
End If
End With
Exit Sub
err2:
MsgBox "登记项目填写不全或数据类型不匹配！"
End Sub

Private Sub Command3_Click()
frmcode.Show
End Sub

Private Sub Command4_Click()
Unload Me
End Sub

Private Sub Form_Load()
On Error GoTo err4
frminput.Top = (frmmain.Height - frminput.Height) / 2 - 500
frminput.Left = (frmmain.Width - frminput.Width) / 2
Adodc1.ConnectionString = frmlogin.conn
Adodc2.ConnectionString = frmlogin.conn
Adodc3.ConnectionString = frmlogin.conn
Command1.Enabled = False
Command2.Enabled = False
Text2.Locked = True
Text1.Enabled = False
Text18.Enabled = False
Text8.Text = "2000"
Text9.Text = "01"
Text10.Text = "01"
Text11.Text = "2000"
Text12.Text = "01"
Text13.Text = "01"
Text14.Text = "2000"
Text15.Text = "01"
Text16.Text = "01"
Text17.Text = "请填写备注"
Exit Sub
err4:
MsgBox "远程服务器连接失败！"
End Sub

Private Sub Text1_Change()
On Error GoTo err3
With Adodc2
.RecordSource = "select * from " & frmmain.kcode & " where 编号='" & Text1.Text & "'"
.Refresh
If .Recordset.AbsolutePosition <> adPosUnknown Then
    Text2.Text = .Recordset.Fields(3)
    Text18.Text = .Recordset.Fields(2)
    Text18.Locked = True
    Label23.ForeColor = &HFF&
    Label23.Caption = "已经找到[" & Text1.Text & "]这个代码!"
    With Adodc1
    .RecordSource = "select * from " & frmmain.datas & " where 编号='" & Text1.Text & "'"
    .Refresh
    If .Recordset.AbsolutePosition <> adPosUnknown Then
        Command1.Enabled = False
        If .Recordset.Fields("数量") > 0 Then
            Command2.Enabled = False
            Combo1.Text = ""
            Text3.Text = ""
            Text4.Text = ""
            Text5.Text = ""
            Text6.Text = ""
            Text7.Text = ""
            Text17.Text = "请填写备注"
            MsgBox "该药品或器械库存结余，不能继续入库！"
            Text1.Locked = False
            Text18.Locked = False
            Text18.Text = ""
            Text1.Text = ""
        Else
            Label23.ForeColor = &HFF0000
            Label23.Caption = "库存[" & Text18.Text & "]已空,请增加库存量!"
            Combo1.Locked = True
            Command2.Enabled = True
            Text4.Locked = True
            Text5.Locked = True
            Text2.Text = .Recordset.Fields("规格")
            Combo1.Text = .Recordset.Fields("单位")
            Text3.Text = .Recordset.Fields("数量")
            Text4.Text = .Recordset.Fields("进价")
            Text5.Text = .Recordset.Fields("零售价")
            Text6.Text = .Recordset.Fields("产地")
            Text7.Text = .Recordset.Fields("批号")
        End If
    Else
        Label23.ForeColor = &HFF0000
        Label23.Caption = "库房中没有[" & Text18.Text & "],请添加新品种!"
        Command2.Enabled = False
        Command1.Enabled = True
        Combo1.Locked = False
        Text4.Locked = False
        Text5.Locked = False
        Combo1.Text = ""
        Text3.Text = ""
        Text4.Text = ""
        Text5.Text = ""
        Text6.Text = ""
        Text17.Text = "请填写备注"
    End If
    End With
Else
Command1.Enabled = False
Command2.Enabled = False
Label23.ForeColor = &H12&
Label23.Caption = "代码库中没有[" & Text1.Text & "]这个代码,应先编制代码!"
End If
End With
Exit Sub
err3:
MsgBox "输入了非法字符或数据项填写不完整！"
End Sub
Private Sub Form_Unload(Cancel As Integer)
frmmain.StatusBar1.Panels(2) = "目前没有窗口被激活"
End Sub
Private Sub Form_Activate()
frmmain.StatusBar1.Panels(2) = "活动窗口：" & frminput.Caption
End Sub
Private Sub Text3_GotFocus()
Text3.SelStart = 0
Text3.SelLength = Len(Text3.Text)
End Sub
Private Sub Text4_GotFocus()
Text4.SelStart = 0
Text4.SelLength = Len(Text4.Text)
End Sub
Private Sub Text5_GotFocus()
Text5.SelStart = 0
Text5.SelLength = Len(Text5.Text)
End Sub
Private Sub Text6_GotFocus()
Text6.SelStart = 0
Text6.SelLength = Len(Text6.Text)
End Sub
Private Sub Text7_GotFocus()
Text7.SelStart = 0
Text7.SelLength = Len(Text7.Text)
End Sub
Private Sub Text17_GotFocus()
Text17.SelStart = 0
Text17.SelLength = Len(Text17.Text)
End Sub
Private Sub Text1_GotFocus()
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub
Private Sub Text18_GotFocus()
Text18.SelStart = 0
Text18.SelLength = Len(Text18.Text)
End Sub
Private Sub Text6_Change()
On Error GoTo err0
With Adodc3
.RecordSource = "select 名称,代码 from othercode where 代码='" & Text6.Text & "'"
.Refresh
If .Recordset.AbsolutePosition <> adPosUnknown Then
Text6.Text = .Recordset.Fields("名称")
End If
End With
Exit Sub
err0:
MsgBox "数据库连接失败！"
End Sub
Private Sub Text18_Change()
On Error GoTo err5
With Adodc2
.RecordSource = "select * from " & frmmain.kcode & " where 代码='" & Text18.Text & "'"
.Refresh
If .Recordset.AbsolutePosition <> adPosUnknown Then
    Text1.Text = .Recordset.Fields(1)
    Text1.Locked = True
Else
    Command1.Enabled = False
End If
End With
Exit Sub
err5:
MsgBox "数据库连接失败！"
End Sub