frmsale3.frm

自动售药系统

      Height          =   495
      Index           =   0
      Left            =   1680
      Stretch         =   -1  'True
      Top             =   2760
      Width           =   735
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Height          =   495
      Left            =   8880
      TabIndex        =   0
      Top             =   840
      Width           =   975
   End
End
Attribute VB_Name = "frmSale3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit


Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Const MAX_PATH = 260

Private m_DBConn As ADODB.Connection
Private Const BLOCK_SIZE = 10000
Private page As Integer
Public delay_ms As Byte
Public test As Integer
Public test_ok As Byte
Public tx_buf As Byte
Private Function TemporaryFileName() As String
Dim temp_path As String
Dim temp_file As String
Dim length As Long

    ' Get the temporary file path.
    temp_path = Space$(MAX_PATH)
    length = GetTempPath(MAX_PATH, temp_path)
    temp_path = Left$(temp_path, length)

    ' Get the file name.
    temp_file = Space$(MAX_PATH)
    GetTempFileName temp_path, "per", 0, temp_file
    TemporaryFileName = Left$(temp_file, InStr(temp_file, Chr$(0)) - 1)
   'TemporaryFileName = "fdsafas.tmp"
End Function

Private Sub Command1_Click()
Genie.Speak "正在识别请等待......", ""
Dim rs As New ADODB.Recordset
Dim rs1 As New ADODB.Recordset

Dim j As Integer
j = 1
 rs.Source = "select * from SaleTmpDB"
 rs.ActiveConnection = Constr
 rs.Open
 'If rs.EOF Then rs.Cose: Exit Sub
    While Not rs.EOF
    
    
    rs1.Source = "select * from DrugsDB where Drugid='" & rs!DrugID & "'"
    rs1.ActiveConnection = Constr
    rs1.Open
    If Not rs1.EOF Then
          Call Sleep(5000)
           Text5.Text = rs1!sgd
           addsale (rs!DrugID)
         rs1.Close
         End If
    
    
    rs.MoveNext
    Wend
   rs.Close
   delcart
   Genie.Speak "请在取药口取出您所购买的药品，请在找零口取出您的找零.", ""
  ' Unload Me
   Call Sleep(1000)
    Genie.Speak "谢谢您使用自动诊疗咨询售药机。期待您的再次光临", ""
  ' Unload frmSale2
   'Unload frmSale
'Text4.Text = gd
'if then
'addsale
'end if
End Sub

Private Sub Form_Load()
 Genie.Show
    Genie.Speak " 请放入相应的购药款1、本机收取纸币面额为5元10元20元。纸币请平铺放入纸币口2、本机收取硬币面额为1元5角，请逐个投入硬币口", ""
    'Genie.Speak "如果您要寻找对应的药品类别，请点击药品分类进行查找", ""
loaddata
   
     If Me.MSComm1.PortOpen Then
        Me.MSComm1.PortOpen = False
        End If
test_ok = 0
End Sub

Private Sub Label1_Click()
Unload Me
End Sub

Function closepic()
Dim p As Integer
For p = 0 To 4 Step 1
Image1(p).Visible = False
Text1(p).Visible = False
Text3(p).Visible = False
Text4(p).Visible = False
Next
End Function

Private Sub Picture2_Click()

End Sub

Private Sub Picture3_Click()
Unload Me
End Sub

Private Sub Picture4_Click()
delcart
 'rs.Close
Unload Me
End Sub

Private Sub Timer1_Timer()
delay_ms = delay_ms + 1
If delay_ms > 10 Then
delay_ms = 0
End If
End Sub

Private Sub Timer2_Timer()
Timer2.Enabled = False
reset
If ValBit(CL_FOOD(0), 0) Then
command1.Enabled = False
End If
'If ValBit(CL_FOOD(0), 1) Then
'Command2.Enabled = False
'End If
Timer2.Enabled = True
End Sub
Public Sub reset()    '一个简单的数组传递
 Dim databyte(2) As Byte
databyte(0) = &H88
databyte(1) = CByte(Text5.Text)
databyte(2) = databyte(0) + databyte(1)



     If Not Me.MSComm1.PortOpen Then
        Me.MSComm1.PortOpen = True
    End If
    Me.MSComm1.InputMode = comInputModeBinary
    Me.MSComm1.RThreshold = 16
   
    
    Me.MSComm1.Settings = "9600,m,8,1" 'mode bit 1
    Me.MSComm1.Output = databyte
      '  Text2.Text = ""
    Me.MSComm1.Settings = "9600,m,8,1"
End Sub

