2013-06-19 07:48

     $TYPECHECK ON

'### MULTI LEVEL UNDO/REDO BOX VERSION 0.1a ###'
' This version support only general-charactor and backspace

'the line which have comment '-- that
'can use same line which comment '-- this
'but my native language re-input '-- this better.

     CONST NEWLINE$ = CHR$(13)+CHR$(10)

     CONST VK_BACK = &H8:CONST VK_TAB = &H9
     CONST VK_RETURN = &HD:CONST VK_SPACE = &H20

     CONST VK_ESCAPE = &H1B
     CONST VK_END = &H23:CONST VK_HOME = &H24
     CONST VK_LEFT = &H25:CONST VK_UP = &H26
     CONST VK_RIGHT = &H27:CONST VK_DOWN = &H28
     CONST VK_INSERT = &H2D:CONST VK_DELETE = &H2E

     CONST VK_NUMPAD0 = &H60:CONST VK_NUMPAD1 = &H61
     CONST VK_NUMPAD2 = &H62:CONST VK_NUMPAD3 = &H63
     CONST VK_NUMPAD4 = &H64:CONST VK_NUMPAD5 = &H65
     CONST VK_NUMPAD6 = &H66:CONST VK_NUMPAD7 = &H67
     CONST VK_NUMPAD8 = &H68:CONST VK_NUMPAD9 = &H69

     CONST VK_MULTIPLY = &H6A:CONST VK_ADD = &H6B
     CONST VK_SEPARATOR = &H6C:CONST VK_SUBTRACT = &H6D
     CONST VK_DECIMAL = &H6E:CONST VK_DIVIDE = &H6F


     DECLARE SUB about_close

     CREATE about AS QFORM
      CAPTION = "about this program"
      height = 200
      CREATE aboutbox AS QRICHEDIT
       align = 1
       alignment = 2
       readonly = 1
       text = "undo/redo box version 0.1a"+NEWLINE$+_
        "program by suchart chokphichitchai"+NEWLINE$+NEWLINE$+_
        "copy right 2003-2004"
      END CREATE
      CREATE aboutbtn AS QBUTTON
       top = aboutbox.height+5
       left = 110
       CAPTION = "close"
       onclick = about_close
      END CREATE
     END CREATE

     SUB about_close
      about.CLOSE
     END SUB

     DIM Form AS QFORM
     Form.Center
     DIM mn AS QMAINMENU
     DIM iEdit AS QMENUITEM
     DIM iRedo AS QMENUITEM
     DIM iUndo AS QMENUITEM
     DIM iHelp AS QMENUITEM
     DIM iAbout AS QMENUITEM
     DIM ed AS QRICHEDIT
     DIM btn AS QBUTTON
     DIM ls AS QLISTBOX
     DIM lsN AS QLISTBOX


     CONST GENERAL_KEY = 1
     CONST EXTENDED_KEY = 2
     CONST NONE_KEY = 0

     DIM DownKey AS INTEGER
     DIM PressedKey AS INTEGER
     DIM selBegin AS INTEGER
     DIM chDeleted AS STRING
     DEFINT undoPosition = -1

     SUB aboutShow
      about.center
      about.SHOWMODAL
     END SUB

     SUB showUndoPosition
 '-- This Subroutine need not for Undoing --'
 ' It's just show the proceed of command.
 ' You may insert quote-mark infront of it to run faster.
      form.CAPTION = "undoPosition = "+STR$(undoPosition)
      Ls.itemIndex = undoPosition
      LsN.itemIndex = undoPosition
     END SUB

     FUNCTION xchar( i AS INTEGER ) AS STRING
      DIM s AS STRING
      SELECT CASE i
      CASE VK_BACK: s = "B"
      CASE VK_TAB: s = "T"
      CASE VK_RETURN: s = "R"
      CASE VK_DELETE: s = "D"
      CASE VK_SPACE: s = "S"
      END SELECT
      xchar = ChDeleted+s
     END FUNCTION

     SUB Inc_undoPosition
      undoPosition = undoPosition + 1
     END SUB

     SUB Dec_undoPosition
      undoPosition = undoPosition - 1
     END SUB

     SUB edkbdown(Key AS WORD, Shift AS INTEGER)
      SELECT CASE Key
      CASE 65 TO 90,186 TO 191,219 TO 222,48 TO 57,VK_NUMPAD0 TO VK_NUMPAD9,VK_SPACE:
       DownKey = GENERAL_KEY
       selBegin = Ed.SelStart

      CASE VK_BACK,VK_TAB,VK_RETURN,VK_DELETE:
       DownKey = EXTENDED_KEY
       selBegin = Ed.SelStart
       PressedKey = Key '// memo Extended Key
       SELECT CASE Key
       CASE VK_TAB,VK_RETURN: ChDeleted = "#"
       CASE VK_BACK: ChDeleted = Ed.Text[ Ed.SelStart ]
       END SELECT

      END SELECT
     END SUB

     SUB edbkbChg
      DIM i AS INTEGER
      SELECT CASE DownKey
      CASE GENERAL_KEY:
       IF (undoPosition <> Ls.itemCount-1) THEN
        FOR i = Ls.itemCount-1 TO undoPosition+1 STEP -1
         Ls.DelItems i  ' clear old undoList
         LsN.DelItems i ' clear old selStartList
        NEXT i
       END IF
       Ls.Additems Ed.Text[ Ed.SelStart ]
       LsN.Additems STR$(selBegin)
       DownKey = NONE_KEY
       Inc_undoPosition:		showUndoPosition
      CASE EXTENDED_KEY:
       SELECT CASE PressedKey
       CASE VK_BACK:
        IF (undoPosition <> Ls.itemCount-1) THEN
         FOR i = Ls.itemCount-1 TO undoPosition+1 STEP -1
          Ls.DelItems i  ' clear old undoList
          LsN.DelItems i ' clear old selStartList
         NEXT i
        END IF
        IF (selBegin <> 0) THEN '// protect adding VK_BACK to undoList
         Ls.Additems xchar(PressedKey)
         LsN.Additems STR$(selBegin)
         DownKey = NONE_KEY
         Inc_undoPosition:		showUndoPosition
        END IF
       CASE VK_RETURN:
        IF (undoPosition <> Ls.itemCount-1) THEN
         FOR i = Ls.itemCount-1 TO undoPosition+1 STEP -1
          Ls.DelItems i  ' clear old undoList
          LsN.DelItems i ' clear old selStartList
         NEXT i
        END IF
        Ls.Additems xchar(PressedKey)
        LsN.Additems STR$(selBegin)
        DownKey = NONE_KEY
        Inc_undoPosition:		showUndoPosition
       END SELECT
      END SELECT
     END SUB

     SUB iUndoCk
      DIM s AS STRING
      DEFINT itemType = LEN(Ls.item(undoPosition))
      IF (itemType = GENERAL_KEY) THEN
       Ed.SelStart = VAL( LsN.item(undoPosition) )
       Ed.SelLength = 1
       Ed.SelText = ""
       Dec_undoPosition:		showUndoPosition
      ELSEIF (itemType = EXTENDED_KEY) THEN
       s = RIGHT$(Ls.item(undoPosition),1)
       SELECT CASE s
       CASE "B": 'VK_BACK
			'if (left$(Ls.item(undoPosition),1) = chr$(10)) then '-- that
			'Ed.SelStart = val( LsN.item(undoPosition) )-2 '-- that
			'	Ed.SelLength = 0 '-- that
			'	Ed.SelText = NEWLINE$ '-- that
			'else '-- that
			'Ed.SelStart = val( LsN.item(undoPosition) )-1 '-- that
			'	Ed.SelLength = 0 '-- that
			'	Ed.SelText = left$(Ls.item(undoPosition),1) '-- that
			'end if '-- that
        IF (LEFT$(Ls.item(undoPosition),1) = CHR$(10)) THEN '-- this
         Ed.SelStart = VAL( LsN.item(undoPosition) )-2 '-- this
         Ed.SelLength = 1 '-- this
         Ed.SelText = NEWLINE$+Ed.SelText '-- this
        ELSE '-- this
         Ed.SelStart = VAL( LsN.item(undoPosition) )-1 '-- this
         Ed.SelLength = 1 '-- this
         Ed.SelText = LEFT$(Ls.item(undoPosition),1)+Ed.SelText '-- this
        END IF '-- this
        IF (Ed.Text[ Ed.SelStart+1 ] <> CHR$(13)) AND (Ed.SelStart <> LEN(Ed.Text)) THEN '-- this
         Ed.SelStart = Ed.SelStart - 1 '-- this
        END IF '-- this
        Dec_undoPosition:		showUndoPosition
       CASE "T": 'VK_TAB
       CASE "R": 'VK_RETURN
        Ed.SelStart = VAL( LsN.item(undoPosition) )
        Ed.SelLength = 2
        Ed.SelText = ""
        Dec_undoPosition:		showUndoPosition
       CASE "D": 'VK_DELETE
       END SELECT
      END IF
      DownKey = NONE_KEY '// protect onchange event
     END SUB

     SUB iRedoCk
      DIM s AS STRING
      DEFINT redoPosition = undoPosition+1
      DEFINT ItemType = LEN(Ls.item(redoPosition))
      IF (ItemType = GENERAL_KEY) THEN
       Ed.SelStart = VAL( LsN.item(redoPosition) )
		'Ed.SelLength = 0 '-- that
		'Ed.SelText = Ls.item(redoPosition) '-- that
       Ed.SelLength = 1 '-- this
       Ed.SelText = Ls.item(redoPosition)+Ed.SelText '-- this
       IF Ed.SelStart <> LEN(Ed.Text) THEN '-- this
        Ed.SelStart = Ed.SelStart - 1 '-- this
       END IF '-- this
       Inc_undoPosition:		showUndoPosition
      ELSEIF (ItemType = EXTENDED_KEY) THEN
       Ed.SelStart = VAL( LsN.item(redoPosition) )
       s = RIGHT$(Ls.item(redoPosition),1)
       SELECT CASE s
       CASE "B": 'VK_BACK
        IF (LEFT$(Ls.item(redoPosition),1) = CHR$(10)) THEN
         Ed.SelLength = -2
         Ed.SelText = ""
        ELSE
         Ed.SelLength = -1
         Ed.SelText = ""
        END IF
       CASE "T": 'VK_TAB
       CASE "R": 'VK_RETURN
        Ed.SelLength = 0
        Ed.SelText = NEWLINE$
       CASE "D": 'VK_DELETE
       END SELECT
       Inc_undoPosition:		showUndoPosition
      END IF
      DownKey = NONE_KEY '// protect onchange event
     END SUB

     Mn.PARENT = form
     Mn.Additems iEdit, iHelp

     iHelp.CAPTION = "&help"
     iHelp.Additems iAbout
     iAbout.CAPTION = "&about"
     iAbout.onclick = aboutShow

     iEdit.CAPTION = "&edit"
     iEdit.Additems iUndo, iRedo
     iUndo.CAPTION = "&undo"
     iUndo.shortcut = "Ctrl+Z"
     iUndo.onclick = iUndoCk
     iRedo.CAPTION = "&redo"
     iRedo.shortcut = "Ctrl+Y"
     iRedo.onclick = iRedoCk

     Ed.PARENT = form
     Ed.width = 225
     Ed.height = 180
     Ed.onKeydown = edkbdown
     Ed.onChange = edbkbChg

     Ls.PARENT = form
     Ls.Left = 230
     Ls.width = 75
     Ls.height = 180
     Ls.Columns = 1
     Ls.Clear

     LsN.PARENT = form
     LsN.Left = 305
     LsN.width = 75
     LsN.height = 180
     LsN.Columns = 1

     Form.width = 390
     Form.height = 250
     Form.CAPTION = "UNDO AND REDO BOX BY DRAGON_HTML"
     Form.SHOWMODAL

' Key - OnKeyDown Event
'a - z 65 - 90'0 - 9 48 - 57
'; 186'= 187', 188'- 189'. 190'/ 191
'[ 219'\ 220'] 221'' 222

2013-06-19 07:48