vbAccelerator - Contents of code file: cUndoRedo.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "cUndoRedo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private m_cUndoDC As cMemDC
Private m_sNames() As String
Private m_iCurrentIndex As Long
Private m_iUndoCount As Long
Private m_iRedoCount As Long
Private m_lIconSizeX As Long
Private m_lIconSizeY As Long
Private m_lFrameCount As Long

Public Sub Init(ByVal lIconSizeX As Long, ByVal lIconSizeY As Long, ByVal
 lFrameCount As Long)
Dim lHDC As Long
   Set m_cUndoDC = New cMemDC
   With m_cUndoDC
      .Width = lIconSizeX * lFrameCount
      .Height = lIconSizeY
      lHDC = .hDC
   End With
   If Not (lHDC = 0) Then
      m_lIconSizeX = lIconSizeX
      m_lIconSizeY = lIconSizeY
      m_lFrameCount = lFrameCount
      ReDim m_sNames(1 To m_lFrameCount) As String
   End If
   m_iUndoCount = 0
   m_iRedoCount = 0
   m_iCurrentIndex = 0
End Sub
Public Sub Add(ByVal hDCOrig As Long, ByVal sName As String)
   ' Increment the number of undo frames:
   If m_iUndoCount < m_lFrameCount Then
      m_iUndoCount = m_iUndoCount + 1
   End If
   ' You cannot redo if you've just added an undo:
   m_iRedoCount = 0
   m_iCurrentIndex = m_iCurrentIndex + 1
   If m_iCurrentIndex > m_lFrameCount Then
      m_iCurrentIndex = 1
   End If
   m_sNames(m_iCurrentIndex) = sName
   BitBlt m_cUndoDC.hDC, (m_iCurrentIndex - 1) * m_lIconSizeX, 0, m_lIconSizeX,
    m_lIconSizeY, hDCOrig, 0, 0, vbSrcCopy
End Sub
Public Sub Undo(ByVal hDCOrig As Long, ByVal lDepth As Long)
Dim lFrame As Long
Dim lNextFrame As Long
   If m_iUndoCount >= lDepth Then
      If m_iRedoCount = 0 Then
         ' must store current image in next frame so we can redo:
         lNextFrame = WrapAdd(m_lFrameCount, m_iCurrentIndex, 1)
         BitBlt m_cUndoDC.hDC, (lNextFrame - 1) * m_lIconSizeX, 0,
          m_lIconSizeX, m_lIconSizeY, hDCOrig, 0, 0, vbSrcCopy
      End If
      lFrame = UndoIndex(lDepth - 1)
      If lFrame > 0 Then
         BitBlt hDCOrig, 0, 0, m_lIconSizeX, m_lIconSizeY, m_cUndoDC.hDC,
          (lFrame - 1) * m_lIconSizeX, 0, vbSrcCopy
         m_iUndoCount = m_iUndoCount - lDepth
         m_iRedoCount = m_iRedoCount + lDepth
         m_iCurrentIndex = WrapSubtract(m_lFrameCount, m_iCurrentIndex, lDepth)
      End If
   End If
End Sub
Public Sub Redo(ByVal hDCOrig As Long, ByVal lDepth As Long)
Dim lFrame As Long
   If m_iRedoCount >= lDepth Then
      lFrame = RedoIndex(lDepth + 1)
      If lFrame > 0 Then
         BitBlt hDCOrig, 0, 0, m_lIconSizeX, m_lIconSizeY, m_cUndoDC.hDC,
          (lFrame - 1) * m_lIconSizeX, 0, vbSrcCopy
         m_iUndoCount = m_iUndoCount + lDepth
         m_iRedoCount = m_iRedoCount - lDepth
         m_iCurrentIndex = WrapAdd(m_lFrameCount, m_iCurrentIndex, lDepth)
      End If
   End If
End Sub
Public Property Get UndoDepth() As Long
   UndoDepth = m_iUndoCount
End Property

Public Property Get RedoDepth() As Long
   RedoDepth = m_iRedoCount
End Property
Public Property Get UndoName(ByVal lDepth As Long) As String
Dim lTheIndex As Long
   lTheIndex = UndoIndex(lDepth)
   If lTheIndex > 0 Then
      UndoName = m_sNames(lTheIndex)
   End If
End Property
Private Property Get UndoIndex(ByVal lDepth As Long) As Long
   UndoIndex = WrapSubtract(m_lFrameCount, m_iCurrentIndex, lDepth)
End Property
Public Property Get RedoName(ByVal lDepth As Long) As String
Dim lTheIndex As Long
   lTheIndex = RedoIndex(lDepth)
   If lTheIndex > 0 Then
      RedoName = m_sNames(lTheIndex)
   End If
End Property
Private Property Get RedoIndex(ByVal lDepth As Long) As Long
   RedoIndex = WrapAdd(m_lFrameCount, m_iCurrentIndex, lDepth)
End Property
Private Function WrapAdd(ByVal lCount As Long, ByVal lIndex As Long, ByVal lAmt
 As Long) As Long
Dim lR As Long
   lR = lIndex + lAmt
   If lR > lCount Then
      lR = (lR - lCount)
   End If
   WrapAdd = lR
End Function
Private Function WrapSubtract(ByVal lCount As Long, ByVal lIndex As Long, ByVal
 lAmt As Long) As Long
Dim lR As Long
   lR = lIndex - lAmt
   If lR < 1 Then
      lR = (lCount + lR)
   End If
   WrapSubtract = lR
End Function