frmsale.frm

自动售药系统

    TemporaryFileName = Left$(temp_file, InStr(temp_file, Chr$(0)) - 1)
   'TemporaryFileName = "fdsafas.tmp"
End Function
Private Sub Form_Load()

closepic
Dim rs 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 j As Integer
j = 1
 page = 1
 rs.Source = "select top 15 * from DrugsDB where sgd>0 order by sgd"
 rs.ActiveConnection = Constr
 rs.Open
 'If rs.EOF Then rs.Cose: Exit Sub
    While Not rs.EOF
            MediaTemp = TemporaryFileName()
            DataFile = 1
            Open MediaTemp For Binary Access Write As DataFile
            
            lngTotalSize = rs!sPicture.ActualSize
            If lngTotalSize = 0 Then
            Close DataFile
            GoTo act1
            End If
            Chunks = lngTotalSize \ ChunkSize
            Fragment = lngTotalSize Mod ChunkSize
            ReDim Chunk(Fragment)
            Chunk() = rs!sPicture.GetChunk(Fragment)
            Put DataFile, , Chunk()
            For m = 1 To Chunks
            ReDim Chunk(ChunkSize)
            Chunk() = rs!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 = rs!Name & rs!StorePrice & "元/" & rs!unit
           Text1(j - 1).Tag = rs!DrugID
           Text1(j - 1).ToolTipText = rs!sgd
           Text1(j - 1).Visible = True
         j = j + 1
         Kill MediaTemp
         rs.MoveNext
        
    Wend
   rs.Close
     ' Genie.Show
     Genie.Speak "如果您要寻找对应的药品类别，请点击药品分类进行查找", ""

   ' Genie.Speak "请选择您要购买的药品并点击药品图片", ""
    'Call Sleep(2000)
   ' Genie.Speak "如果您要寻找对应的药品类别，请点击药品分类进行查找", ""
   Image2(0).Picture = LoadPicture(App.Path & "\saleimg\gm.gif")
   Image2(1).Picture = LoadPicture(App.Path & "\saleimg\fx.gif")
   Image2(2).Picture = LoadPicture(App.Path & "\saleimg\js.gif")
   Image2(3).Picture = LoadPicture(App.Path & "\saleimg\hp.gif")
   Image2(4).Picture = LoadPicture(App.Path & "\saleimg\ws.gif")
   Image2(5).Picture = LoadPicture(App.Path & "\saleimg\rg.gif")
   Image2(6).Picture = LoadPicture(App.Path & "\saleimg\by.gif")
   Image2(7).Picture = LoadPicture(App.Path & "\saleimg\xy.gif")
   Image2(8).Picture = LoadPicture(App.Path & "\saleimg\zt.gif")
   Image2(9).Picture = LoadPicture(App.Path & "\saleimg\xe.gif")
   Image2(10).Picture = LoadPicture(App.Path & "\saleimg\zk.gif")
End Sub


Private Sub Image1_Click(Index As Integer)
Dim Today, m, d, h, f, s
m = Month(Date)
d = Day(Date)
If m < 10 Then
m = "0" & m
End If
If d < 10 Then
d = "0" & d
End If
h = Hour(Time)
If h < 10 Then
h = "0" & h
End If
f = Minute(Time)
If f < 10 Then
f = "0" & f
End If
s = Second(Time)
If s < 10 Then
s = "0" & s
End If
Today = Year(Date) & m & d & h & f & s
'MsgBox Today
If Not startg Then
tempid = Today
startg = True
End If
frmSale2.gd = Text1(Index).ToolTipText
frmSale2.ypstr = Text1(Index).Tag
frmSale2.Show (1)
End Sub

Private Sub Image2_Click(Index As Integer)
closepic
Dim rs 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 j As Integer
j = 1
 
 rs.Source = "select top 15 * from DrugsDB where stype='" & Lfl(Index).Tag & "' and sgd>0 order by sgd"
 rs.ActiveConnection = Constr
 rs.Open
 'If rs.EOF Then rs.Cose: Exit Sub
    While Not rs.EOF
            MediaTemp = TemporaryFileName()
            DataFile = 1
            Open MediaTemp For Binary Access Write As DataFile
            
            lngTotalSize = rs!sPicture.ActualSize
            If lngTotalSize = 0 Then
            Close DataFile
            GoTo act1
            End If
            Chunks = lngTotalSize \ ChunkSize
            Fragment = lngTotalSize Mod ChunkSize
            ReDim Chunk(Fragment)
            Chunk() = rs!sPicture.GetChunk(Fragment)
            Put DataFile, , Chunk()
            For m = 1 To Chunks
            ReDim Chunk(ChunkSize)
            Chunk() = rs!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")
        End If
      Text1(j - 1).Text = rs!Name & rs!StorePrice & "元/" & rs!unit
      Text1(j - 1).ToolTipText = rs!sgd
           Text1(j - 1).Tag = rs!DrugID
           Text1(j - 1).Visible = True
         j = j + 1
         Kill MediaTemp
         rs.MoveNext
        
    Wend
   rs.Close
   Lfl(Index).ForeColor = &HFF&
End Sub

