form1.frm

来自「MIS系统开发实例（VB+SQL SERVER2000）」· FRM 代码 · 共 999 行 · 第 1/3 页

         EndProperty
         ForeColor       =   &H00FF0000&
         Height          =   375
         Left            =   6840
         TabIndex        =   15
         Top             =   3840
         Width           =   2295
      End
      Begin VB.Image Image2 
         Height          =   360
         Left            =   6360
         Picture         =   "Form1.frx":294F7A
         Stretch         =   -1  'True
         Top             =   3840
         Width           =   360
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim xs(20) As curxiaoshou
Dim ty(20) As Integer
Dim i%, m%

Private Sub Combo1_LostFocus()
sql = "select cname from namezidian, yaopinjbxx,xiaosdingjia,changjiazidian where namezidian.yno=yaopinjbxx.yno and yaopinjbxx.pk=xiaosdingjia.pk and changjiazidian.cno=yaopinjbxx.cno and yname='" & Trim$(Combo3.Text) & "'and ddanwei='" & Combo1.Text & "'"
Call comadd(sql, "cname", Combo2)
End Sub

Private Sub Combo2_LostFocus()
Call adoopen
sql = "select distinct namezidian.yno,namezidian.yname,leibiezidian.leiname,changjiazidian.cname,kucunjilu.chuchangdate,baozhiqi,kunum,dname,danjia from yaopinjbxx,namezidian,leibiezidian,kucunjilu,danweizidian,changjiazidian where yaopinjbxx.yno=namezidian.yno and yaopinjbxx.lno=leibiezidian.lno and yaopinjbxx.dno=danweizidian.dno and yaopinjbxx.cno=changjiazidian.cno and yaopinjbxx.pk=kucunjilu.pk and yname='" & Trim$(Combo3.Text) & "'"
Call rs(sql)
If Not adors.EOF Then
Label8.Caption = "库中有药！"
Else
Label8.Caption = "库中暂无此药！"
End If
Call adoclose
End Sub



Private Sub Combo3_LostFocus()
sql = "select ddanwei from xiaosdingjia,yaopinjbxx,namezidian where yaopinjbxx.yno=namezidian.yno and xiaosdingjia.pk=yaopinjbxx.pk and yname='" & Combo3.Text & "'"
Call comadd(sql, "ddanwei", Combo1)
End Sub

Private Sub Command1_Click()
Command5.Enabled = True
Command1.Enabled = False
ListView1.ListItems.Clear
Call adoopen
sql = "select yname,cname,ddanwei,curnum,zonge,shoushi,beizhu,yaopinjbxx.pk,ypk,xname from yaopinjbxx,namezidian,changjiazidian,xiaosdingjia,xiaoshou,xiaoshouman where yaopinjbxx.pk=xiaosdingjia.pk and yaopinjbxx.pk=xiaoshou.pk and yaopinjbxx.cno=changjiazidian.cno and yaopinjbxx.yno=namezidian.yno and xiaoshou.xiaono=xiaoshouman.xiaono and fapiaono='" & Text2 & "'and tyinf='0'"
Call rs(sql)
If Not adors.EOF Then
    While Not adors.EOF
          Set x = ListView1.ListItems.Add()
          x.Text = Trim$(adors.Fields("yname"))
          x.SubItems(1) = Trim$(adors.Fields("cname"))
          x.SubItems(2) = Trim$(adors.Fields("ddanwei"))
          x.SubItems(3) = Trim$(adors.Fields("curnum"))
          x.SubItems(4) = Trim$(adors.Fields("zonge"))
          x.SubItems(5) = Trim$(adors.Fields("shoushi"))
          x.SubItems(6) = Trim$(adors.Fields("xname"))
          x.SubItems(7) = Trim$(adors.Fields("ypk"))
          x.SubItems(8) = Trim$(adors.Fields("beizhu"))
          adors.MoveNext
    Wend
End If
Call adoclose
k = 0
End Sub

