Office中国论坛/Access中国论坛

标题: [LWWVB]最精绝的标签菜单例子 [打印本页]

作者: tmtony 时间: 2004-6-20 10:42
标题: [LWWVB]最精绝的标签菜单例子
LWWVB的最精绝的标签菜单例子

用几个标签做菜单，以前也有很多人做过了，包括刘小军的通用界面2.0。但这些东西给我的感觉就是代码太松散了，有些编得不好的，界面还要有几百行的现象。可怕！为此，本人今天精心设计了一个标签菜单例子，为的是启发一下大家的编程思路，几百行代码做一个界面，还必要吗？

本例子使用了VB的高级程序设计的概念，类、事件处理和消息引发，做出来的东西特别有趣和巧妙。

但我用ACCESS 2K和ACCESS 2003运行这个东西时，有时不关闭主窗口进入VBA编辑器，再按一下停止按钮，ACCESS就会出错，为此可以一见ACCESS的稳定性。唉，两年了，ACCESS真的很好，唯一的不好就是程序和设计一复杂点，经常就是出错，死机，文件不能用，2003了，ACCESS真的还是如此脆弱？？

[此贴子已经被作者于2004-6-20 2:45:44编辑过]

作者: tmtony 时间: 2004-6-20 10:47
tmtony反馈:非常不错的代码，实属精品。

只是有关access的稳定性方面，不太苟同：），withevent及类在access的早期版本就开始支持，而且使用与VB相差不多，只是对类调试时，最好在类程序中间不要加断点，否则有时会出现GPF非法操作现象，这在我调试VB时也偶尔会发现。当然，要考较稳定性还必须双方都打齐补丁。

看到这么好的程序也觉手痒：）也提提自己的建议，或能让程序更加完善。

1。可以利用tag标志来控制更多XP样式标签的行为

2。如果要让标签有不同的行为，就需要有不同的withevent,由于withevent不支持数据组，可以考虑使用集合collection和implement共同来实现。这样扩展开来，可以实现很多好的功能，而且由于类的封装，调用更加方便。

3。命名标准化（LNC或匈牙利）

李啸林反馈：很棒的思路.

"进入我的程序之后，点击几下菜单，进入设计方式，又打开，重复几次再打开VBA编辑器，按VBA的停止键".

用不着重复几次,只需一次我的Access就完蛋.(Access 2003 +Windows 2003)tanyiqiang反馈：非常不错，对消息处理很熟悉，ACCESS确实可以做很多事情，VB里面的东西几乎都可以搬过来用，只是要理解底层的东西。精品。

作者: quanli 时间: 2004-10-9 00:11
哇，非常好。

作者: 六区柳园11-511 时间: 2004-10-12 00:38
都看不懂啊！云里雾里的......顶，又极端羡慕[em06]

作者: yehf 时间: 2005-9-1 18:34
在标签的超级链接地址里设置不就行了吗,这样做好像有点绕圈咯哦.

作者: obiit 时间: 2006-4-4 21:38
好东西

作者: J-2006 时间: 2006-4-5 05:09
[em03]

作者: wb111666 时间: 2006-4-6 04:05
非常不错

作者: mm0704 时间: 2006-4-6 18:24

以下是引用六区柳园11-511在2004-10-11 16:38:00的发言：
都看不懂啊！云里雾里的......顶，又极端羡慕[em06]

我也是呀~~~~~

作者: 中国情 时间: 2006-4-7 21:20
很漂亮啊

作者: sy_chenhu 时间: 2006-9-11 17:53
好

作者: ywz168 时间: 2006-9-18 00:52
不错的程序

作者: bluesky28 时间: 2006-9-22 22:12
很漂亮啊

作者: mqmelon 时间: 2006-10-7 07:23
好东西!!!!!

作者: 109091372 时间: 2008-1-6 14:06
下载个东西都要老回帖我的孩啊。，。，，。

作者: zhaohuaw 时间: 2008-1-9 16:15
好东西，加羡慕！

作者: szsoncon 时间: 2008-1-15 09:46
不够钱呀,下不了怎么办呀

作者: laiguiyou 时间: 2008-1-26 14:02
see............

作者: 咱家是猫 时间: 2008-1-26 14:28
欣赏一下.

作者: ivwsydcel 时间: 2008-1-26 19:21
谢谢楼主分享,已经收藏

作者: huangqinyong 时间: 2008-1-27 00:47

作者: hunrybecky 时间: 2008-1-27 11:38
很久的。还不错。可以参考下。

作者: XMX64311 时间: 2008-1-28 16:01
下载来看看,谢谢分享!

作者: sunny-xie 时间: 2008-1-28 16:08
msgbox"学习"

作者: yori2007 时间: 2008-1-29 14:06

:lol :lol :lol

作者: ttstory 时间: 2008-2-2 19:24
好东西,一定要收藏

作者: duomu 时间: 2008-2-2 19:46
看一下,是不是使用类触发事件

作者: guoanxiang 时间: 2008-2-3 14:12
看看呀！
好东西

:lol

作者: guowj_ywk_sist 时间: 2008-3-30 12:44
学习学习，谢谢分享！

作者: 668899 时间: 2008-4-16 16:09
11111111111

作者: huhz 时间: 2008-4-17 00:25
标题: 好高
难学吧

作者: dqsytmh 时间: 2008-4-26 22:27
在下来看一部

作者: fuxuan123 时间: 2008-4-28 18:33
学无止境，先收藏一下。

