form1.frm

把图片写入数据库 "VB6"和 MS 数据库 2003

    txtNotes = "" & rsEMP("Notes")
    
    ReadPictureData
    
    Me.MousePointer = vbNormal
      
End Sub



'*****************************************************************************
'* ReadPictureData()
' --The procedure reads the bianry picture data from the DB and generates
'*  a temp image file on the user's local machine and then displays that
'*  temp image file in the Image control
'*****************************************************************************
Private Sub ReadPictureData()
                
    Dim diskFile As String
    diskFile = App.Path & "\temp\emp.bmp"
    
    Dim tempDir As String
    tempDir = Dir(App.Path & "\temp", vbDirectory)
    
    If tempDir = "" Then
        MkDir App.Path & "\temp"
    End If
    
    ' Delete the temp picture file.
    If Len(Dir$(diskFile)) > 0 Then
       Kill diskFile
    End If
   
    'Get the Phot size
    fileSize = rsEMP("Photo").ActualSize
    
    'Get a free file handle
    Dim destfileNum As Long
    destfileNum = FreeFile
    
    'Open the file
    Open diskFile For Binary As destfileNum
    
    'Calculate the number of blocks (100000 bytes blocks)
    Dim pictBlocks  As Integer
    pictBlocks = fileSize / BLOCK_SIZE
            
    'Calculate the left over data
    Dim leftOverData As Long
    leftOverData = fileSize Mod BLOCK_SIZE
    
    'Byte array for Picture data.
    Dim pictData() As Byte
    'Get the left over data first
    pictData() = rsEMP("Photo").GetChunk(leftOverData)
    
    'write the binary picture data from a variable to disk file
    Put destfileNum, , pictData()
    
    Dim i
    
    'Now get the remaining binary picture data in Blocks of 100000
    For i = 1 To pictBlocks
        pictData() = rsEMP("Photo").GetChunk(BLOCK_SIZE)
        Put destfileNum, , pictData()
    Next i
    
    'Close the file handle
    Close destfileNum
    
    'Load the temp Picture into the Image control
    Image1.Picture = LoadPicture(App.Path & "\temp\emp.bmp")
    
End Sub



Private Sub cmdFirst_Click()

    If rsEMP.State = adStateOpen Then
        
        On Error Resume Next
        
        rsEMP.MoveFirst
        
        If Not rsEMP.EOF Then
            ClearFields
            FillFields
            cmdSave.Enabled = False
        End If
        
    End If
    
End Sub



Private Sub cmdLast_Click()

    If rsEMP.State = adStateOpen Then
        On Error Resume Next
            
        rsEMP.MoveLast
        
        If Not rsEMP.EOF Then
            ClearFields
            FillFields
            cmdSave.Enabled = False
        End If
        
    End If
    
End Sub



Private Sub cmdNext_Click()

    If rsEMP.State = adStateOpen Then
    
        On Error Resume Next
        
        rsEMP.MoveNext
        
        If Not rsEMP.EOF Then
            ClearFields
            FillFields
            
            cmdSave.Enabled = False
        Else
            rsEMP.MoveLast
            If Not rsEMP.BOF Then
                ClearFields
                FillFields
                
                cmdSave.Enabled = False
            End If
        End If
    End If
    
End Sub



Private Sub cmdPrevious_Click()

    If rsEMP.State = adStateOpen Then
        On Error Resume Next
        
        rsEMP.MovePrevious
        
        If Not rsEMP.BOF Then
            ClearFields
            FillFields
            
            cmdSave.Enabled = False
        Else
            rsEMP.MoveFirst
            If Not rsEMP.EOF Then
                ClearFields
                FillFields
                
                cmdSave.Enabled = False
            End If
        End If
    End If
    
End Sub



Private Sub cmdClear_Click()
    ClearFields
    cmdSave.Enabled = True
End Sub



