Skip to content

技术细节

本文档详细说明 cToast 组件的内部实现原理和技术细节。

目录


内部架构

类结构图

cToast (核心管理类)
├── 9个方位集合 (Collection)
│   ├── CollCenter         (居中)
│   ├── CollCenterTop      (居上)
│   ├── CollCenterBottom   (居下)
│   ├── CollLeftTop        (左上)
│   ├── CollLeftBottom     (左下)
│   ├── CollLeftCenter     (左中)
│   ├── CollRightTop       (右上)
│   ├── CollRightBottom    (右下)
│   └── CollRightCenter    (右中)
├── 全局Key集合
│   └── m_AllKeys          (所有弹窗的TagName)
├── 配置属性
│   ├── m_Pos              (当前位置)
│   ├── m_State            (当前状态)
│   ├── m_Theme            (当前主题)
│   ├── m_Index            (堆叠索引)
│   ├── m_Tag              (TagName)
│   └── m_ManualStack      (是否手动堆叠)
├── 两个窗体
│   ├── FToastCenter       (居中窗体)
│   └── FToastDrawer       (侧边窗体)
└── 事件
    ├── OnToastCountChange (数量变化)
    └── OnCloseAll         (批量关闭)

核心成员变量

vb
' 配置属性
Private m_Pos As EnumPos           ' 当前显示位置
Private m_State As EnumState       ' 当前状态主题
Private m_Theme As EnumTheme       ' 当前颜色主题
Private m_Index As Long            ' 堆叠索引
Private m_Tag As String            ' TagName
Private m_ManualStack As Boolean    ' 是否手动调用InstIndex

' 9个方位集合
Private CollCenter As Collection
Private CollCenterTop As Collection
Private CollCenterBottom As Collection
Private CollLeftTop As Collection
Private CollLeftBottom As Collection
Private CollLeftCenter As Collection
Private CollRightTop As Collection
Private CollRightBottom As Collection
Private CollRightCenter As Collection

' 全局Key集合
Private m_AllKeys As Collection

初始化流程

vb
Private Sub Class_Initialize()
    ' 设置默认值
    m_Pos = Center
    m_State = Info
    m_Theme = Light
    m_Index = -1
    m_Tag = ""
    m_ManualStack = False

    ' 初始化所有集合
    Set CollCenter = New Collection
    Set CollCenterTop = New Collection
    Set CollCenterBottom = New Collection
    Set CollLeftTop = New Collection
    Set CollLeftBottom = New Collection
    Set CollLeftCenter = New Collection
    Set CollRightTop = New Collection
    Set CollRightBottom = New Collection
    Set CollRightCenter = New Collection
    Set m_AllKeys = New Collection
End Sub

窗体实现

窗体选择逻辑

根据 m_Pos 参数自动选择使用哪个窗体:

vb
Public Function Show(...) As cToast
    If IsCenter(m_Pos) Then
        ' 使用 FToastCenter
        Set Inst = New FToastCenter
    Else
        ' 使用 FToastDrawer
        Set Inst = New FToastDrawer
    End If
    ' ...
End Function

判断函数(mToast.bas):

vb
Public Function IsLeft(ByVal p As Long) As Boolean
    IsLeft = p < 20
End Function

Public Function IsCenter(ByVal p As Long) As Boolean
    IsCenter = p >= 20 And p < 30
End Function

Public Function IsRight(ByVal p As Long) As Boolean
    IsRight = p >= 30
End Function

FToastCenter(居中窗体)

特点:

  • 无边框窗口
  • 包含底部颜色条
  • 自动宽度计算
  • 屏幕居中或垂直堆叠

核心实现:

