Access快速开发基础教程
网站公告
·Access专家课堂QQ群号：239158550    ·Access快速开发平台下载地址及教程    ·欢迎加入Access专家课堂微信群！    ·如何快速搜索本站文章|示例|资料    
您的位置：　首页 > 技术文章 > Access开发平台

Access快速开发平台--通用附件附加折叠扩展显示功能实例

来源:www.sourceentoi.com  点击数:1066  　 | 收藏 | 复制

时　间:2022-04-04 08:01:25
作　者:张旭军   ID：72228  城市：杭州
摘　要:ACCESS附件附加折叠扩展显示功能实例。
正　文:

       盟威Access快速开发平台非常实用，我们需要更多普及使用方法。本文适合初学者学习。

       附件占用的显示区域大，如果能折叠起来可以改善窗体的美观，使用心得仅供大家参考，不周全之处大家谅解。

       附件详细使用说明见我此前的文章说明：

http://www.sourceentoi.com/blog/article-show.asp?userid=72228&Id=20190

================================================================

有人会问直接用InsideWidth不是具备展开区域目的，为什么要搞二个定位在窗体里？

每个窗体有大有小，打开时需要居中显示如果设置好定位的存在调试时更快捷方便。

定位也可以进行二次扩展，具体就不详细说明。

扩展区域的作用：

1》存放隐藏核心参数或者展示附件详细，配备权限时有保密作用

2》主要和次要内容分开显示，【简化窗体】，让参数较多的窗体不臃肿。

==============================================================

扩展区域和折叠功能实现步骤如下:

1》首先设置二个变量

Private gTMPInsideWidth As Long

Private showAll As Boolean


2》在原区域和扩展之后的区域设置定位的目标

     cmd5_More 是箭头的控键

     Text5          是一个扩展之后的定位作用的文本框控键【定位最远箭头的位置作用】    【使用时最好设置不可见，最小化】

     以上二个建议使用时数字编号是一对，在使用时头绪不会紊乱

     任意一个在窗体下端的控键或者文本框  收缩显示区域的定位目标。


3》注意事项：

    1】如果多个窗体使用折叠扩展显示区域时 箭头控键和文本定位不能使用一个固定的名称，

         否则只有第一次使用的窗体正常使用，其他窗体无法使用�！境跹д吡粢狻�

         设计时最好统一分配好数字编号，防止系统紊乱。

    2】窗体大小显示不同，收缩的范围不同，定位的箭头有不同，注意自己了解那个是定位的位置

        +是向右移动     -是向左移动   【也能实现2次折叠显示】
    3】如果收缩之后不合适，系统将无法显示   会变成一个很窄的小窗体只能看到一个“×”

         点这个窄窗体上边的“×”才能退出死循环

点击图片查看大图


4》代码如下 

Option Compare Database
Option Explicit
'====================折叠功能专用=======================================
Private showAll As Boolean '申明一个扩展区域的变量专用
Private gTMPInsideWidth As Long '申明一个扩展区域的变量专用


Public Function InitData()
    ClearControlValues Me
    CurrentDb.Execute "Delete FROM [TMP_纹纸仪匠_次]"
        
   '===============附件功能专用=====================
     Call Me.sfrAttachments.Form.LoadAttachmentData("纹纸图", Me!纹纸图)
   '===============附件功能专用====================
    Me.sfrDetail.Requery
End Function


Private Sub Form_Load()
    If CanViewVBACode() Then
        On Error GoTo 0
    Else
        On Error GoTo ErrorHandler
    End If
    ApplyTheme Me
    LoadLocalLanguage Me
        
    '------------------------
    Dim cnn As Object     '【附件添加的代码】【申明CNN】
    Set cnn = CurrentProject.Connection   '【附件添加的代码】【设置CNN】
    Me.InitData
    If Nz(Me.OpenArgs) <> "" Then
        LoadRecord Me, "Select * FROM [纹纸仪匠_主] Where [ID]=" & Nz(Me.OpenArgs, 0)
        LoadRecord "TMP_纹纸仪匠_次", "Select * FROM [纹纸仪匠_次] Where [纹纸代码]=" & SQLText(Me![纹纸代码])
    End If
       
    
    '加载附件时，只能放在这里，否则保存时报警
    Call Me.sfrAttachments.Form.LoadAttachmentData("纹纸图", Me!纹纸图)    '附件添加的【加载作用】代码  “纹纸图”是保存的时候前缀名称
 
    If Me.DataEntry Then
        Me![ID] = Null
        Me![纹纸代码] = Null
    End If

    Me.sfrDetail.Requery
    Me.btnSave.Enabled = Me.AllowEdits
 '==============================
       If Me.审核状态 = "已审核" Then          '当审核状态=已审核时
         Me.AllowEdits = False                '窗体的所有编辑功能=关闭
         Me.btnSave.Enabled = False           '窗体的保存功能=关闭
         Me.sfrDetail.Enabled = False         '窗体的子窗体编辑功能=关闭
       End If                                 '退出假设
            
    '=================================
ExitHere:
    Exit Sub
ErrorHandler:
    MsgBoxEx Err.Description, vbCritical
    Resume ExitHere
End Sub