Private Sub Command2_Click()
If Command6.Enabled = True Then DataEnvironment1.rsCommand1.Close
Call adoopen
sql = "select yaopinjbxx.pk,dingjia from yaopinjbxx,xiaosdingjia,changjiazidian,namezidian where yaopinjbxx.pk=xiaosdingjia.pk and yaopinjbxx.cno=changjiazidian.cno and yaopinjbxx.yno=namezidian.yno  and yname='" & Trim$(Combo3.Text) & "'and ddanwei='" & Combo1.Text & "' and cname='" & Combo2.Text & "'"
Call rs(sql)
If Not adors.EOF Then
dingjia = Val(Trim$(adors.Fields("dingjia")))
xs(i).pk = Trim$(adors.Fields("pk"))
xs(i).shoushi = Now
xs(i).curnum = Text3
xs(i).zonge = Str$(Val(Text3) * dingjia)
Text5 = Val(Text5) + xs(i).zonge
xs(i).renyuan = user
xs(i).beizhu = Text4
xs(i).sign = 1
End If
Call adoclose
i = i + 1
If Combo3.Text <> "" And Combo1.Text <> "" And Combo2.Text <> "" And Text3 <> "" Then
List1.AddItem Combo3.Text & "      " & Combo2.Text & "      " & Combo1.Text & "      " & Str$(dingjia) & "      " & Text3 & "      " & Str$(Val(Text3) * dingjia)

Label8.Caption = ""
Combo3.Text = ""
Text3 = ""
Text4 = ""
Combo1.Clear
Combo2.Clear
End If

End Sub

Private Sub Command3_Click()
If List1.ListCount = 0 Then
   MsgBox "选择销售药品！", vbOKOnly + vbInformation, "提示"
   Exit Sub
End If
If Text6 = "" Then
   MsgBox "还未付款！", vbOKOnly + vbInformation, "提示"
   Text6.SetFocus
   Exit Sub
End If
If Not IsNumeric(Text6) Then
   MsgBox "输入金额有误，请重新输入！", vbOKOnly + vbInformation, "提示"
   Text6 = ""
   Text6.SetFocus
   Exit Sub
End If
Command6.Enabled = True
Dim ypk%, fap%, zonge!
ypk = 1: fap = 1: zonge = 0
i = 0

Picture1.Cls

Call adoopen
sql = "select  ypk from xiaoshou "
Call rs(sql)
If Not adors.EOF Then
    Call adoclose
    Call adoopen
    sql = "select  max(fapiaono) as fapiaono from xiaoshou "
    Call rs(sql)
    If Not adors.EOF Then
        fap = Val(adors.Fields("fapiaono")) + 1
    End If
    Call adoclose
Else
    Call adoclose
End If

For i = 0 To 19
    If xs(i).sign = 1 Then
       xs(i).fapiaono = Str$(fap)
       Call adoopen
       sql = "select *  from xiaoshou"
       Call rs(sql)
       If Not adors.EOF Then
           Call adoclose
           Call adoopen
           sql = "select max(ypk) as dd from xiaoshou"
           Call rs(sql)
           If Not adors.EOF Then
               ypk = Val(Trim$(adors.Fields("dd"))) + 1
           End If
           Call adoclose
       Else
           ypk = 1
           fap = 1
           Call adoclose
       End If
       
       
       xs(i).ypk = Str$(ypk)
       
       
       Call adoopen
       sql = "insert into xiaoshou values('" & xs(i).pk & "','" & xs(i).curnum & "','" & xs(i).shoushi & "','" & xs(i).zonge & "','" & xs(i).renyuan & "','" & xs(i).fapiaono & "','" & xs(i).ypk & "','" & xs(i).beizhu & "','0','')"
       Call rs(sql)
       Call adoclose
    End If
Next i
For i = 0 To 19
    zonge = zonge + Val(xs(i).zonge)
Next i
 sql = "select yname,cname,ddanwei,curnum,dingjia from yaopinjbxx,namezidian,xiaosdingjia,xiaoshou,changjiazidian where yaopinjbxx.cno=changjiazidian.cno and yaopinjbxx.yno=namezidian.yno and xiaosdingjia.pk=yaopinjbxx.pk and xiaoshou.pk=yaopinjbxx.pk and fapiaono='" & xs(0).fapiaono & "'"
 
Call adoopen
adocon.Execute "if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[curxs]') and OBJECTPROPERTY(id, N'IsView') = 1)" & _
               "drop view [dbo].[curxs]"
adocon.Execute "create view curxs as select yname,cname,ddanwei,curnum,dingjia from yaopinjbxx,namezidian,xiaosdingjia,xiaoshou,changjiazidian where yaopinjbxx.cno=changjiazidian.cno and yaopinjbxx.yno=namezidian.yno and xiaosdingjia.pk=yaopinjbxx.pk and xiaoshou.pk=yaopinjbxx.pk and fapiaono='" & xs(0).fapiaono & "'"
adocon.Close
Set adocon = Nothing