作者: xinle 时间: 2008-4-28 18:37
很漂亮啊

作者: yuayua23 时间: 2008-5-4 19:13
[:50]

作者: zbjit 时间: 2008-5-6 14:28
下來學習下。

作者: 67613188 时间: 2008-5-8 12:56
标题: KANKAN
KANKAN KANKAN

作者: qinds1977 时间: 2008-5-22 01:22
[:50] [:50] [:50] [:50] [:50]

作者: chenwm1973 时间: 2008-5-22 08:14
[:50] [:50] [:50]

作者: ABCaccess 时间: 2008-6-1 12:02
谢谢你与大众分享

作者: ktdntt 时间: 2008-6-6 00:11
看看啊，顶

作者: hjackie 时间: 2008-6-14 13:07
看看先

作者: linag516 时间: 2008-6-14 18:09
[:50]

作者: tonywong 时间: 2008-6-14 18:46
look[:50]

作者: fxtest 时间: 2008-6-28 10:19
[:50] [:50]

作者: fqhp-gq 时间: 2008-7-7 17:29
qqqqqqqqqqqqq

作者: zwdeemail 时间: 2008-7-13 11:02
先下了再说

作者: 西瓜帝国 时间: 2008-7-30 17:16
学习一下,谢谢

作者: YWM161616 时间: 2008-7-30 18:59
看看................................................。

作者: 086-china 时间: 2008-8-11 22:46
极端羡慕

作者: lkh 时间: 2008-8-13 13:42
标题: kk
[:28] [:28] [:28] [:28] kk

作者: 罗春芳 时间: 2008-8-14 14:02
得好好学学

作者: wei010 时间: 2008-8-14 14:24
see see good

作者: zxclen 时间: 2008-8-14 14:37
标题: 学习学习
学习学习学习学习学习学习学习学习

作者: liaoliao 时间: 2008-8-14 19:25
[:45] [:45] [:45] 收没收过呢,看看再说吧.

作者: xuwenning 时间: 2008-8-15 09:43
[:21] 收藏

作者: cjf78 时间: 2008-8-15 11:38
我要收藏

作者: elecsy 时间: 2008-8-17 18:51
谢谢分享

作者: wangchaoyong 时间: 2008-9-5 17:34
很漂亮啊

作者: bjzlx 时间: 2008-9-9 00:35
学习拉

作者: hycnchen 时间: 2008-9-9 00:44
oooooooooooooooooooooooo

作者: changweiren 时间: 2008-9-22 23:05
芝麻开门咚咚咚

作者: lixiaokyoko 时间: 2008-9-23 15:30
非常不错

作者: darwenli 时间: 2008-10-4 17:31
learn it first

作者: freeoffice 时间: 2008-10-15 19:26
dsdfsaf

作者: changweiren 时间: 2008-10-18 01:55
精绝的标签菜单

作者: wdmx 时间: 2008-10-19 02:12
哇，非常好。[:34]

作者: 小小鸟 时间: 2008-11-13 12:58
谢谢分享，下载学习。

作者: 飘零雨 时间: 2008-11-13 13:00
很漂亮

作者: sheandme0 时间: 2008-11-14 12:57
挺好的,谢谢

作者: hwxboy 时间: 2008-11-14 16:22
[:33] [:33] [:33]

作者: liuxinquan 时间: 2009-3-27 16:37
通用模块:读取图片文件并保存到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

作者: 鱼儿游游 时间: 2009-4-2 14:54

作者: fslgb 时间: 2009-4-13 16:30
很漂亮啊

作者: canghe168 时间: 2009-4-28 01:10
很漂亮啊

作者: jackysu78 时间: 2009-6-26 09:48
thanks

作者: Y9X 时间: 2009-7-11 17:38
学习下

作者: yuayua23 时间: 2009-7-12 15:49

作者: 柔情小生 时间: 2009-7-13 14:57
谢谢分享

作者: guoguoququ 时间: 2009-7-19 18:57
很漂亮啊

作者: CHENWK 时间: 2009-8-5 22:42

作者: apsfxc1 时间: 2009-8-21 12:07
学习

作者: luhao 时间: 2009-8-21 12:28
see

作者: wxf2008hz 时间: 2009-8-21 17:41
不错

作者: ilovshevchenko 时间: 2009-8-22 12:00
站长的帖子要顶的

作者: li08hua 时间: 2009-9-2 14:10
下载看看

作者: fengfzg 时间: 2009-9-3 00:20
非常不错

作者: cfncmjh 时间: 2009-9-26 10:16
好的,下了看看.

作者: szyewj 时间: 2009-9-27 18:05
www.office-cn.net

作者: winsign 时间: 2009-9-28 22:30
学习一下

作者: benzzhou 时间: 2009-10-1 08:18
谢谢...................

作者: angpeu_9 时间: 2009-10-9 13:00
学习一下。

作者: chaojianan 时间: 2009-10-10 08:45
看看，谢谢分享。

作者: yedaoan 时间: 2009-10-11 16:55
测试一下

作者: guten 时间: 2009-10-13 01:46
看看

作者: sagemeyou 时间: 2009-10-14 09:42

kankan

作者: xxiaoxin321 时间: 2009-10-14 19:02
好东西要顶个再拿!

作者: leijiqiang 时间: 2009-10-15 15:29
学习一下

作者: leijiqiang 时间: 2009-10-15 15:41
真得很不错

作者: wangxingang 时间: 2009-10-15 15:55
学习

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