Office中国论坛/Access中国论坛

标题: 通用模块:读取图片文件并保存到OLE字段中 [打印本页]

作者: duomu 时间: 2008-2-1 17:53
标题: 通用模块:读取图片文件并保存到OLE字段中
带示例文件,请各位朋友多多指正

Public ImgPath As String
Public 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 With
ExitHere:
Exit Function
HandleErr:
MsgBox Err.Description
Resume ExitHere
End Function
Public 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 = Nothing
ExitHere:
Exit Function
HandleErr:
MsgBox Err.Description
Resume ExitHere
End Function
Public 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 = Nothing
ExitHere:
Exit Function
HandleErr:
MsgBox Err.Description
Resume ExitHere
End Function
Public 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 Function
HandleErr:
MsgBox Err.Description
Resume ExitHere
End Function

作者: 真主 时间: 2008-2-1 18:31
谢谢，真的非常感谢！

作者: 5988143 时间: 2008-2-1 18:31
好东东,收藏了!
谢谢分享 !

作者: tmtony 时间: 2008-2-1 19:24
谢谢分享

作者: andymark 时间: 2008-2-1 20:28
谢谢分享！！

作者: sunny-xie 时间: 2008-2-2 14:15
这是不是说,可以把图片保存在库里,而不用单独的把图片保存在一个文件夹和后台放在一起了?

作者: baije 时间: 2008-2-2 14:33
好东西，收了。。。。。
谢谢

作者: aone 时间: 2008-2-3 23:38
好东西赶紧收藏！

作者: hosam 时间: 2008-7-24 10:25
谢谢分享～～～～

作者: zzcjp 时间: 2008-9-27 17:22
好东东，收藏了！

作者: rcylbx 时间: 2008-9-27 20:45
好东东，收藏了

作者: bpchan 时间: 2008-10-28 12:11
标题: hh
hhhhhhhhhh

作者: 7777777 时间: 2008-11-22 17:43
东东,收藏了!
谢谢分享 !

作者: sunwrsun 时间: 2008-11-23 03:45
非常感谢！

作者: liuxinquan 时间: 2009-3-27 16:35
谢谢，真的非常感谢！

作者: wangzi2010 时间: 2009-3-31 12:47

1# duomu

作者: 陈大林 时间: 2009-4-5 15:06
看看

作者: liuxinquan 时间: 2009-4-15 12:08
谢谢，真的非常感谢！

作者: 最怕冷 时间: 2009-4-20 22:15
好东西,受教了

作者: wzh 时间: 2009-4-22 13:09
好东东,收藏了!
谢谢分享

作者: 快乐王 时间: 2009-4-24 14:01
谢谢分享

作者: yinghua05 时间: 2009-5-6 18:43
学习一下

作者: sxb2007 时间: 2009-5-8 22:22
谢谢分享

作者: chaojianan 时间: 2009-5-9 11:05
谢谢,十分感谢.

作者: 宏魔法师 时间: 2009-5-21 12:50
正需要这个，学习下！

作者: zzcjp 时间: 2009-8-9 17:13
谢谢分享

作者: ssangcry 时间: 2009-8-25 11:57
谢谢分享

作者: ilovshevchenko 时间: 2009-8-27 10:27
收藏了

作者: 坡芽歌书 时间: 2009-8-27 10:35
谢谢，真的非常感谢！

作者: 坡芽歌书 时间: 2009-8-27 10:36
谢谢分享～～～～

作者: wangweiyds 时间: 2009-8-28 10:02
谢谢分享～～～～

作者: li08hua 时间: 2009-9-2 04:25
非常感谢！

作者: jamesmarkgg 时间: 2009-9-4 00:30
CESHI

作者: secowu 时间: 2009-9-5 15:18
谢谢..............辛苦了...........

作者: secowu 时间: 2009-9-7 16:57
有没有好的BOM模块呢

作者: ui 时间: 2009-11-13 17:13
看看

作者: 小桥人家 时间: 2009-11-24 09:30
OEL其他文件的行不行

作者: hi-wzj 时间: 2009-12-9 14:35
看下

作者: jellings 时间: 2009-12-11 15:09
学习学习 .

作者: amocvv 时间: 2009-12-15 18:00
这个不需要什么控件吧~~

作者: lp2lp2 时间: 2009-12-17 09:28
学习学习

作者: tony182838 时间: 2010-1-16 10:10
谢谢分享

作者: 13601812106_01 时间: 2010-1-17 00:21
谢谢分享