Picture1.Print "销售成功！"
Picture1.Print "销售时间：" & Now
Picture1.Print "应    收：" & Str$(zonge) & "元"
Picture1.Print "实    收：" & Text6 & "元"
Picture1.Print "找    零：" & Text7 & "元"
MsgBox "销售成功！", vbOKOnly + vbInformation, "提示"
DataReport1.Sections(2).Controls.Item("Label6").Caption = "药NO-" & xs(0).fapiaono
DataReport1.Sections(5).Controls.Item("Label8").Caption = "销售总金额：" & zonge & "元"
DataReport1.Refresh
i = 0
For j = 0 To 19
    xs(j).beizhu = ""
    xs(j).curnum = ""
    xs(j).fapiaono = ""
    xs(j).pk = ""
    xs(j).renyuan = ""
    xs(j).shoushi = ""
    xs(j).ypk = ""
    xs(j).zonge = ""
    xs(j).sign = 0
Next j
List1.Clear
Combo3.Text = ""
Text3 = ""
Text4 = ""
Text5 = ""
Text6 = ""
Text7 = ""
Combo1.Clear
Combo2.Clear
Label8.Caption = ""
End Sub

Private Sub Command4_Click()
List1.Clear
Label8.Caption = ""
Combo3.Text = ""
Text3 = ""
Text4 = ""
Text5 = ""
Text6 = ""
Text7 = ""
Combo1.Clear
Combo2.Clear
For j = 0 To 19
    xs(j).beizhu = ""
    xs(j).curnum = ""
    xs(j).fapiaono = ""
    xs(j).pk = ""
    xs(j).renyuan = ""
    xs(j).shoushi = ""
    xs(j).ypk = ""
    xs(j).zonge = ""
    xs(j).sign = 0
Next j
i = 0
End Sub

Private Sub Command5_Click()
For k = 0 To 19
    If ty(k) <> 0 Then
        Call adoopen
        sql = "select tyinf,tycourse from xiaoshou where ypk='" & ty(k) & "'"
        Call rs(sql)
        If Not adors.EOF Then
            adors.Fields("tyinf") = 1
            adors.Fields("tycourse") = Text8
            adors.Update
        End If
        Call adoclose
    End If
Next k

ListView1.ListItems.Clear
Text8 = ""
Text2 = ""
Command5.Enabled = False
Command1.Enabled = True

k = 0
Text2.SetFocus
End Sub

Private Sub Command6_Click()
Command6.Enabled = False
DataReport1.Show 1
DataEnvironment1.rsCommand1.Close

End Sub

Private Sub Form_Load()
Text1.Text = "欢迎使用医药销售系统   今日时间：" & Date
m = 10
sql = "select yname from yaopinjbxx,xiaosdingjia,namezidian where yaopinjbxx.pk=xiaosdingjia.pk and yaopinjbxx.yno=namezidian.yno"
Call comadd(sql, "yname", Combo3)
i = 0
For j = 0 To 19
    ty(j) = 0
    xs(j).beizhu = ""
    xs(j).curnum = ""
    xs(j).fapiaono = ""
    xs(j).pk = ""
    xs(j).renyuan = ""
    xs(j).shoushi = ""
    xs(j).ypk = ""
    xs(j).zonge = ""
    xs(j).sign = 0
Next j
End Sub

Private Sub Form_Resize()
Picture2.Width = Width
End Sub

Private Sub ListView1_ItemCheck(ByVal Item As MSComctlLib.ListItem)
If Item.Checked = True Then
    ty(k) = Val(Item.SubItems(7))
    k = k + 1
Else
    k = k - 1
    If k = -1 Then k = 0
    ty(k) = 0
End If

End Sub
Private Sub Text2_GotFocus()
Command1.Enabled = True
Command5.Enabled = False
End Sub

Private Sub Text6_Change()
Text7 = Str$(Val(Text6) - Val(Text5))
End Sub

Private Sub Timer1_Timer()
If Text1.Left >= -Text1.Width Then
Text1.Left = Text1.Left - m
Else
Text1.Left = Picture3.Width
End If
End Sub