VB调用eDrawings 窗体显示防抖解决问题

wangyanpin · 发表于 2024-4-20 09:54:37

问题描述:
   在 excel 中用 eDrawings 窗体显示solidworks零部件。具体实现是通过 Workbook_SheetSelectionChange 触发(也可以使用user32 API的MouseMove事件)。使用中发现一个问题，快速操作表格或者移动鼠标的时候，这些事件都是频繁触发的，而 eDrawings 打开零部件还是耗时的，频繁触发会造成极大的延迟。这中间频繁调用起始都是无效的，我们真正希望的是保留最后一次的调用。
解决思路: 就是利用延时制造一个防抖。多次触发只执行最后一次。避免频繁调用，无效渲染
1. 触发事件，先执行一次，延时Ts, 才能再次调用。
2.  延时期间若是再次触发则更新延时，重新延时Ts，记录需要最后一次的任务信息。‘
3. Ts延时后若是有任务则执行任务，若是没有则结束。
核心点: 2此调用的时间间隔大于等于 Ts,  频繁调用也是更新定时器，没有渲染调用，避免的了无效渲染，性能浪费。
下面是实现代码：

wangyanpin · 发表于 2024-4-20 09:56:11

无效渲染'防抖使用 : 避免频繁调用，无效渲染
'触发事件后函数会立即执行，n 秒内触发事件不会执行功能函数下一次调用，n秒后再次触发才会再次执行功能函数。
'第一次: flag=false, 执行一次，flag=true,延时，flag=false
'延时期间(flag=true)，更新延迟，并记录最后一次的信息，延迟结束，执行
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Const waitTime As Single = 1#
Static Start As Single '标记开始状态的时间
Static isSleep As Boolean ' 记录状态初始值默认是false 防抖使用
Static hasTask As Boolean ' 是否有任务
Static last As Range
'防抖使用 : 避免频繁调用，无效渲染
'触发事件后函数会立即执行，n 秒内触发事件不会执行功能函数下一次调用，n秒后再次触发才会再次执行功能函数。
' 更新 timer 并且退出
If isSleep Then
' 单位是秒
hasTask = True
Set last = Target
Start = Timer
Exit Sub
End If
' 设置开始暂停的时刻。
Dim FileName As String
Dim FileType As String
Dim task As Range
isSleep = True
Set task = Target
TashHandler:
hasTask = False
'Debug.Print task.row & "," & task.Column & ": " & task
If task.Column = Header_e.fFileName Then
FileType = task.Offset(0, 1)
FileName = IIf(task <> "" And GetFileType(FileType) <> 0, task & "." & FileType, "")
ElseIf ActiveCell.Column = Header_e.fHasDraw Then
FileName = IIf(task = "★", task.Offset(0, 2) & ".SLDDRW", "")
Else
If ModelDisplay.visible = True Then
ModelDisplay.Hide
End If
isSleep = False
Exit Sub
End If
If FileName = "" Then
isSleep = False
ModelDisplay.Hide
Exit Sub
End If
ModelDisplay.Caption = FileName
FileName = Cells(task.row, Header_e.fFilePath) + FileName
If FileName <> ModelDisplay.doc Then
ModelDisplay.doc = FileName
'ModelDisplay.EModelViewControl1.CloseActiveDoc ModelDisplay.doc
'ModelDisplay.EModelViewControl1.Refresh
'ModelDisplay.Top = 50
End If
ModelDisplay.EModelViewControl1.OpenDoc FileName, False, False, True, ""
'Debug.Print task.Left, task.Width
If Not ModelDisplay.visible Then
ModelDisplay.Show vbModeless
End If
ModelDisplay.Left = Int(task.Left + task.Width) + 20
Start = Timer
While Timer < Start + waitTime
DoEvents ' 将控制让给其他程序。
Wend
If hasTask Then Set task = last: GoTo TashHandler
isSleep = False
' ModelDisplay.Show
End Sub