作者: 82077802 时间: 2010-1-17 09:11
好东东,收藏了!
谢谢分享 !

作者: li08hua 时间: 2010-1-29 22:52
好东东。分享！

作者: zhao__feng 时间: 2010-2-7 20:05
谢谢

作者: duomu 时间: 2010-3-2 19:48
因工作原因，好久没回家，祝各位坛友新年快乐！

作者: lovelaceliu 时间: 2010-3-4 11:41
楼主很厉害，向楼主学习

作者: BILLFEI 时间: 2010-3-11 15:11
谢谢分享

作者: bochin 时间: 2010-3-14 00:19
學習

作者: dfnt11 时间: 2010-3-14 01:09
好东西赶紧收藏！

作者: liushichao3687 时间: 2010-4-6 14:24
xiexie

作者: liushichao3687 时间: 2010-4-6 14:27
我下载的文件为什么有密码啊
到底密码是多少啊
！

作者: yanwei82123300 时间: 2010-4-6 14:51
好东东,收藏了!
谢谢分享 !

作者: BILLFEI 时间: 2010-4-11 00:56
谢谢分享～～～～

作者: sagemeyou 时间: 2010-4-14 12:14
好帖，顶下

作者: shouryu 时间: 2010-4-23 16:54
顶顶了

作者: jsan999 时间: 2010-5-28 11:56
xiexie xxx

作者: xlyw 时间: 2010-5-28 15:07
学习学习再学习

作者: utngrihii 时间: 2010-6-5 21:14
谢谢，真的非常感谢！

作者: zww3008 时间: 2010-6-12 18:55
谢谢分享～～～～

作者: 石三少 时间: 2010-7-27 09:33
看看

作者: ZHENGLIAN 时间: 2010-8-18 15:11
谢谢，真的非常感谢！

作者: fcghw 时间: 2010-11-15 17:28
真的非常感谢

作者: lirong 时间: 2010-11-18 21:16
下载一个来看看

作者: LUIDAOHONG 时间: 2010-12-6 00:40
2222222222222

作者: xie62 时间: 2010-12-6 07:49
谢谢分享 !

作者: hnabv 时间: 2010-12-7 21:12
ok!

作者: weny87 时间: 2011-3-31 23:12
很好，最好又实例就更加好了

作者: js7756 时间: 2011-5-2 00:20
谢谢，真的非常感谢！

作者: yy138360 时间: 2011-5-2 21:17
先谢谢了

作者: zhaozhuonayes 时间: 2011-6-4 08:27
学习

作者: 130050007 时间: 2011-6-7 12:20
good

作者: wgh3g 时间: 2011-6-7 17:48
学习

作者: chenyingfengsx 时间: 2011-7-12 10:03
我看看，正在找啊！

作者: licongli 时间: 2011-7-12 10:25
看看。

作者: dolodelqyitm 时间: 2011-7-17 04:51
国奥队、

作者: yhf 时间: 2011-9-20 19:34
学学

作者: jedtang 时间: 2011-11-18 09:28
谢谢分享～～～～

作者: bpchan 时间: 2011-11-26 14:23
X XXXX！

作者: pangzcn 时间: 2011-11-26 21:29
学些学习

作者: 67613188 时间: 2011-11-27 07:50

作者: 67613188 时间: 2011-11-27 07:52
谢谢分享～～～～

作者: hdgf1234 时间: 2011-12-16 17:06
have a look

作者: h150085001 时间: 2011-12-16 17:46
真好

作者: xxiaoxin321 时间: 2012-1-4 10:09
学习！~~~

作者: l_q101 时间: 2012-1-12 17:52
{:soso_e192:}{:soso_e192:}{:soso_e192:}

作者: lazybird 时间: 2012-2-26 21:44
谢谢，真的非常感谢！

作者: xuwenning 时间: 2012-2-27 08:21
收藏了

作者: dsz5142 时间: 2012-4-13 16:28
不错啊，谢谢分享

作者: boyandmerry 时间: 2012-4-24 18:07
终于找到了

作者: xjb_test 时间: 2012-4-24 19:16
谢谢楼主分享...

作者: accesswj 时间: 2012-4-25 21:37
okkookokkoo

作者: jingan 时间: 2012-4-29 11:42
好东东学习

作者: sl-txm 时间: 2012-8-9 21:20
学习

作者: lxj8897 时间: 2012-8-14 10:09
谢谢分享！很有用

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)