Private Sub btnSave_Click()
    If CanViewVBACode() Then
        On Error GoTo 0
    Else
        On Error GoTo ErrorHandler
    End If
    If Not CheckRequired(Me) Then Exit Sub
    If Not CheckTextLength(Me) Then Exit Sub
    If Not CheckRequired(Me.sfrDetail) Then Exit Sub
    Dim cnn: Set cnn = CurrentProject.Connection  'ADO.Connection()
    cnn.BeginTrans
    Dim blnTransBegin As Boolean: blnTransBegin = True
    If Nz(Me![纹纸代码]) = "" Then Me![纹纸代码] = GetAutoNumber("纹纸代码")
    Dim strSQL: strSQL = "Select * FROM [纹纸仪匠_主] Where [ID]=" & Nz(Me![ID], 0)
    Dim rst:    Set rst = ADO.OpenRecordset(strSQL, adLockOptimistic, cnn)
    If rst.EOF Then rst.AddNew
    UpdateRecord Me, rst
    '你的自定义代码
    'rst!Field1 = Me!Field1
    'rst!Field2 = Me!Field2
    rst.Update
    rst.Close
    cnn.Execute "Delete FROM [纹纸仪匠_次] Where [纹纸代码]=" & SQLText(Me![纹纸代码])
    strSQL = "Select * FROM [纹纸仪匠_次] Where [纹纸代码]=" & SQLText(Me![纹纸代码])
    Set rst = ADO.OpenRecordset(strSQL, adLockOptimistic, cnn)
    Dim rstTmp: Set rstTmp = CurrentDb.OpenRecordset("TMP_纹纸仪匠_次")
    Do Until rstTmp.EOF
        rst.AddNew
        UpdateRecord rstTmp, rst
        '你的自定义代码
        'rst!Field1 = Me!Field1
        'rst!Field2 = Me!Field2
        rst![纹纸代码] = Me![纹纸代码]
        rst.Update
        rstTmp.MoveNext
    Loop
    rst.Close
    rstTmp.Close
    cnn.CommitTrans
    blnTransBegin = False
    RequeryDataObject gsfrList
    MsgBoxEx LoadString("Saved Successfully."), vbInformation

    '加载保存附件时，必须放在保存之后，否则保存时出错
    Call Me.sfrAttachments.Form.SaveAttachmentData("纹纸图", Me!纹纸图)          '【附件添加的保存代码】
    
    If Me.DataEntry Then
        Me.InitData
    Else
        DoCmd.Close acForm, Me.Name, acSaveNo
    End If
ExitHere:
    Set rst = Nothing
    Set cnn = Nothing
    Set rstTmp = Nothing
    Exit Sub
ErrorHandler:
    If blnTransBegin Then
        cnn.RollbackTrans
        blnTransBegin = False
    End If
    MsgBoxEx Err.Description, vbCritical
    Resume ExitHere
End Sub


Private Sub btnCancel_Click()
    On Error Resume Next
    DoCmd.Close acForm, Me.Name, acSaveNo
End Sub
Private Sub 停用_Click()
  If Me.停用 = -1 Then                                                         '当停用为假时
     MsgBox "你确定要【停用】此数据吗？" & vbNewLine & "系统将【不会采用】本数据！" & vbNewLine & "请慎重选择！", vbExclamation + vbOKOnly            '警告提示   +允许确认
  Else
     MsgBox "你确定要【启用】此数据吗？" & vbNewLine & "系统将【使用】本数据！" & vbNewLine & "请慎重选择！", vbExclamation + vbOKOnly               '警告提示   +允许确认
  End If
End Sub
    
Private Sub cmd5_More_Click()
If showAll = True Then
    Me.InsideWidth = Me.Text5.Width + Me.InsideWidth + Me.cmd5_More.Width + 6200                                    '最大布局的最大宽上放CMD_click的地方
    Me.cmd5_More.Left = Me.Text5.Left + 250                                                                        'CMD_click的左边位置 在那个按键的地方距离
    Me.cmd5_More.Picture = CurrentProject.Path & "\Images\icons\db previous.ico"
    showAll = False
Else
    Me.InsideWidth = gTMPInsideWidth
    Me.cmd5_More.Picture = CurrentProject.Path & "\Images\icons\db next.ico"
    Me.cmd5_More.Left = Me.纹纸图.Left + 11050                                                                     'CMD_click的 【新箭头的右边】距离位置  在纹纸图的左侧+11050的位置
    showAll = True
End If
End Sub


Private Sub Form_Open(Cancel As Integer)
showAll = True
Me.cmd5_More.Picture = CurrentProject.Path & "\Images\icons\db next.ico"
'隐藏计算部分，并让窗体居中。
Me.InsideWidth = Me.cmd5_More.Left + Me.cmd5_More.Width + 20                                                       '设置显示时窗体的边界在那里
gTMPInsideWidth = Me.InsideWidth
Move Me.WindowLeft + Me.纹纸图.Width - 200                                                                   '当窗体不居中时，把窗体向左平移200个单位
End Sub

5》示例下载:

点击下载此示例附件


6》图示效果:

点击图片查看大图


点击图片查看大图



Access快速开发平台QQ群 (群号:115180141) 　　　　　　Access源码网店
【打印此文】【关闭窗口】

常见问答:

技术分类:

相关资源:

源码示例

学习心得

最新文章

专栏作家

关于我们 | 服务条款 | 在线投稿 | 友情链接 | 网站统计 | 网站帮助