Private Sub Label1_Click()
Unload Me
End Sub


Private Sub Label2_Click()

End Sub

Private Sub Label6_Click()
closepic
Dim rs 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 j As Integer
j = 1

 rs.Source = "SELECT TOP 15 * From DrugsDB WHERE (sgd NOT IN (SELECT TOP 15 sgd From DrugsDB where sgd>0 ORDER BY sgd)) and sgd>0 ORDER BY sgd"
 rs.ActiveConnection = Constr
 rs.Open
 If Not rs.EOF Then
 page = page + 1
 End If
    While Not rs.EOF
            MediaTemp = TemporaryFileName()
            DataFile = 1
            Open MediaTemp For Binary Access Write As DataFile
            
            lngTotalSize = rs!sPicture.ActualSize
            If lngTotalSize = 0 Then
            Close DataFile
            GoTo act1
            End If
            Chunks = lngTotalSize \ ChunkSize
            Fragment = lngTotalSize Mod ChunkSize
            ReDim Chunk(Fragment)
            Chunk() = rs!sPicture.GetChunk(Fragment)
            Put DataFile, , Chunk()
            For m = 1 To Chunks
            ReDim Chunk(ChunkSize)
            Chunk() = rs!sPicture.GetChunk(ChunkSize)
            Put DataFile, , Chunk()
            Next m
            Close DataFile

'rs.Close
        If MediaTemp = "" Then Exit Sub
        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
           Text1(j - 1).Text = rs!Name & rs!StorePrice & "元/" & rs!unit
           Text1(j - 1).Tag = rs!DrugID
           Text1(j - 1).ToolTipText = rs!sgd
           Text1(j - 1).Visible = True
         j = j + 1
         rs.MoveNext
        
    Wend
   rs.Close
    
    
End Sub

Private Sub Label7_Click()
closepic
Dim rs 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 j As Integer
j = 1
 
 rs.Source = "select top 15 * from DrugsDB where sgd>0 order by sgd"
 rs.ActiveConnection = Constr
 rs.Open
 'If rs.EOF Then rs.Cose: Exit Sub
    While Not rs.EOF
            MediaTemp = TemporaryFileName()
            DataFile = 1
            Open MediaTemp For Binary Access Write As DataFile
            
            lngTotalSize = rs!sPicture.ActualSize
            If lngTotalSize = 0 Then
            Close DataFile
            GoTo act1
            End If
            Chunks = lngTotalSize \ ChunkSize
            Fragment = lngTotalSize Mod ChunkSize
            ReDim Chunk(Fragment)
            Chunk() = rs!sPicture.GetChunk(Fragment)
            Put DataFile, , Chunk()
            For m = 1 To Chunks
            ReDim Chunk(ChunkSize)
            Chunk() = rs!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
      Text1(j - 1).Text = rs!Name & rs!StorePrice & "元/" & rs!unit
           Text1(j - 1).Tag = rs!DrugID
           Text1(j - 1).ToolTipText = rs!sgd
           Text1(j - 1).Visible = True
         j = j + 1
         Kill MediaTemp
         rs.MoveNext
        
    Wend
   rs.Close
    

End Sub



Private Sub Lfl_Click(Index As Integer)
closepic
Dim rs 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 j As Integer
j = 1
 
 rs.Source = "select top 15 * from DrugsDB where stype='" & Lfl(Index).Tag & "' and sgd>0 order by sgd"
 rs.ActiveConnection = Constr
 rs.Open
 'If rs.EOF Then rs.Cose: Exit Sub
    While Not rs.EOF
            MediaTemp = TemporaryFileName()
            DataFile = 1
            Open MediaTemp For Binary Access Write As DataFile
            
            lngTotalSize = rs!sPicture.ActualSize
            If lngTotalSize = 0 Then
            Close DataFile
            GoTo act1
            End If
            Chunks = lngTotalSize \ ChunkSize
            Fragment = lngTotalSize Mod ChunkSize
            ReDim Chunk(Fragment)
            Chunk() = rs!sPicture.GetChunk(Fragment)
            Put DataFile, , Chunk()
            For m = 1 To Chunks
            ReDim Chunk(ChunkSize)
            Chunk() = rs!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")
        End If
      Text1(j - 1).Text = rs!Name & rs!autoprice & "元/" & rs!unit
      Text1(j - 1).ToolTipText = rs!sgd
           Text1(j - 1).Tag = rs!DrugID
           Text1(j - 1).Visible = True
         j = j + 1
         Kill MediaTemp
         rs.MoveNext
        
    Wend
   rs.Close
   Lfl(Index).ForeColor = &HFF&
End Sub
Function closepic()
Dim p As Integer
For p = 0 To 14 Step 1
Image1(p).Visible = False
Text1(p).Visible = False
Next
End Function

Private Sub Lfl_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
Lfl(Index).ForeColor = &HFFFFFF
End Sub

Private Sub Text1_Change(Index As Integer)
'frmSale2.gd = Text1(Index).ToolTipText
'frmSale2.ypstr = Text1(Index).Tag
'frmSale2.Show (1)
End Sub

Private Sub Timer1_Timer()
startg = False
End Sub