Private Sub cmdSave_Click()

    ' This procedure Saves the employee information to the DB.
    ' converts that Image file to a Byte array, and saves the Byte
    ' Array to the table using the Appendchunk method.
    
    'Validate the employee information
    If ValidateData = False Then
        
        Exit Sub
           
    Else
        
        Me.MousePointer = vbHourglass
        
        'Get a Free file handle
        Dim sourceFile As Integer
        sourceFile = FreeFile
          
        'Open the Photo
        Open fileName For Binary Access Read As sourceFile
        
        'Get the size of the file in bytes
        fileSize = LOF(sourceFile)
                     
        If fileSize = 0 Then
    
            Close sourceFile
              
            MsgBox "Employee's Photo is invalid"
            Exit Sub
              
        Else
        
            'Calculate the number of blocks (100000 bytes blocks)
            Dim pictBlocks  As Integer
            pictBlocks = fileSize / BLOCK_SIZE
            
            'Calculate the left over data
            Dim leftOverData As Long
            leftOverData = fileSize Mod BLOCK_SIZE
    
            'Byte array for Picture data.
            Dim pictData() As Byte
            ReDim pictData(leftOverData)
            
            'Reads data from an open disk file into pictData()
            Get sourceFile, , pictData()
              
              
            'Save the Employee Information
            rsEMP.AddNew
            'Appends the Left Over binary picture data to the Photo field
            'in the employee table
            rsEMP("Photo").AppendChunk pictData()
            
            ReDim pictData(BLOCK_SIZE)
            
            Dim i As Integer
            
            For i = 1 To pictBlocks
                'Read the picture data in blocks of 100000 bytes
                Get sourceFile, , pictData()
                'appends the binary picture data the Photo field
                rsEMP("Photo").AppendChunk pictData()
            Next i
                        
            rsEMP("FirstName") = txtFName
            rsEMP("MiddleName") = txtMName
            rsEMP("LastName") = txtLName
            rsEMP("SSN") = txtSSN
            rsEMP("Notes") = txtNotes
            
            'Update the data
            rsEMP.Update
                                   
            'close the file handle
            Close sourceFile
            
        End If
        
        Me.MousePointer = vbNormal
        
        'Clear the form
        ClearFields
        
        MsgBox "Employee Information Saved Successfully"
        
    End If
    
End Sub



Private Sub Form_Unload(Cancel As Integer)

    'Close and terminate the conection and recordset objects
    If rsEMP.State = adStateOpen Then rsEMP.Close
    Set rsEMP = Nothing
    
    If cnnEmp.State = adStateOpen Then cnnEmp.Close
    Set cnnEmp = Nothing
    
End Sub



Private Sub Image1_DblClick()
    
    ' Retrieve the picture and update the record.
    CommonDialog1.Filter = "(*.bmp;*.ico;*.gif;*.jpg)|*.bmp;*.ico;*.gif;*.jpg"
    CommonDialog1.ShowOpen
    
    fileName = CommonDialog1.fileName
    
    If fileName <> "" Then
        Set Image1.Picture = LoadPicture(fileName)
    End If
            
End Sub

'v1.1 changes
Private Sub Image1_OLEDragOver(Data As DataObject, _
                              Effect As Long, _
                              Button As Integer, _
                              Shift As Integer, _
                              X As Single, _
                              Y As Single, _
                              State As Integer)
    
    'vset a drag drop effect
    If Data.GetFormat(vbCFFiles) Then
        Effect = vbDropEffectCopy And Effect
        Exit Sub
    End If
    
    Effect = vbDropEffectNone

End Sub



Private Sub Image1_OLEDragDrop(Data As DataObject, _
                              Effect As Long, _
                              Button As Integer, _
                              Shift As Integer, _
                              X As Single, _
                              Y As Single)
    
    'if File list from Windows Explorer
    If Data.GetFormat(vbCFFiles) Then
    
        Dim vFN

        For Each vFN In Data.Files
            Dim fileExt As String
            
            'get the file ext
            fileExt = Mid(vFN, InStrRev(vFN, ".") + 1, Len(vFN))
            
            Select Case UCase(fileExt)
                Case "BMP", "GIF", "JPEG", "JPG", "WMF", "TIF", "PNG"
                    Set Image1.Picture = LoadPicture(vFN)
                    fileName = vFN
            End Select
                            
        Next vFN
        
    End If
    
End Sub
'end of v1.1 changes