Option Explicit

'元に戻すとやり直しができるテキストエディターを作りました
'自作エディターなどに組み込んで見てください
'また、クラス化してみてはいかがでしょうか

'コメントだけでは、動作がちょっと理解しにくいかも知れません
'(ほとんどのサンプルが説明不足でスイマセン)(_^;

'欠点がひとつあります
'元に戻すなどを使ったときに、
'TextBoxのカーソルが先頭に移動してしまうことです
'リッチテキストボックスなどを使えば解消されるかもしれません

Const UNDOMAX = 5 '元に戻すができる最大回数

Private Type UndoType '元に戻す(やり直しも)の変数をまとめた構造体(型)
    Max As Integer '元に戻すの最大回数(UNDOMAXを超えることはない)
    Now As Integer '文字列ﾊﾞｯﾌｧの現在位置(元に戻すを押さなかったら、ず〜っと値が0)
    flg As Boolean 'Text1.Textﾌﾟﾛﾊﾟﾃｨへの文字列の例外代入用
    Buf(UNDOMAX) As String 'TextBoxの文字列ﾊﾞｯﾌｧ
End Type

Dim Undo As UndoType 'Undo構造体を使う

Sub TextChange() 'Undoﾊﾞｯﾌｧの入れ替え
    Dim j As Integer
    
    '### (2001/3/19: バグ報告により確認) ###
    'この一行を忘れてました(涙)
    If Undo.flg = False Then Exit Sub
    
    cmdUndo.Enabled = True '元に戻すが使えるようにする
    cmdRedo.Enabled = False 'やり直しが使えるようにする
    
    '元に戻すが何度か押された場合
    If Undo.Now <> 0 Then
    
        'Undo.Maxの変更
        Undo.Max = UNDOMAX - Undo.Now
        
        'Undo.NowからUndo.Bufまでの文字列ﾊﾞｯﾌｧを文字列ﾊﾞｯﾌｧの先頭に移動する
        For j = 0 To Undo.Max
            Undo.Buf(j) = Undo.Buf(Undo.Now + j)
        Next
        
        '文字列ﾊﾞｯﾌｧのお尻のごみを削除する
        For j = Undo.Max + 1 To UNDOMAX
            Undo.Buf(j) = ""
        Next
        
        'Undo.Nowの変更
        Undo.Now = 0
        
    End If
        
    'Undo.Bufの入れ替えを行う
    For j = UNDOMAX To 1 Step -1
        Undo.Buf(j) = Undo.Buf(j - 1)
    Next
    Undo.Buf(0) = Text1.Text
    
    '元に戻すの最大戻り回数を決める
    If Undo.Max = UNDOMAX Then
        Undo.Max = UNDOMAX
    Else
        Undo.Max = Undo.Max + 1
    End If
    
    'どのように動作しているか確認用をする(この行とTextDebug関数を消しても大丈夫)
    TextDebug

End Sub

Private Sub cmdUndo_Click() '元に戻す
    Dim j As Integer
    
    Text1.SetFocus
    Undo.Now = Undo.Now + 1
    
    'Text1.Textへの例外代入
    '(Text1_ChangeｲﾍﾞﾝﾄでTextChange関数が勝手に使われないようにするため)
    Undo.flg = True
    Text1.Text = Undo.Buf(Undo.Now)
    Undo.flg = False
    
    '元に戻すが限界値になったら元に戻すが使えないようにする
    If Undo.Now < Undo.Max Then
        cmdUndo.Enabled = True
        cmdRedo.Enabled = True
    Else
        cmdUndo.Enabled = False
    End If
    
    'どのように動作しているか確認用をする(この行とTextDebug関数を消しても大丈夫)
    TextDebug
    
End Sub

Private Sub cmdRedo_Click() 'やり直し
    Dim j As Integer
    
    Text1.SetFocus
    Undo.Now = Undo.Now - 1
    
    'Text1.Textへの例外代入
    '(Text1_ChangeｲﾍﾞﾝﾄでTextChange関数が勝手に使われないようにするため)
    Undo.flg = True
    Text1.Text = Undo.Buf(Undo.Now)
    Undo.flg = False
    
    'やり直しが限界値になったらやり直しが使えないようにする
    If Undo.Now > 0 Then
        cmdUndo.Enabled = True
        cmdRedo.Enabled = True
    Else
        cmdRedo.Enabled = False
    End If
    
    'どのように動作しているか確認用をする(この行とTextDebug関数を消しても大丈夫)
    TextDebug
    
End Sub

Private Sub Form_Load()
    Dim strMemo As String
    
    Label1.Caption = "元に戻すが使える回数は、最大" & UNDOMAX & "回までです。"
    
    cmdUndo.Enabled = False
    cmdRedo.Enabled = False
    Debug.Print vbCrLf & vbCrLf & vbCrLf 'ｲﾐﾃﾞｨｴｲﾄ ｳｨﾝﾄﾞｳをｸﾘｱにする
    
End Sub

Private Sub Text1_Change()
    
    '例外代入(元に戻すとやり直しで使う)以外の場合TextChange関数を使う
    If Undo.flg = False Then TextChange

End Sub

Sub TextDebug() '現在の状態が分かるﾃﾞﾊﾞｯｸﾞ関数(ｲﾐﾃﾞｨｴｲﾄ ｳｨﾝﾄﾞｳに表示)
    Dim j As Integer, strMemo As String
    
    For j = 0 To UNDOMAX
        
        If Undo.Now = j Then
            '→は、現在の位置を示します
            strMemo = "→" & Undo.Buf(j) & " "
        Else
            strMemo = Undo.Buf(j) & " "
        End If
        
        If j = UNDOMAX Then
            Debug.Print strMemo
        Else
            Debug.Print strMemo;
        End If
    Next
    
End Sub