now compiles using PBWin10
Source code in Source Code Forum: http://www.powerbasic.com/support/pb...114#post436114
-
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 functionLeave a comment:
-
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
Leave a comment: