Windows only
Das Modul bietet ein mehrstufiges, differenzielles Undo und auch eine mehrstufiges Redo.
- es wird für das Undo immer nur der geänderte Text gespeichert (Textvergleich mittels CRC32), um Speicher zu sparen.
- bei jeder Undo-Aktion wird der jeweils aktuelle Text für ein Redo gesichert. Sobald neue Undo-Daten hinzugefügt werden, werden die Redo-Daten gelöscht.
Code: Alles auswählen
;/ === UndoModule.pbi === [ PureBasic V5.6x ]
;/ (Windows only)
;/ Oktober 2017 by Thorsten1867
;/ Differential Undo & Redo for EditorGadgets (incl. cursor position)
DeclareModule Undo
Declare.s GetCursorChar(GadgetID.i) ; Get character at cursor position
Declare AddText(GadgetID.i, Text$="") ; Add current text or Text$ and cursor position to Undo list
Declare.s GetLastText(GadgetID.i) ; Do Undo and get last text (return) and cursor position
Declare SetLastCursor(GadgetID.i) ; Set last cursor position after Undo action
Declare SetLastText(GadgetID.i, CurPos.l=#True) ; Set last text to gadget (Undo)
Declare.i CountUndo(GadgetID.i) ; Count Undo entries
Declare.s GetRedoText(GadgetID.i) ; Get text for Redo
Declare SetRedoText(GadgetID.i) ; Set Redo text to gadget
Declare.i CountRedo(GadgetID.i) ; Count Redo entries
Declare Clear(GadgetID.i=-1) ; Clear Undo data
EndDeclareModule
Module Undo
EnableExplicit
Structure UndoStructure
Idx.i ; ListIndex of last complete Text
Length.i ; Length of text
Text.s ; Text or differential text
CurPos.i ; Cursor position
CRC32.i ; CRC32 checksum of text
EndStructure
Structure GadgetStructure
LastText.s ; Text of Undo-Action
RedoText.s ; Text before Undo-Action
Cursor.i ; Position of the Cursor
List Redo.s()
List Undo.UndoStructure()
EndStructure
Global NewMap Gadget.GadgetStructure()
CompilerIf #PB_Compiler_Version >= 540
UseCRC32Fingerprint()
Procedure.i GetCRC32(Text$)
ProcedureReturn Val(StringFingerprint(Text$, #PB_Cipher_CRC32))
EndProcedure
CompilerElse
Procedure.i GetCRC32(Text$) ; Get CRC32 checksum
ProcedureReturn CRC32Fingerprint(@Text$, StringByteLength(Text$))
EndProcedure
CompilerEndIf
Procedure.i GetCursorPos(GadgetID.i) ; Get cursor position
Define Range.CHARRANGE
If IsGadget(GadgetID)
SendMessage_(GadgetID(GadgetID), #EM_EXGETSEL, 0, Range)
ProcedureReturn Range\cpMax
EndIf
EndProcedure
Procedure.s GetCursorChar(GadgetID.i) ; Get character at cursor position
Define ttr.TEXTRANGE
Define REG.i, Buffer$ = Space(1)
If IsGadget(GadgetID)
ttr\lpstrText = @Buffer$
SendMessage_(GadgetID(GadgetID), #EM_EXGETSEL, 0, ttr\chrg)
ttr\chrg\cpMax = ttr\chrg\cpMin
ttr\chrg\cpMin - 1
SendMessage_(GadgetID(GadgetID), #EM_GETTEXTRANGE, 0, ttr\chrg)
ProcedureReturn Buffer$
EndIf
EndProcedure
Procedure AddRedo(GadgetID.i, Text$="")
Define.s GId$ = Str(GadgetID)
If IsGadget(GadgetID)
If Text$ = "" : Text$ = GetGadgetText(GadgetID) : EndIf
AddElement(Gadget(GId$)\Redo())
Gadget(GId$)\Redo() = Text$
EndIf
EndProcedure
Procedure AddText(GadgetID.i, Text$="") ; Add current text or Text$ and cursor position to Undo list
Define.s Diff$, GId$ = Str(GadgetID)
Define.i Idx, Length
If IsGadget(GadgetID)
If Text$ = "" : Text$ = GetGadgetText(GadgetID) : EndIf
If LastElement(Gadget(GId$)\Undo())
Idx = Gadget(GId$)\Undo()\Idx
Length = Gadget(GId$)\Undo()\Length
If Trim(Text$) And Text$ <> Gadget(GId$)\Undo()\Text
If Gadget(GId$)\Undo()\CRC32 = GetCRC32(Left(Text$, Length))
Diff$ = Mid(Text$, Length+1)
If Diff$
AddElement(Gadget(GId$)\Undo())
Gadget(GId$)\Undo()\Idx = Idx
Gadget(GId$)\Undo()\Length = Len(Text$)
Gadget(GId$)\Undo()\Text = Diff$
Gadget(GId$)\Undo()\CurPos = GetCursorPos(GadgetID)
Gadget(GId$)\Undo()\CRC32 = GetCRC32(Text$)
EndIf
Else
AddElement(Gadget(GId$)\Undo())
Gadget(GId$)\Undo()\Idx = ListIndex(Gadget(GId$)\Undo())
Gadget(GId$)\Undo()\Length = Len(Text$)
Gadget(GId$)\Undo()\Text = Text$
Gadget(GId$)\Undo()\CurPos = GetCursorPos(GadgetID)
Gadget(GId$)\Undo()\CRC32 = GetCRC32(Text$)
EndIf
;Debug "Undo: |"+ Gadget(GId$)\Undo()\Text + "| ("+Str(Gadget(GId$)\Undo()\Idx)+")"
EndIf
Else
If Trim(Text$)
AddElement(Gadget(GId$)\Undo())
Gadget(GId$)\Undo()\Idx = ListIndex(Gadget(GId$)\Undo())
Gadget(GId$)\Undo()\Length = Len(Text$)
Gadget(GId$)\Undo()\Text = Text$
Gadget(GId$)\Undo()\CurPos = GetCursorPos(GadgetID)
Gadget(GId$)\Undo()\CRC32 = GetCRC32(Text$)
;Debug "Undo: |"+ Gadget(GId$)\Undo()\Text + "| ("+Str(Gadget(GId$)\Undo()\Idx)+")"
EndIf
EndIf
ClearList(Gadget(GId$)\Redo())
EndIf
ProcedureReturn #True
EndProcedure
Procedure.s GetLastText(GadgetID.i) ; Do Undo and get last text (return) and cursor position
Define.s Last$, Text$, GId$ = Str(GadgetID)
Define.i Idx
If IsGadget(GadgetID) ; Save gadget text for Redo
Text$ = GetGadgetText(GadgetID)
AddRedo(GadgetID, Text$)
EndIf
If LastElement(Gadget(GId$)\Undo())
Idx = Gadget(GId$)\Undo()\Idx
If Idx = ListIndex(Gadget(GId$)\Undo())
Gadget(GId$)\LastText = Gadget(GId$)\Undo()\Text
Gadget(GId$)\Cursor = Gadget(GId$)\Undo()\CurPos
DeleteElement(Gadget(GId$)\Undo())
Else
Last$ = Gadget(GId$)\Undo()\Text
Gadget(GId$)\Cursor = Gadget(GId$)\Undo()\CurPos
DeleteElement(Gadget(GId$)\Undo())
SelectElement(Gadget(GId$)\Undo(), Idx)
Gadget(GId$)\LastText = Gadget(GId$)\Undo()\Text
While NextElement(Gadget(GId$)\Undo())
Gadget(GId$)\LastText + Gadget(GId$)\Undo()\Text
Wend
If Trim(Gadget(GId$)\LastText + Last$) <> Trim(Text$)
Gadget(GId$)\LastText + Last$
EndIf
EndIf
EndIf
ProcedureReturn Gadget(GId$)\LastText
EndProcedure
Procedure SetLastCursor(GadgetID.i) ; Set cursor after Undo action
Define Range.CHARRANGE
Define.s GId$ = Str(GadgetID)
If IsGadget(GadgetID)
Range\cpMin = Gadget(GId$)\Cursor
Range\cpMax = Gadget(GId$)\Cursor
SendMessage_(GadgetID(GadgetID), #EM_EXSETSEL, 0, Range)
EndIf
EndProcedure
Procedure SetLastText(GadgetID.i, CurPos.l=#True) ; Set last text (Undo) to gadget
Define.s GId$ = Str(GadgetID)
GetLastText(GadgetID)
If Gadget(GId$)\LastText
If IsGadget(GadgetID) : SetGadgetText(GadgetID, Gadget(GId$)\LastText) : EndIf
If CurPos : SetLastCursor(GadgetID) : EndIf
EndIf
EndProcedure
Procedure.s GetRedoText(GadgetID.i) ; Get text for Redo
Define.s GId$ = Str(GadgetID)
If LastElement(Gadget(GId$)\Redo())
Gadget(GId$)\RedoText = Gadget(GId$)\Redo()
DeleteElement(Gadget(GId$)\Redo())
EndIf
ProcedureReturn Gadget(GId$)\RedoText
EndProcedure
Procedure SetRedoText(GadgetID.i) ; Set Redo text to gadget
Define.s GId$ = Str(GadgetID)
GetRedoText(GadgetID)
If Gadget(GId$)\RedoText
If IsGadget(GadgetID) : SetGadgetText(GadgetID, Gadget(GId$)\RedoText) : EndIf
EndIf
EndProcedure
Procedure.i CountUndo(GadgetID.i) ; Count Undo entries
ProcedureReturn ListSize(Gadget(Str(GadgetID))\Undo())
EndProcedure
Procedure.i CountRedo(GadgetID.i) ; Count Redo entries
ProcedureReturn ListSize(Gadget(Str(GadgetID))\Redo())
EndProcedure
Procedure Clear(GadgetID.i=-1) ; Clear Undo data
If GadgetID >= 0
If FindMapElement(Gadget(), Str(GadgetID))
ClearList(Gadget()\Undo())
EndIf
Else
ClearMap(Gadget())
EndIf
EndProcedure
EndModule
CompilerIf #PB_Compiler_IsMainFile
#Window = 0
#Editor = 1
#Undo = 2
#Redo = 3
If OpenWindow(#Window, 0, 0, 240, 200, "Test Undo (Module)", #PB_Window_SystemMenu|#PB_Window_TitleBar|#PB_Window_ScreenCentered)
EditorGadget(#Editor, 10, 10, 220, 150)
ButtonGadget(#Undo, 10, 169, 80, 22, "Undo")
ButtonGadget(#Redo, 150, 169, 80, 22, "Redo")
DisableGadget(#Undo, #True)
DisableGadget(#Redo, #True)
ExitWindow.l = #False
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
ExitWindow = #True
Case #PB_Event_Gadget
Select EventGadget()
Case #Undo
Undo::SetLastText(#Editor)
If Undo::CountRedo(#Editor)
DisableGadget(#Redo, #False)
EndIf
Case #Redo
Undo::SetRedoText(#Editor)
Case #Editor
If EventType() = #PB_EventType_Change
Char$ = Undo::GetCursorChar(#Editor)
If Char$ = " " Or Char$ = "." : Undo::AddText(#Editor) : EndIf
If Undo::CountUndo(#Editor) ; Disable/Enable Buttone
DisableGadget(#Undo, #False)
Else
DisableGadget(#Undo, #True)
EndIf
If Undo::CountRedo(#Editor) = #False : DisableGadget(#Redo, #True) : EndIf
EndIf
EndSelect
EndSelect
Until ExitWindow
CloseWindow(#Window)
EndIf
CompilerEndIf