Announcement

Collapse
No announcement yet.

text editor MK1 for graphic window

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • text editor MK1 for graphic window

    Although this editor sort of works, its performance could be improved because it has to redraw the edit window whenever text may have moved between lines. Any suggestions on how to make the text structure less reliant on refreshes would be most welcome.

    Code:
    ' a stab at a Text Eitor using PBCC GRAPHIC WINDOW
    ' V 0.2 - subclassing the graphic window for mouse control
    ' V 0.3 - cursor navigation
    ' V 0.4 - charcter insert, delete, backspace
    '
    ' Chris Holbrook Oct 2008
    '
    #COMPILE EXE
    #DIM ALL
    
    #INCLUDE "WIN32API.INC"
    %TRUE = 1
    %FALSE = 0
    %KEY_LEFT    = 19200
    %KEY_RIGHT   = 19712
    %KEY_HOME    = 18776
    %KEY_END     = 20224
    %KEY_DEL     = 21248
    %KEY_UP      = 18432
    %KEY_DOWN    = 20480
    %KEY_BSP     = 8
    %KEY_ESC     = 27
    %KEY_CTRLF   = 6
    %KEY_CTRLA   = 1
    GLOBAL GrDialogProc AS LONG
    GLOBAL GrStaticProc AS LONG
    GLOBAL gMouseX AS LONG,gMouseY AS LONG    ' Mouse x and y
    GLOBAL gLbDOWN AS LONG,gRBDOWN AS LONG    ' Left and right mouse button
    GLOBAL gMouseMoved AS LONG               ' Detect mouse movements
    '--------------------------------------------------------------------------------
    FUNCTION GrDlgProc(BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
     FUNCTION = CallWindowProc(GrDialogProc, hWnd, wMsg, wParam, lParam)
    END FUNCTION
    '--------------------------------------------------------------------------------
    FUNCTION GrProc(BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
      LOCAL p AS pointapi
      SELECT CASE wMsg
        CASE %WM_MOUSEMOVE
            gMouseMoved = %TRUE
            gMouseX = LO(WORD,lParam)
            gMouseY = HI(WORD,lParam)         ' Current Mouse X and Y Position in the graphic window
        CASE %WM_LBUTTONDOWN
            gLBDOWN = 1
            EXIT FUNCTION                      ' Left button pressed
        CASE %WM_RBUTTONDOWN
            gRBDOWN = 1
            EXIT FUNCTION                      ' Right button pressed
      END SELECT
     FUNCTION = CallWindowProc(GrStaticProc, hWnd, wMsg, wParam, lParam)
    
    END FUNCTION
    '--------------------------------------------------------------------
    ' edit text
    %fgcolor = %BLACK
    %bgcolor = %WHITE
    %cursorbgcolor = %CYAN
    %hmargin = 2
    %vmargin = 2
    %MAXLINES = 99
    %MINHEIGHT = 5
    %MINWIDTH = 20
    
    FUNCTION edittext ( hGW AS DWORD, BYREF stext AS STRING, maxrct AS QUAD, minx AS LONG, miny AS LONG,term AS STRING) AS QUAD
    
        LOCAL ll() AS BYTE PTR
        LOCAL cpl, i, lpd, lline, endoftext, maxright, maxbottom, pxcwide, pxchigh AS LONG
        LOCAL rw, cl AS LONG ' row, col for generating edit window, not for editing!
        LOCAL row, col AS LONG ' for keeping edit location within window
        LOCAL pbwd, p, pe, pf  AS BYTE PTR
        DIM ll(0 TO %MAXLINES) AS LOCAL BYTE PTR ' array of start of line offsets
        LOCAL r, lastrect AS rect
        LOCAL skey, s AS STRING
        STATIC SERRWTOOLONG AS STRING
        LOCAL l, movemode, ltc AS LONG
        LOCAL pw AS WORD PTR
        'LOCAL lastcursor as quad ' text offset, x & Y of last cursor pos
        'local cursorpos AS DWORD 'X & Y of current cursor pos
        LOCAL cursoroffset AS LONG ' the offset in the string of the current (cursor) character)
                                   ' it is not changed by resizing the edit window
        LOCAL lastrow, lastcol AS LONG ' the row and column before edit window resizing
        LOCAL top AS LONG ' the line number of the top of the edit window
        LOCAL resized AS LONG ' boolean to indicate that the control has been resized
        LOCAL whitespace AS LONG ' bool
        LOCAL freshen AS LONG ' bool used to control redisplay of edit window after ll array invalidated
        SERRWTOOLONG = "<word too long>"
        ' extract bounding max rect from parameter
        r.nleft   = LO(WORD, LO(DWORD,maxrct))
        r.ntop    = HI(WORD, LO(DWORD,maxrct))
        r.nright  = LO(WORD, HI(DWORD,maxrct))
        r.nbottom = HI(WORD, HI(DWORD,maxrct))
        ' set font
        GRAPHIC FONT "Courier New", 10
        'get pixel sizes of characters
        GRAPHIC CHR SIZE TO pxcwide, pxchigh
        lastrect = r
        freshen = %TRUE
        DO
            IF freshen THEN
                freshen = %FALSE
                GOSUB again
            END IF
            ' if display has been resized then convert prev. text offset into a cursor position
            ' delete last cursor and display current cursor
            ' mCursorClr (col, row)
            lastcol = col
            lastrow = row
            GOSUB clrcursor
            IF resized THEN
                GOSUB getrowcolfroffset
                'calculate current position (row, col) from cursoroffset (position in text string)
                lastcol = col
                lastrow = row
                GOSUB clrcursor
            END IF
            GOSUB shewcursor
            resized = %FALSE
            WHILE skey = ""
                GRAPHIC INKEY$ TO skey
                IF skey = "" THEN
                    SLEEP 1
                    IF gLBDOWN THEN
                        movemode = %TRUE
                        gLBdown = 0
                    END IF
                    IF movemode THEN
                        IF gLBDOWN = %FALSE THEN ' moveto event has occurred
                            movemode = %FALSE
                            IF gMouseY < MINX THEN ITERATE
                            IF gMouseX < MINY THEN ITERATE
                            r.nright = gMouseX
                            r.nbottom = gMouseY
                            resized = %TRUE
                            freshen = %true: GOSUB again
                        END IF
                    END IF
                END IF
            WEND
            SELECT CASE LEN(skey)
                CASE 1 : lTC = ASC(skey)
                CASE 2 : pw = STRPTR(skey): lTC = @pw
                CASE 4 : ' unexpected mouse response
            END SELECT
            skey = ""
            SELECT CASE AS LONG lTC
                CASE %KEY_UP
                    GOSUB clrcursor
                    'are we at the first row?
                    IF row = 0 THEN ITERATE
                    DECR row
                    IF row < top THEN
                        DECR top ' move edit window up a line
                        freshen = %true
                        EXIT SELECT ' display the new window
                    END IF
                    ' is the current position off the end of the line?
                    WHILE ll(row) + col >= ll(row+1)
                        DECR col
                        IF col = 0 THEN ITERATE
                    WEND
                    GOSUB setoffset
                    
                CASE %KEY_DOWN
                    ' are we at the end of the array?
                    IF row >= %MAXLINES -1 THEN ITERATE
                    ' are we at the end of the data?
                    IF (ll(row + 2) = 0) THEN ITERATE
                    GOSUB clrcursor
                    INCR row
                    ' is the current position off the end of the line?
                    WHILE ll(row) + col >= ll(row+1)
                        DECR col
                        IF col < 0 THEN ITERATE
                    WEND
                    GOSUB setoffset
                    ' cursor at end of edit window
                    IF row >= (top + lpd) THEN
                        INCR top
                        freshen = %true
                        EXIT SELECT
                    END IF
                    
                CASE %KEY_CtrlF ' to start of next word
                    GOSUB clrcursor
                    p = cursoroffset + STRPTR(stext)
                    WHILE p < endoftext
                        IF @p < 33 THEN
                            whitespace = %true
                        ELSE
                            IF whitespace = %true THEN' we have gone thru whitespace to get to a "printable" char
                                whitespace = %false
                                cursoroffset = p - STRPTR(stext)
                                'lastrow = row: lastcol = col
                                GOSUB getrowcolfroffset
                                IF row > (lpd + top -1) THEN
                                    INCR top
                                    freshen = %true
                                    EXIT SELECT
                                END IF
                                EXIT LOOP
                            END IF
                        END IF
                        INCR p
                    WEND
                    
                CASE %KEY_CtrlA ' to start of next word
                    GOSUB clrcursor
                    p = cursoroffset + STRPTR(stext)
                    WHILE p >= STRPTR(stext)
                        IF @p < 33 THEN
                            whitespace = %true
                        ELSE
                            IF whitespace = %true THEN' we have gone thru whitespace to get to a "printable" char
                                whitespace = %false
                                ' we have arrived at the trailing char if the target word
                                ' so wind back to the leading char
                                WHILE (@p > 32)
                                    DECR p
                                    IF p < STRPTR(stext) THEN EXIT LOOP ' start of string
                                WEND
                                INCR p
                                cursoroffset = p - STRPTR(stext)
                                'lastrow = row: lastcol = col
                                GOSUB getrowcolfroffset
                                IF row < top THEN
                                    DECR top
                                    freshen = %true
                                END IF
                                EXIT LOOP
                            END IF
                        END IF
                        DECR p
                    WEND
                    
                CASE %KEY_RIGHT
                    GOSUB clrcursor
                    INCR cursoroffset
                    ' are we at the end of the text?
                    IF cursoroffset = endoftext - STRPTR(stext) THEN
                        stext = stext + " "
                        INCR endoftext
                        INCR ll(row + 1)
                        GOSUB getrowcolfroffset
                        freshen = %true
                    ELSE
                        'are we at the right hand end of the row?
                        IF col = ll(row + 1) - ll(row) THEN
                            GOSUB getrowcolfroffset
                            IF row >= (lpd + top) THEN
                                INCR top
                                freshen = %true
                                EXIT SELECT
                            END IF
                        ELSE
                            INCR col
                        END IF
                    END IF
    
                CASE %KEY_LEFT
                    ' are we at extreme left or the row?
                    GOSUB clrcursor
                    IF col = 0 THEN
                        IF row = 0 THEN
                            ITERATE
                        ELSE
                            DECR cursoroffset
                            GOSUB getrowcolfroffset
                        END IF
                    ELSE
                        DECR cursoroffset
                        DECR col
                    END IF
                    IF row < top THEN DECR top
    
                CASE %KEY_DEL
                    ' delete a character
                    stext = LEFT$(stext, cursoroffset) + MID$(stext, cursoroffset + 2)
                    freshen = %true
                    
                CASE %KEY_BSP
                    ' destructive backspace
                    stext = LEFT$(stext, cursoroffset -1) + MID$(stext, cursoroffset + 1)
                    DECR col
                    DECR cursoroffset
                    GOSUB getrowcolfroffset
                    freshen = %true
                    
                CASE %KEY_ESC
                    FUNCTION = MAK(QUAD,MAK(DWORD,&H1B,0),0)
                    EXIT FUNCTION
                
                CASE 32 TO 126
                    stext = LEFT$(stext, cursoroffset) + CHR$(lTC) + MID$(stext, cursoroffset + 1)
                    INCR cursoroffset
                    INCR col
                    freshen = %true
    
                CASE 13
                    stext = LEFT$(stext, cursoroffset) + $CRLF + MID$(stext, cursoroffset + 1)
                    cursoroffset = cursoroffset + 2
                    col = 0
                    INCR row
                    freshen = %true
    
                CASE ELSE
                    freshen = %true
            END SELECT
        LOOP
        EXIT FUNCTION ' should never get here!
    '''''''''''''''''''''''''''''''''''''''''''''''''
    again:
        'get no of characters per line
        cpl = (r.nright - r.nleft - 2*%hmargin ) \pxcwide
        'get no of lines in display
        lpd = (r.nbottom - r.ntop - 2 * %vmargin ) \pxchigh
        GRAPHIC COLOR %fgcolor, %bgcolor
        REDIM ll(0 TO %MAXLINES) AS LOCAL BYTE PTR
        GRAPHIC BOX ( lastrect.nleft, lastrect.ntop) - (lastrect.nright, lastrect.nbottom),0,%WHITE,%WHITE,0
        GRAPHIC BOX (r.nleft,r.ntop) - (r.nright, r.nbottom), 0,0,%WHITE,0
        ' split text into lines until text or exhausted or > maxlines
        endoftext = STRPTR(stext) + LEN(stext)
        p = STRPTR(stext)
        rw = 0: cl = 0
        pe = p
        '
        DO
            ll(rw) = pe
            p = pe
            ' substring to consider is bounded by p and pe
            ' it is the max possible line length (cpl=chars per line)
            pe = p + cpl -1
            IF pe > endoftext THEN
                pe = endoftext
                INCR rw
                EXIT LOOP
            END IF
            ' look forward for first line break
            pf = p
            WHILE pf < pe
                IF @pf = 13 THEN
                    pe = pf ' leave CR on the end of the line
                    EXIT LOOP ' exit this WHILE loop
                END IF
                INCR pf
            WEND
            ' if no line break, look backwards for first word break
            IF @pe <> 13 THEN ' no line break detected
                WHILE @pe <> 32
                    IF pe = p THEN ' word exceeds line
                        pe = p + cpl
                        EXIT LOOP ' exit this WHILE loop
                    END IF
                    DECR pe
                WEND
            END IF
            WHILE @pe < 33
                INCR pe ' leave LF, CR or control chars on end of line
                IF pe > p + cpl THEN EXIT LOOP
            WEND
            INCR rw
            IF rw > %maxlines THEN EXIT LOOP
        LOOP
        ' at this point the row variable points to the last row used +1
        ll(rw) = pe ' set limiting size into pointer array
        ' display lines in text box
        FOR rw = top  TO top + lpd -1
            IF ll(rw + 1) = 0 THEN EXIT FOR
            pbwd = ll(rw)
            lline = ll(rw +1) - pbwd
            s = STRING$(cpl, 0)
            movememory(BYVAL STRPTR(s), @pbwd, lline)
            GRAPHIC SET POS ( r.nleft + 2 , r.ntop + 2 + ((rw - top) * pxchigh))
            REPLACE $NUL WITH $SPC IN s
            GRAPHIC PRINT s
        NEXT
        pbwd = STRPTR(stext)
        FOR i = 0 TO %MAXLINES
            IF ll(i) = 0 THEN EXIT FOR
            ll(i) = ll(i) - pbwd
        NEXT
    
        maxright  = 375
        maxbottom = 315
        skey = ""
        lastrect = r ' save box rectangle in case it is changed
    RETURN
    '''''''''''''''''''''''''''''''''''''''''''''''''
                'calculate current position (row, col) from cursoroffset (position in text string)
    getrowcolfroffset:
        FOR i = 0 TO %MAXLINES
            IF ll(i)  > cursoroffset THEN
                row = i - 1
                col = cursoroffset - ll(row)
                EXIT FOR
            END IF
        NEXT
    RETURN
    setoffset:
        cursoroffset = ll(row) + col
    clrcursor:
        ' if the cursor position is in view, clear it
        IF lastrow <= (top + lpd) THEN
            IF lastrow >= top THEN
                IF ( lastcol <= cpl) THEN
                    GRAPHIC SET POS ( r.nleft + %hmargin + pxcwide*lastcol , r.ntop + %vmargin + pxchigh * (lastrow-top))
                    GRAPHIC COLOR %fgcolor, %bgcolor
                    GRAPHIC PRINT MID$(stext, ll(lastrow) + lastcol + 1,1)
                END IF
            END IF
        END IF
    RETURN
    '''''''''''''''''''''''''''''''''''''''''''''''''
    shewcursor:
        ' if the cursor position is in view, highlight it
        IF row <= (top + lpd) THEN
            IF row >= top THEN
                IF ( col <= cpl) THEN
                    IF (col > -1) THEN
                        GRAPHIC SET POS ( r.nleft + %hmargin + pxcwide*col , r.ntop + %vmargin + pxchigh * (row-top))
                        GRAPHIC COLOR %fgcolor, %cursorbgcolor
                        GRAPHIC PRINT MID$(stext, ll(row) + col + 1,1)
                    END IF
                END IF
            END IF
        END IF
    RETURN
    '''''''''''''''''''''''''''''''''''''''''''''''''
    END FUNCTION
    '-------------------------------------------------
    
    FUNCTION PBMAIN () AS LONG
        LOCAL hGW AS DWORD
        LOCAL qrect AS QUAD
        LOCAL qtc AS QUAD
        LOCAL s AS STRING
        LOCAL hstatic AS DWORD
    
        GRAPHIC WINDOW "text editor", 100, 100, 450, 450 TO hGW
        hStatic = GetWindow(hGW, %GW_CHILD)                       ' Retrieve static handle of graphic window
        GrStaticProc = SetWindowLong(hStatic, %GWL_WNDPROC, CODEPTR(GrProc)) ' Subclasses Graphic control
        GRAPHIC ATTACH hGW, 0
        GRAPHIC COLOR %BLACK, %WHITE
        s = "Titiro e Kawana--a whakarongo mai hoki. " + $CRLF + "Ko te wahi e nohoia na e koe, ko " + _
            "te wahi tena i noho ai to matou tupuna a Hinemoa, i tona Kauanga mai. " + _
            "Kia kauwhautia atu iana, e ahau, ki a koe. Na, ko Rangiuru, te matua " + _
            "wahine o Tutanekai, ko Whakaue-Kaipapa tana tane tupu; he tane tahae a " + _
            "Tuwharetoa. Ko ana tamariki matamua tokotoru, ko o ratou ingoa, ko " + _
            "Tawakeheimoa, ko Ngararanui, ko Tuteaiti; muri iho o te tokotoru, ka " + _
            "moea tahaetia a Rangiuru e Tuwharetoa."+$CRLF + "I haere manuhiri mai a " + _                  '
            "Tuwharetoa, nana a Tutanekai, he poriro ia, otira i moea ano e Whakaue a " + _
            "Rangiuru; ka hapu ano, he tamaiti, ko Kopako tona ingoa; ka hapu ano " + _
            "hoki ia i muri iho i a Kopako, he tamahine, Ko Tupa tona ingoa, ko te " + _
            "whakapakanga ia o nga tamariki a Whakaue."
        GRAPHIC SET POS ( 20, 340)
        GRAPHIC PRINT "Left-click to plant the bottom right corner of the text, ESC to exit"
        GRAPHIC SET POS ( 20, 355)
        GRAPHIC PRINT "word-wise navigation: Ctrl-A, Ctrl-F"
        qrect = MAK(QUAD,MAK(DWORD,20,20),MAK(DWORD,400,300))
        qtc = edittext ( hGW, s, qrect, 100, 100, $ESC + $NUL)
    
    END FUNCTION

  • #2
    slightly improved version
    Code:
    ' a stab at a Text Editor using PBCC GRAPHIC WINDOW
    ' Chris Holbrook Oct 2008
    '
    ' V 0.2 - subclassing the graphic window for mouse control
    ' V 0.3 - cursor navigation
    ' V 0.4 - character insert, delete, backspace
    ' V 0.5 - 8-NOV-2009 using Caret stuff from Win32API following Dave Bigg's example in the PB forums,
    '                    disabled edit window resizing
    '                    move caret to click location
    '                    using GRAPHIC REDRAW for better performance
    '                    some old bugs fixed
    '                    some new ones awaiting discovery
    '
    #compile exe
    #dim all
    #debug display
    #include "WIN32API.INC"
    $VERSION = "0.5"
    %TRUE = 1
    %FALSE = 0
    %LMOUSE_DOWN = -1
    %KEY_LEFT    = 19200
    %KEY_RIGHT   = 19712
    %KEY_HOME    = 18776
    %KEY_END     = 20224
    %KEY_DEL     = 21248
    %KEY_UP      = 18432
    %KEY_DOWN    = 20480
    %KEY_TAB     = 9
    %KEY_BSP     = 8
    %KEY_RET     = 13
    %KEY_ESC     = 27
    %KEY_CTRLF   = 6
    %KEY_CTRLA   = 1
    %KEY_CTRLV   = 22
    %UM_UPDATECARETPOS = %wm_user + 1001
    %UM_CREATECARET = %wm_user + 1000
    %bgcolor = %white
    %cursorbgcolor = %cyan
    %hmargin = 2
    %vmargin = 2
    %MAXLINES = 999
    %MINHEIGHT = 5
    %MINWIDTH = 20
    
    global GrDialogProc as long
    global GrStaticProc as long
    global gMouseX as long,gMouseY as long    ' Mouse x and y
    global gLbDOWN as long,gRBDOWN as long    ' Left and right mouse button
    global gMouseMoved as long                ' Detect mouse movements
    global gpxw, gpxh as long                 ' character dimensions
    global ghstatic as dword
    global gTopRow as long                    ' the line (row) number of the top of the edit window
    global geditrect as rect                  ' the rect for the editor panel
    global gctrl as long                      ' control key down flag
    global gTabKey as long                    ' tab key pressed flag
    
    '-------------------------------------------------------------------------------
    function GrProc(byval hWnd as dword, byval wMsg as dword, byval wParam as dword, byval lParam as long) as long
      local p as pointapi
      local x, y as long
    
      select case wMsg
        case %UM_CREATECARET
         CreateCaret hWnd, 0, gpxw, gpxh  ' Create solid caret size of font character grid
    
        ' User message to update caret pos
        ' wparam lsw is column, msw is row
        case %UM_UPDATECARETPOS
          local xx, yy as long
          x = wParam : y = lParam
          xx = x * gpxw: yy = y * gpxh
          xx = geditrect.nleft + gpxw*x
          yy = geditrect.ntop + gpxh * (y-gtoprow)
          SetCaretPos xx, yy
          ShowCaret hWnd
        '
        case %wm_killfocus
          DestroyCaret ' Don't show caret if focus elsewhere
        '
        case %wm_setfocus
          CreateCaret hWnd, 0, gpxw, gpxh
          ShowCaret hWnd  ' we're back! - show caret
        '
        case %wm_lbuttondown                   ' Left button pressed
            gLBDOWN = 1
            gMouseX = lo(word, lparam)
            gMouseY = hi(word, lparam)
            exit function
        '
        case %wm_rbuttondown
            gRBDOWN = 1
            exit function                      ' Right button pressed
        '
        case %wm_char                          ' just to catch the tab key
            if wparam = %VK_TAB then
                gTabKey = 1
                function = 1
            end if
      end select
      function = CallWindowProc(GrStaticProc, hWnd, wMsg, wParam, lParam)
    
    end function
    '--------------------------------------------------------------------
    ' edit text
    %fgcolor = %black
    
    function edittext ( hGW as dword, byref stext as string, r as rect, minx as long, miny as long,term as string) as quad
    
        local ll() as byte ptr' array of start of line offsets
        local hardbreak as long ' CR flag, zero for a soft break
        local CharsPerLine, i, LinesPerDisplay, lline, endoftext as long
        local rw, cl as long ' row, col for generating edit window, not for editing!
        local row, col, bottomline as long ' for keeping edit location within window
        local pbwd, p, pe, pf  as byte ptr
    
        dim ll(0 to %MAXLINES) as local byte ptr ' array of start of line offsets
        dim linebreak(0 to %MAXLINES) as local long ' array of linebreak types
        local lastrect as rect
        local skey, s, blankline as string
        local x, y, l, movemode, n, ltc, touched, untouchedtext  as long
        local pw as word ptr
        local cursoroffset as long ' the offset in the string of the current (cursor) character)
                                   ' it is not changed by resizing the edit window
        local lastrow, lastcol as long ' the row and column before edit window resizing
        local whitespace as long ' bool
        '
        graphic font "Courier New", 8
        'get pixel sizes of characters
        graphic chr size to gpxw, gpxh
        charsperline = int((r.nright - r.nleft)+ 0.5)/gpxw
        blankline = space$(charsperline) ' used in redisplay SR
        linesperdisplay = int((r.nbottom - r.ntop) + 0.5)/gpxh
        geditrect = r
        gosub redisplay
        SendMessage ghStatic, %UM_CREATECARET, 0, 0            ' Create caret
        row=0: col=0                                            ' Rows and columns in box
        SendMessage ghStatic, %UM_UPDATECARETPOS, col, row
        graphic redraw
        touched = 1
        gosub redisplay
    '======================================InKey$ Loop==============================================
        do
            graphic inkey$ to skey
            sleep 2
            select case len(skey)
                case 1 : lTC = asc(skey)
                case 2 : pw = strptr(skey): lTC = @pw
                case 4 : ' mouse response unexpected
            end select
            skey = ""
            if gtabkey then ' flag set by the subclass proc when a tab key is detected
                lTC = %KEY_TAB
                gtabkey = 0
            else
                ' KLUDGE for Ctrl-L & Ctrl-R
                local ctrl as long
                ctrl = GetAsyncKeyState(%VK_CONTROL)
                if ctrl then
                    select case as long lTC
                        case %key_right
                            lTC = %KEY_CTRLF
                        case %Key_left
                            lTC = %KEY_CTRLA
                    end select
                end if
            end if
            if gLBdown then
                col = int((gMouseX - r.nleft + 0.5) / gpxW)
                row = int((GMouseY - r.ntop + 0.5) / gpxH)
                gosub setoffset
                gosub UpdateCaretPos
                gLBDown = 0
            else
                touched = 0
                select case as long lTC
                    '
                    case %KEY_CTRLV
                        touched = 1
                        clipboard get text to s
                        stext = left$(stext, cursoroffset) + s + mid$(stext, cursoroffset + 1)
                        cursoroffset = cursoroffset + len(s)
                        gosub redisplay
    '                    gosub getrowcolfroffset ' recalc row & col posn
    
                    case %KEY_UP
                        if row = 0 then iterate
                        decr row
                        ' is the current position off the end of the line?
                        while ll(row) + col >= ll(row+1)
                            decr col
                            if col = 0 then iterate
                        wend
                        gosub setoffset
    
                    case %KEY_DOWN
                        ' are we at the end of the array?
                        if row >= %MAXLINES -1 then iterate
                        ' are we at the end of the data?
                        if (ll(row + 2) = 0) then iterate
                        incr row
                        ' is the current position off the end of the line?
                        while ll(row) + col >= ll(row+1)
                            decr col
                            if col < 0 then iterate
                        wend
                        gosub setoffset
    
                    case %KEY_CtrlF ' to start of next word
                        p = cursoroffset + strptr(stext)
                        while p < endoftext
                            if @p < 33 then
                                whitespace = %true
                            else
                                if whitespace = %true then' we have gone thru whitespace to get to a "printable" char
                                    whitespace = %false
                                    cursoroffset = p - strptr(stext)
                                    exit loop
                                end if
                            end if
                            incr p
                        wend
    
                    case %KEY_CtrlA ' to start of next word
                        p = cursoroffset + strptr(stext)
                        while p >= strptr(stext)
                            if @p < 33 then
                                whitespace = %true
                            else
                                if whitespace = %true then' we have gone thru whitespace to get to a "printable" char
                                    whitespace = %false
                                    ' we have arrived at the trailing char if the target word
                                    ' so wind back to the leading char
                                    while (@p > 32)
                                        decr p
                                        if p < strptr(stext) then exit loop ' start of string
                                    wend
                                    incr p
                                    cursoroffset = p - strptr(stext)
                                    exit loop
                                end if
                            end if
                            decr p
                        wend
    
                    case %KEY_RIGHT
                        incr cursoroffset
                        ' are we at the end of the text?
                        if cursoroffset = endoftext - strptr(stext) then
                            stext = stext + " "
                            incr endoftext
                            incr ll(row + 1)
                        end if
                        gosub UpdateCaretPos
    
                    case %KEY_LEFT
                        ' are we at extreme left of the row?
                        if col = 0 then
                            if row = 0 then
                                iterate
                            else
                                decr cursoroffset
                            end if
                        else
                            decr cursoroffset
                        end if
    
                    case %KEY_DEL
                        touched = 1
                        ' delete a character
                        stext = left$(stext, cursoroffset) + mid$(stext, cursoroffset + 2)
    
                    case %KEY_BSP
                        touched = 1
                        ' destructive backspace
                        stext = left$(stext, cursoroffset -1) + mid$(stext, cursoroffset + 1)
                        'decr col
                        decr cursoroffset
    
                    case %KEY_ESC
                        function = mak(quad,mak(dword,&H1B,0),0)
                        exit function
    
                    case 32 to 126
                        touched = 1
                        stext = left$(stext, cursoroffset) + chr$(lTC) + mid$(stext, cursoroffset + 1)
                        incr cursoroffset
    
                    case %KEY_TAB
                        touched = 1
                        stext = left$(stext, cursoroffset) + $tab + mid$(stext, cursoroffset + 1)
                        cursoroffset += 4
    
                    case %KEY_RET
                        touched = 1
                        stext = left$(stext, cursoroffset) + $cr + mid$(stext, cursoroffset + 1)
                        incr cursoroffset
                        incr row
                        col = 0
    
                    case 0 ' do nowt
    
                    case else
                        ? str$(lTC) 'gosub redisplay
                end select
                if lTC then gosub redisplay
            end if
            lTC = 0 ' avoid repeating key action
        loop
        exit function ' should never get here!
    '''''''''''''''''''''''''''''''''''''''''''''''''
    redisplay:
        ' if the last key was a cursor movement and the display has not been scrolled,
        ' there is no need to rebuild the text. Unless this is the intial text display.
        n = gTopRow
        if touched = 0 then
            gosub UpdateCaretPos
            if n = gTopRow then return
        end if
        ' ll() is populated here as a pointer array,
        ' each element pointing to the first character of a line.
        replace $lf with "" in stext
        replace $tab with "    " in stext' 4 spaces
        graphic color %fgcolor, %bgcolor
        redim ll(0 to %MAXLINES) as local byte ptr
        redim lbreak(0 to %MAXLINES) as local long
        endoftext = strptr(stext) + len(stext)
        p = strptr(stext)
        rw = 0: cl = 0
        pe = p
        bottomline = gTopRow + LinesPerDisplay + 2
        do
            hardbreak = 0
            ll(rw) = pe
            p = pe
            ' chunk to consider is bounded by p and pe
            ' it is the max possible line length
            ' but could contain several CR delimited lines
            pe = p + CharsPerLine -1
            if pe > endoftext then ' we are on the last chunk...
                pe = endoftext
    '            incr rw
    '            exit loop
            end if
            ' look forward for first line break
            pf = min(p, endoftext)
            while pf < pe
                if @pf = 13 then
                    hardbreak = 1 ' hard break - CR is not stored in array
                    pe = pf + 1   ' advance pointer past CR
                    exit loop ' exit this WHILE loop
                end if
                incr pf
            wend
            ' wordwrap - if no line break, look backwards for first word break
            if hardbreak = 0 then 'if @pe <> 13 then ' no line break detected
                while @pe <> 32
                    if pe = p then ' word exceeds line
                        pe = p + CharsPerLine
                        exit loop ' exit this WHILE loop
                    end if
                    decr pe
                wend
                incr pe ' so that the new line starts with the character following the space
            end if
            incr rw
        loop until  (p >= endoftext) or ( rw > bottomline)   ' (rw > %maxlines) or
        decr rw
        ' at this point the row variable points to the last row used +1
        ll(rw) = min(pe, endoftext) ' set limiting size into pointer array
        ' display lines in text box
        for rw = gTopRow  to bottomline -2 'gTopRow + LinesPerDisplay -1
            p = ll(rw)
            if (p = 0) or (ll(rw + 1) = 0)  then
                s = blankline
            else
                lline = ll(rw + 1) - p                              ' get length of line
                s = space$(lline)                                   ' create a copy of the line
                movememory(byval strptr(s), @p, lline)              ' drop line into buffer
                s = left$(s + blankline, charsperline)   ' left-align text
            end if
            graphic set pos ( r.nleft, r.ntop + ((rw - gTopRow) * gpxh))
            graphic print s
        next
        ' turn the array of pointers into an array of offsets
        ' by subtracting the start of string address
        p = strptr(stext)
        for i = 0 to %MAXLINES
            if ll(i) = 0 then exit for
            ll(i) = ll(i) - p
        next
        skey = ""
        gosub UpdateCaretPos
        graphic redraw
    return
    '''''''''''''''''''''''''''''''''''''''''''''''''
    ' calculate current position (row, col) from cursoroffset (position in text string)
    ' if it is off the display area, scroll the display by recalculating gTopRow
    getrowcolfroffset:
        for i = 0 to %MAXLINES
            if ll(i) > cursoroffset then
                row = i - 1
                col = cursoroffset - ll(row)
                exit for
            end if
        next
        ' don't let caret go south of bottom margin.
        if row < gTopRow then
            while row < gTopRow
                decr gTopRow
            wend
            return
        end if
        if row > (gtoprow + LinesperDisplay -1) then
            while row > (gtoprow + LinesperDisplay -1)
                incr gTopRow
            wend
        end if
    return
    '''''''''''''''''''''''''''''''''''''''''''''''''
    ' set the offset from the row and column positions
    setoffset:
        cursoroffset = ll(row) + col
    return
    '''''''''''''''''''''''''''''''''''''''''''''''''
    ' calculate the insertion position and update the caret position
    UpdateCaretPos:
        gosub getrowcolfroffset
        SendMessage ghStatic, %UM_UPDATECARETPOS, col, row
    return
    '''''''''''''''''''''''''''''''''''''''''''''''''
    end function
    
    '=============================================
    function pbmain () as long
        local hGW as dword
        local r as rect
        local qtc as quad
        local s as string
    
        graphic window "PBCC text editor V" + $VERSION, 100, 100, 450, 450 to hGW
        '=========================================
        ' START THE SUBCLASSING
        '=========================================
        ' Retrieve static handle of graphic window
        ghStatic = GetWindow(hGW, %GW_CHILD)
        ' Subclasses Graphic control
        GrStaticProc = SetWindowLong(ghStatic, %GWL_WNDPROC, codeptr(GrProc))
        '=========================================
        graphic attach hGW, 0, redraw
        graphic color %black, %white
        graphic set pos ( 20, 340)
        graphic print "ESC to exit"
        graphic set pos ( 20, 355)
        graphic print "word-wise navigation: Ctrl-A, Ctrl-F or Ctrl-L and Ctrl-R"
        graphic set pos ( 20, 370)
        graphic print "insert from clipboard Ctrl-V"
        '=========================================
        ' GET THE CLIPBOARD CONTENTS
        '=========================================
        clipboard get text to s
        '=========================================
        ' SET DIMENSIONS HERE
        '=========================================
        setrect r, 20, 20, 400, 300
        '=========================================
        ' CALL THE EDITOR
        '=========================================
        qtc = edittext ( hGW, s, r, 100, 100, $esc + $nul)
        '=========================================
        ' UNDO THE SUBCLASSING
        '=========================================
        SetWindowLong(ghStatic, %GWL_WNDPROC, grStaticProc)
        '=========================================
        ' FINISHED WITH GRAPHIC WINDOW
        '=========================================
        graphic window end
    end function

    Comment


    • #3
      now compiles using PBWin10

      Source code in Source Code Forum: http://www.powerbasic.com/support/pb...114#post436114
      Last edited by Chris Holbrook; 11 Aug 2013, 02:58 PM.

      Comment

      Working...
      X