Function addsale(ypid As String)
Dim m, d
m = Month(Date)
d = Day(Date)
If m < 10 Then
m = "0" & m
End If
If d < 10 Then
d = "0" & d
End If
Dim rs As New ADODB.Recordset

 rs.Source = "select * from SaleDB"
 rs.ActiveConnection = Constr
  rs.CursorType = adOpenKeyset
 rs.LockType = adLockOptimistic
 rs.Open
 rs.AddNew
 rs.Fields(1).Value = ypid
 rs.Fields(2).Value = 1
 rs.Fields(3).Value = Year(Date) & m & d
 rs.Update
  rs.Close
  rs.Source = "select * from DrugsDB  where DrugID='" & ypid & "'"
 rs.ActiveConnection = Constr
  rs.CursorType = adOpenKeyset
 rs.LockType = adLockOptimistic
 rs.Open
 rs!StoreNum = rs!StoreNum - 1
 rs.Update
  rs.Close
End Function
Private Sub MSComm1_OnComm()
 Dim intInputLen As Integer
    Dim temp As String
    Dim i As Integer
    
    
        
        intInputLen = MSComm1.InBufferCount
        If intInputLen = 0 Then
            Exit Sub
        End If
    
     If intInputLen > 15 Then
        MyArr = MSComm1.Input
        CL_FOOD(0) = MyArr(2)
        CL_FOOD(1) = MyArr(3)
        CL_FOOD(2) = MyArr(4)
        CL_FOOD(3) = MyArr(5)
        CL_FOOD(4) = MyArr(6)
        CL_FOOD(5) = MyArr(7)
       ' if received cl message then clear text.tx
       If MyArr(14) = CByte(Text5.Text) Then
       
       Text5.Text = 0
       
       
       End If
       'money display still not correct now
        Text6.Text = MyArr(11)
        'BELOW command enable
        If MyArr(11) >= 10 Then
        command1.Enabled = True
        'Command2.Enabled = True
        End If
        
        
        If test < 2 Then
        test = CInt(MyArr(13))
        End If
        If intInputLen = 0 Then
            Exit Sub
        End If
     End If
     
End Sub

Function loaddata()
closepic
Dim rs As New ADODB.Recordset
Dim rs1 As New ADODB.Recordset
Dim Chunk() As Byte
Const ChunkSize As Integer = 2384
Dim DataFile As Integer, Chunks, Fragment As Integer
Dim MediaTemp As String
Dim lngOffset, lngTotalSize As Long
Dim m As Integer
Dim price As Double

Dim j As Integer
price = 0
j = 1
 page = 1
 rs.Source = "select top 5 * from SaleTmpDB"
 rs.ActiveConnection = Constr
 rs.Open
 'If rs.EOF Then rs.Cose: Exit Sub
    While Not rs.EOF
    rs1.Source = "select * from DrugsDB where Drugid='" & rs!DrugID & "'"
    rs1.ActiveConnection = Constr
    rs1.Open
    If Not rs1.EOF Then
            MediaTemp = TemporaryFileName()
            DataFile = 1
            Open MediaTemp For Binary Access Write As DataFile
            
            lngTotalSize = rs1!sPicture.ActualSize
            If lngTotalSize = 0 Then
            Close DataFile
            GoTo act1
            End If
            Chunks = lngTotalSize \ ChunkSize
            Fragment = lngTotalSize Mod ChunkSize
            ReDim Chunk(Fragment)
            Chunk() = rs1!sPicture.GetChunk(Fragment)
            Put DataFile, , Chunk()
            For m = 1 To Chunks
            ReDim Chunk(ChunkSize)
            Chunk() = rs1!sPicture.GetChunk(ChunkSize)
            Put DataFile, , Chunk()
            Next m
            Close DataFile

'rs.Close
       
        Image1(j - 1).Picture = LoadPicture(MediaTemp)
        Image1(j - 1).Visible = True
act1:
        If lngTotalSize = 0 Then
        Image1(j - 1).Picture = LoadPicture(App.Path & "\3.gif")
         Image1(j - 1).Visible = True
        End If
       ' If Picture1.Picture = 0 Then Exit Sub
      '  Image1(j - 1).Picture = LoadPicture(load_pic(rs!Name))
           Text1(j - 1).Text = rs1!Name '& rs1!autoprice & "元/" & rs1!unit
           Text1(j - 1).Tag = rs1!DrugID
           Text1(j - 1).ToolTipText = rs1!sgd
           Text1(j - 1).Visible = True
           Text3(j - 1).Text = rs1!autoprice
           price = price + rs1!autoprice
           Text3(j - 1).Visible = True
           Text4(j - 1).Text = 1
           Text4(j - 1).Visible = True
         j = j + 1
         Kill MediaTemp
         rs1.Close
         End If
         rs.MoveNext
        
    Wend
   rs.Close
   Text2.Text = "共有" & j - 1 & "件药品，合计：" & price
End Function
Function delcart()
Dim rs As New ADODB.Recordset

 rs.Source = "delete SaleTmpDB"
 rs.ActiveConnection = Constr
  rs.CursorType = adOpenKeyset
 rs.LockType = adLockOptimistic
 rs.Open
End Function