Public ImgPath As StringPublic Function LoadBImage(ByVal NewForm As Form, _                           ByVal NewID As String, _                           ByVal NewIDValue As Variant, _                           ByVal NewField As String, _                           ByVal NewImage As Image)'==============================================================================='-函数名称:     LoadBImage'-功能描述:     以二进制数据格式加载图片,并保存于数据库,一般为当前数据库,'               若窗体引用记录集为外部ACCESS数据库,同样适用,调用函数SaveImage'-输入参数说明: 参数1: 必选 应用显示图片的窗体,[对象变量]'               参数2: 必选 窗体记录集的主键名,[文本变量]'               参数3: 必选 窗体某一记录的主键值,一般为当前记录,[未定义变量]'               参数4: 必选 图片所在的字段名,[文本变量]'               参数5: 必选 应用显示的图片控件,[对象变量]'-返回参数说明: 无'-使用语法示例: Call LoadBImage(Me, "id", me.id, "图片", me.image1)'-参考:'-使用注意:     NewForm, NewImage 为对象，使用时不能加引号'               因为要使用文本流对象,请使用前引用 Microsoft ActiveX Objects 2.5以上'-兼容性:       2000,XP,2003 compatible'-作者:         duomu'-更新日期：    2007-09-6'===============================================================================    Dim result As Integer    Dim FileName As String    On Error GoTo HandleErr    If Len(ImgPath) = 0 Then ImgPath = CurrentProject.Path    With Application.FileDialog(1)        .Title = "选择照片"        .Filters.Clear        .Filters.Add "所有文件", "*.*"        .Filters.Add "JPEGs", "*.jpg"        .Filters.Add "位图文件", "*.bmp"        .FilterIndex = 2        .AllowMultiSelect = False        .InitialFileName = ImgPath        result = .Show        If result = -1 Then            FileName = Trim(.SelectedItems.Item(1))            Call SaveBImage(FileName, NewForm, NewID, NewIDValue, NewField, NewImage)        Else            LoadBImage = 1            Exit Function        End If        ImgPath = FileName        NewImage.Picture = FileName    End WithExitHere:    Exit FunctionHandleErr:    MsgBox Err.Description    Resume ExitHereEnd FunctionPublic Function SaveBImage(ByVal FileName As String, _                           ByVal NewForm As Form, _                           ByVal NewID As String, _                           ByVal NewIDValue As Variant, _                           ByVal NewField As String, _                           ByVal NewImage As Image)'==============================================================================='-函数名称:     SaveBImage'-功能描述:     以二进制数据格式加载图片,并保存于数据库,一般为当前数据库,'               若窗体引用记录集为外部ACCESS数据库,同样适用,调用函数SaveImage'-输入参数说明: 参数1: 必选 图片路径,[文本变量]'               参数2: 必选 应用显示图片的窗体,[对象变量]'               参数3: 必选 窗体记录集的主键名,[文本变量]'               参数4: 必选 窗体某一记录的主键值,一般为当前记录,[未定义变量]'               参数5: 必选 图片所在的字段名,[文本变量]'               参数6: 必选 应用显示的图片控件,[对象变量]'-返回参数说明: 无'-使用语法示例: 略'-参考:         LoadBImage()过程'-使用注意:     NewForm, NewImage 为对象，使用时不能加引号'               因为要使用文本流对象,请使用前引用 Microsoft ActiveX Objects 2.5以上'-兼容性:       2000,XP,2003 compatible'-作者:         duomu'-更新日期：    2007-09-6'===============================================================================    Dim ObjRst As DAO.Recordset    Dim ObjStream As ADODB.Stream    On Error GoTo HandleErr    Set ObjRst = NewForm.Recordset    Set ObjStream = New ADODB.Stream    If Not IsNull(FileName) Then        With ObjStream            .Type = adTypeBinary            .Open            .LoadFromFile FileName        End With    End If    If ObjRst.Fields(NewID).Type = dbText Then        ObjRst.FindFirst "[" & NewID & "]" & " = '" & NewIDValue & "'"    Else        ObjRst.FindFirst "[" & NewID & "]" & " = " & NewIDValue    End If    If Not ObjRst.NoMatch Then        ObjRst.Edit        ObjRst(NewField) = ObjStream.Read        ObjRst.Update    End If    ObjStream.Close    Set ObjStream = NothingExitHere:    Exit FunctionHandleErr:    MsgBox Err.Description    Resume ExitHereEnd FunctionPublic Function DisplayBImage(ByVal NewForm As Form, _                              ByVal NewID As String, _                              ByVal NewIDValue As Variant, _                              ByVal NewField As String, _                              ByVal NewImage As Image)'==============================================================================='-函数名称:     DisplayBImage'-功能描述:     显示以二进制数据格式保存在数据库内的图片'-输入参数说明: 参数1: 必选 应用显示图片的窗体,[对象变量]'               参数2: 必选 窗体记录集的主键名,[文本变量]'               参数3: 必选 窗体某一记录的主键值,一般为当前记录,[未定义变量]'               参数4: 必选 图片所在的字段名,[文本变量]'               参数5: 必选 应用显示的图片控件,[对象变量]'-返回参数说明: 无'-使用语法示例: Call DisplayBImage(Me, "id", me.id, "图片", me.image1)'-参考:'-使用注意:     NewForm, NewImage 为对象，使用时不能加引号'               因为要使用文本流对象,请使用前引用 Microsoft ActiveX Objects 2.5以上'-兼容性:       2000,XP,2003 compatible'-作者:         duomu'-更新日期：    2007-09-6'===============================================================================    Dim ObjRst As DAO.Recordset    Dim ObjStream As ADODB.Stream    On Error GoTo HandleErr    Set ObjRst = NewForm.Recordset    Set ObjStream = New ADODB.Stream    If IsNull(NewIDValue) Then NewImage.Picture = "": Exit Function    If ObjRst.Fields(NewID).Type = dbText Then        ObjRst.FindFirst "[" & NewID & "]" & " = '" & NewIDValue & "'"    Else        ObjRst.FindFirst "[" & NewID & "]" & " = " & NewIDValue    End If    If Not ObjRst.NoMatch Then        If Len(ObjRst(NewField)) > 0 Then            With ObjStream                .Mode = adModeReadWrite                .Type = adTypeBinary                .Open                .Write ObjRst(NewField)                .SaveToFile CurrentProject.Path & "\image.jpg", adSaveCreateOverWrite            End With        Else            NewImage.Picture = ""            Exit Function        End If    End If    NewImage.Picture = CurrentProject.Path & "\image.jpg"    NewImage.SizeMode = acOLESizeZoom    ObjStream.Close    Kill CurrentProject.Path & "\image.jpg"    Set ObjStream = NothingExitHere:    Exit FunctionHandleErr:    MsgBox Err.Description    Resume ExitHereEnd FunctionPublic Function DeleteBImage(ByVal NewForm As Form, _                             ByVal NewID As String, _                             ByVal NewIDValue As Variant, _                             ByVal NewField As String, _                             ByVal NewImage As Image)'==============================================================================='-函数名称:     LoadImage'-功能描述:     删除以二进制数据格式保存在数据库内的图片'-输入参数说明: 参数1: 必选 应用显示图片的窗体,[对象变量]'               参数2: 必选 窗体记录集的主键名,[文本变量]'               参数3: 必选 窗体某一记录的主键值,一般为当前记录,[未定义变量]'               参数4: 必选 图片所在的字段名,[文本变量]'               参数5: 必选 应用显示的图片控件,[对象变量]'-返回参数说明: 无'-使用语法示例: Call LoadImage(Me, "id", me.id, "图片", me.image1)'-参考:'-使用注意:     NewForm, NewImage 为对象，使用时不能加引号'               因为要使用文本流对象,请使用前引用 Microsoft ActiveX Objects 2.5以上'-兼容性:       2000,XP,2003 compatible'-作者:         duomu'-更新日期：    2007-09-6'===============================================================================    Dim ObjRst As DAO.Recordset    On Error GoTo HandleErr    Set ObjRst = NewForm.Recordset    If ObjRst.Fields(NewID).Type = dbText Then        ObjRst.FindFirst "[" & NewID & "]" & " = '" & NewIDValue & "'"    Else        ObjRst.FindFirst "[" & NewID & "]" & " = " & NewIDValue    End If    If Not ObjRst.NoMatch Then        ObjRst.Edit        ObjRst(NewField) = ""        ObjRst.Update    End If    NewImage.Picture = ""ExitHere:    Exit FunctionHandleErr:    MsgBox Err.Description    Resume ExitHereEnd Function