vb
Public Sub ShowMe(ByVal Content As String, Optional ByVal Delay As Long = 3000, Optional ByVal Title As String = "")
    ' 自动宽度计算
    Dim w As Long
    w = Len(Content) * 240 + 1400
    If w < 160 * 15 Then w = 160 * 15
    If w > Screen.Width Then w = Screen.Width * 0.9
    Me.Width = w

    ' 设置文本
    If Title <> "" Then Title = "[" & Title & "] "
    Text1.Text = Title & Content

    ' 设置计时器
    Timer1.Interval = Delay
    If Delay > 0 Then Timer1.Enabled = True

    ' 计算位置
    Dim CenterX As Long, CenterY As Long, YPos As Long
    CenterX = (Screen.Width - Me.Width) \ 2 \ Screen.TwipsPerPixelX

    If TopVal > 0 Then
        YPos = TopVal \ Screen.TwipsPerPixelY
    Else
        CenterY = (Screen.Height - Me.Height) \ 2 \ Screen.TwipsPerPixelY
        YPos = CenterY
    End If

    ' 显示窗口(无焦点 + 顶置)
    SetWindowPos Me.hwnd, HWND_TOPMOST, CenterX, YPos, 0, 0, SWP_NOSIZE Or SWP_NOACTIVATE Or SWP_SHOWWINDOW

    ' 初始化阴影
    Sad.ShowBorders Me.hwnd, False
End Sub

FToastDrawer(侧边窗体)

特点:

  • 无边框窗口
  • 包含侧边颜色条(左侧或右侧)
  • 包含标题和内容两个文本框
  • 支持左右对齐颜色条

核心实现:

vb
Public Sub ShowMe(ByVal Content As String, Optional ByVal Delay As Long = 3000, Optional ByVal Title As String = "提示")
    ' 设置文本
    Text1.Text = Title
    Text2.Text = Content

    ' 设置计时器
    Timer1.Interval = Delay
    If Delay > 0 Then Timer1.Enabled = True

    ' 设置颜色条位置
    If IsLeft(PosVal) = True Then
        Picture1.Align = 4  ' 右对齐
    End If
    If IsRight(PosVal) = True Then
        Picture1.Align = 3  ' 左对齐
    End If

    ' 计算位置
    Dim ShowTop As Long
    If TopVal = 0 Then
        ShowTop = (Screen.Height - Me.Height) \ 2
    Else
        ShowTop = TopVal
    End If

    Me.Move LeftVal, ShowTop

    ' 显示窗口
    SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE Or SWP_SHOWWINDOW

    ' 初始化阴影
    Sad.ShowBorders Me.hwnd, False
End Sub

无焦点窗口实现

vb
Private Sub Form_Load()
    ' 设置无焦点样式 + 禁用窗口
    SetWindowLong Me.hwnd, GWL_EXSTYLE, GetWindowLong(Me.hwnd, GWL_EXSTYLE) Or WS_EX_NOACTIVATE
    SetWindowLong Me.hwnd, GWL_STYLE, GetWindowLong(Me.hwnd, GWL_STYLE) Or WS_DISABLED
End Sub

API声明:

vb
Private Const WS_EX_NOACTIVATE = &H8000000
Private Const WS_DISABLED = &H8000000
Private Const GWL_EXSTYLE = -20
Private Const GWL_STYLE = -16

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

堆叠算法

自动堆叠管理

cToast 通过 m_ManualStack 标记判断是否启用自动堆叠:

vb
' Show 方法中的自动堆叠逻辑
If Not m_ManualStack Then
    ' 用户没有手动调用InstIndex,且集合已有实例,自动堆叠
    If Coll.Count > 0 Then
        m_Index = Coll.Count
    End If
End If

堆叠位置计算

顶部位置(顺序堆叠):

vb
' i=0 在最上方(y 最小),依次向下
TopVal = 800 + (ItemHeight * i)

底部位置(倒序堆叠):

vb
' i=0 在最底部,依次向上
TopVal = Screen.Height - Me.Height - 800 - (i * ItemHeight)

参数说明:

  • 800:距离屏幕边缘的间距
  • ItemHeight:每个弹窗的高度 + 200(间距)
  • Screen.Height:屏幕高度

堆叠示意图

顶部顺序堆叠:

