您的位置：　首页 > 技术文章 > Access开发平台

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

来源:www.accessoft.com 点击数:7175 　 | 收藏 | 复制

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

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

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

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

http://www.accessoft.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》示例下载:

点击下载此示例附件