屏幕顶部 (y=0)

    800        ← 弹窗1 (i=0)

    +Height+200

    800+Height+200*1  ← 弹窗2 (i=1)

    +Height+200

    800+Height+200*2  ← 弹窗3 (i=2)

底部倒序堆叠:

屏幕底部 (y=Screen.Height)

    -800-Height      ← 弹窗1 (i=0)

    -Height-200

    -800-Height-200*1  ← 弹窗2 (i=1)

    -Height-200

    -800-Height-200*2  ← 弹窗3 (i=2)

手动堆叠控制

vb
Public Function InstIndex(ByVal i As Long) As cToast
    Set InstIndex = Me
    ' 居中/覆盖位置不支持堆叠
    If m_Pos = Center Or m_Pos = LeftCenter Or m_Pos = RightCenter Then Exit Function
    m_Index = i
    m_ManualStack = True
End Function

使用示例:

vb
' 手动指定堆叠位置
Toast.Pos(RightTop).InstIndex(2).Show "第3条", 0  ' 指定在索引2位置

事件机制

窗体初始化和回调

cToast 端:

vb
Public Function Show(...) As cToast
    ' 创建实例
    If IsCenter(m_Pos) Then
        Set Inst = New FToastCenter
    Else
        Set Inst = New FToastDrawer
    End If

    ' 初始化窗体
    With Inst
        .Init Me, TagName  ' 传入Parent和TagName
        .Pos m_Pos
        .State m_State
        .Theme m_Theme
        If m_Index >= 0 Then .InstIndex m_Index
        .ShowMe Content, Delay, Title
    End With

    ' 存入集合
    Coll.Add Inst, TagName
    m_AllKeys.Add TagName, TagName

    ' 触发数量变化事件
    RaiseEvent OnToastCountChange(TagName, False, m_AllKeys.Count)

    ' 重置状态
    ResetState
End Function

窗体端(FToastCenter/FToastDrawer):

vb
Public Sub Init(ByRef Parent As cToast, ByVal TagName As String)
    Set m_ParentToast = Parent
    m_TagName = TagName
End Sub

窗体销毁回调

窗体端:

vb
Private Sub Form_Unload(Cancel As Integer)
    ' 通知父级 cToast 此窗体正在销毁
    If Not m_ParentToast Is Nothing Then
        If m_TagName <> "" Then
            m_ParentToast.UnloadToastForm m_TagName
        End If
        Set m_ParentToast = Nothing
    End If
    Set Sad = Nothing
End Sub

cToast 端:

vb
Friend Sub UnloadToastForm(ByVal TagName As String)
    ' 遍历所有方位集合查找并移除
    Dim Coll As Collection
    Dim i As Integer

    For i = 1 To 9
        Select Case i
            Case 1: Set Coll = CollCenter
            Case 2: Set Coll = CollCenterTop
            Case 3: Set Coll = CollCenterBottom
            Case 4: Set Coll = CollLeftTop
            Case 5: Set Coll = CollLeftBottom
            Case 6: Set Coll = CollLeftCenter
            Case 7: Set Coll = CollRightTop
            Case 8: Set Coll = CollRightBottom
            Case 9: Set Coll = CollRightCenter
        End Select

        ' 尝试移除
        Coll.Remove TagName
    Next i

    ' 从 Keys 集合中移除
    m_AllKeys.Remove TagName

    ' 触发数量变化事件
    RaiseEvent OnToastCountChange(TagName, True, m_AllKeys.Count)
End Sub

鼠标悬停暂停机制

窗体端:

vb
Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    ' 鼠标进入文本框,暂停计时器
    If Not m_ParentToast Is Nothing And m_TagName <> "" Then
        m_ParentToast.PauseToast m_TagName
    End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    ' 检测鼠标是否离开窗体区域
    If x < 0 Or y < 0 Or x > Me.ScaleWidth Or y > Me.ScaleHeight Then
        If Not m_ParentToast Is Nothing And m_TagName <> "" Then
            m_ParentToast.ResumeToast m_TagName
        End If
    End If
End Sub

cToast 端:

vb
Friend Sub PauseToast(ByVal TagName As String)
    Dim Inst As Object
    Set Inst = FindInstance(TagName)
    If Not Inst Is Nothing Then
        On Error Resume Next
        Inst.PauseTimer
        On Error GoTo 0
    End If
End Sub

Friend Sub ResumeToast(ByVal TagName As String)
    Dim Inst As Object
    Set Inst = FindInstance(TagName)
    If Not Inst Is Nothing Then
        On Error Resume Next
        Inst.ResumeTimer
        On Error GoTo 0
    End If
End Sub

Private Function FindInstance(ByVal Name As String) As Object
    Dim Coll As Collection
    Dim i As Integer

    For i = 1 To 9
        Select Case i
            Case 1: Set Coll = CollCenter
            Case 2: Set Coll = CollCenterTop
            Case 3: Set Coll = CollCenterBottom
            Case 4: Set Coll = CollLeftTop
            Case 5: Set Coll = CollLeftBottom
            Case 6: Set Coll = CollLeftCenter
            Case 7: Set Coll = CollRightTop
            Case 8: Set Coll = CollRightBottom
            Case 9: Set Coll = CollRightCenter
        End Select

        On Error Resume Next
        Dim Inst As Object
        Set Inst = Coll(Name)
        On Error GoTo 0

        If Not Inst Is Nothing Then
            Set FindInstance = Inst
            Exit Function
        End If
    Next i

    Set FindInstance = Nothing
End Function

窗体端的Timer控制:

vb
Public Sub PauseTimer()
    Timer1.Enabled = False
End Sub

Public Sub ResumeTimer()
    If Timer1.Interval > 0 Then
        Timer1.Enabled = True
    End If
End Sub

生命周期管理

弹窗创建流程

1. 用户调用 cToast.Show()

2. 检查 TagName 是否重复

3. 根据 Pos 选择窗体类型(FToastCenter/FToastDrawer)

4. 创建窗体实例

5. 调用窗体.Init(Me, TagName) 保存父级引用

6. 设置窗体属性(Pos, State, Theme, InstIndex)

7. 调用窗体.ShowMe() 显示窗口

8. 将窗体实例存入对应集合(以TagName为Key)

9. 将TagName存入全局Key集合

10. 触发 OnToastCountChange 事件

11. 重置 cToast 配置状态(保留Pos)

弹窗销毁流程

正常关闭(Timer到期或手动CloseMe):

1. 窗体.Timer1_Timer() 触发或用户调用 CloseMe()

2. 调用 Unload Me

3. 触发 Form_Unload

4. 调用 m_ParentToast.UnloadToastForm(TagName)

5. cToast 从所有集合中移除该实例

6. 从 m_AllKeys 中移除 TagName

7. 触发 OnToastCountChange 事件

8. 释放阴影对象 Sad

9. 释放父级引用 m_ParentToast

10. 窗体完全销毁

批量关闭(CloseAll):

1. 用户调用 cToast.CloseAll()

2. 记录关闭前数量 closedCount = m_AllKeys.Count

3. 遍历所有9个集合

4. 逐个调用窗体的 CloseMe()

5. 清空所有集合

6. 清空 m_AllKeys

7. 触发一次 OnCloseAll(closedCount) 事件

8. 每个窗体的 Form_Unload 也会触发 UnloadToastForm

9. 但由于集合已清空,不会重复触发 OnToastCountChange

状态重置机制

每次 Show 调用后会重置部分配置状态:

vb
Private Sub ResetState()
    ' 保留m_Pos作为下次的默认位置,其他重置
    m_State = Info
    m_Theme = Light
    m_Index = -1
    m_Tag = ""
    m_ManualStack = False
    Set m_InstRef = Nothing
    Set m_ParentToast = Nothing
End Sub

设计原因:

  • m_Pos 保留,方便在同一位置显示多个弹窗
  • 其他配置重置,避免影响下一次显示

性能优化

集合索引优化

使用 m_AllKeys 集合快速获取所有弹窗名称:

vb
Public Property Get ActiveKeys() As Collection
    Set ActiveKeys = m_AllKeys
End Property

优势:

  • 避免遍历9个集合
  • O(1) 查询复杂度
  • 实时反映当前状态

事件触发优化

批量关闭时只触发一次 OnCloseAll 事件:

vb
Public Function CloseAll() As Boolean
    Dim closedCount As Long
    closedCount = m_AllKeys.Count

    ' 关闭所有集合
    CloseCollection CollCenter
    CloseCollection CollCenterTop
    ' ... 其他集合

    ' 清空 Keys 集合
    Set m_AllKeys = New Collection

    ' 只触发一次 OnCloseAll 事件
    If closedCount > 0 Then
        RaiseEvent OnCloseAll(closedCount)
    End If
End Function

避免的问题:

  • 频繁触发 OnToastCountChange 事件
  • UI多次刷新
  • 性能损耗

窗体资源管理

及时释放窗体资源:

vb
Private Sub Form_Unload(Cancel As Integer)
    If Not m_ParentToast Is Nothing Then
        If m_TagName <> "" Then
            m_ParentToast.UnloadToastForm m_TagName
        End If
        Set m_ParentToast = Nothing
    End If
    Set Sad = Nothing  ' 释放阴影对象
End Sub

自动宽度计算

FToastCenter 根据内容自动计算宽度:

vb
Dim w As Long
w = Len(Content) * 240 + 1400
If w < 160 * 15 Then w = 160 * 15
If w > Screen.Width Then w = Screen.Width * 0.9
Me.Width = w

优化点:

  • 最小宽度:160 * 15 = 2400 twips
  • 最大宽度:屏幕宽度的90%
  • 字符宽度系数:240 twips/字符

相关技术

阴影效果

使用 cShadow 类实现窗口阴影:

vb
Private Sub Form_Load()
    Set Sad = New cShadow

    With Sad
        .BackColor = vbBlack
        .BorderRadius = 0
        .BorderWidth = 0
        .ShadowColor = &H0&
        .ShadowOffsetX = 0
        .ShadowOffsetY = 0
        .ShadowSize = 5
    End With

    Sad.ShowBorders Me.hwnd, False
End Sub

API 调用

SetWindowPos:

vb
Private Declare Function SetWindowPos Lib "user32" ( _
    ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
    ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, _
    ByVal wFlags As Long) As Long

Private Const HWND_TOPMOST = -1
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const SWP_SHOWWINDOW = &H40

使用示例:

vb
SetWindowPos Me.hwnd, HWND_TOPMOST, CenterX, YPos, 0, 0, SWP_NOSIZE Or SWP_NOACTIVATE Or SWP_SHOWWINDOW

扩展建议

未来可能的扩展

  1. 内容更新功能

    vb
    Public Function Update(ByVal Name As String, ByVal NewContent As String) As Boolean
        ' 更新已显示弹窗的内容
    End Function
  2. 进度条支持

    vb
    Public Function Progress(ByVal Name As String, ByVal Value As Long, ByVal Max As Long) As Boolean
        ' 更新进度条
    End Function
  3. 自定义图标

    vb
    Public Function Icon(ByVal Name As String, ByVal IconPath As String) As cToast
        ' 设置自定义图标
    End Function
  4. 动画效果

    vb
    Public Enum EnumAnimation
        None = 0
        FadeIn = 1
        SlideIn = 2
        ScaleIn = 3
    End Enum
    
    Public Function Animation(ByVal anim As EnumAnimation) As cToast
        ' 设置动画效果
    End Function
  5. 位置查询

    vb
    Public Function GetPosition(ByVal Name As String) As EnumPos
        ' 查询指定弹窗的位置
    End Function
  6. 对于手动关闭(Delay=0)的窗体提供用户可操作的关闭按钮。

VB6及其LOGO版权为微软公司所有