Graphic Screen Mouse Cursor Location

[Michael Mattias]

. Maybe you are using a different or altered WIN32API.INC, in which the POINTAPI UDT is defined otherwise.

That just gave me a great new feature suggestion.... for the Source Code Bundler. at Source Code Bundler v 3 handles PB 7/8/9/10 and CC 3/4/5/6 source code

(I already submitted this to PB but I am not holding my breath).

WHAT IF... one of the options after gathering up all the #INCLUDE files was,"Create Single-File source code file?"

Might be a really cool debugging tool, as it would give you ONE file with everything the compiler sees in the order it sees it. Should be a heck of a lot easier to find all those "duplicate definition" or "parameter mismatch" errors, huh?

Maybe add it as a context menu item when you have the files list control filled?

Hey, the source code is there, anyone could do it.

[Manuel Valdes]

Hi Mark,

In my system the code works OK. Maybe you are using a different or altered WIN32API.INC, in which the POINTAPI UDT is defined otherwise.

Regards,

[Mark Longley-Cook]

In my haste, I wasn't too clear. You have to look at Valdes' program (the 6th post this thread):

#COMPILE EXE
#CONSOLE OFF
#DIM ALL

#INCLUDE "WIN32API.INC"

GLOBAL hvin AS LONG

FUNCTION PBMAIN () AS LONG
DIM MousePoint AS POINTAPI
LOCAL hWin AS LONG
GRAPHIC WINDOW "Cursor Position",0,0,800,600 TO hwin
GRAPHIC ATTACH hWin, 0, REDRAW
hvin=1
DO
SLEEP 20
IF hvin=0 THEN EXIT LOOP
GRAPHIC GET DC TO hvin
GetCursorPos Mousepoint
ScreenToClient hWin,mousepoint
GRAPHIC SET POS (20,20)
GRAPHIC PRINT "X: ";Mousepoint.x;" Y: ";Mousepoint.y;" "
GRAPHIC REDRAW
LOOP
GRAPHIC WINDOW END
END FUNCTION

If instead of

GRAPHIC PRINT "X: ";Mousepoint.x;" Y: ";Mousepoint.y;" "

one codes

GRAPHIC PRINT "X: ";Mousepoint.x-900;" Y: ";Mousepoint.y-700;" "

(in order to translate the cursor point to a different coordinate system, say)
both numbers printed will be near 2^32, not negative (assuming the cursor is inside "Cursor Position" window).

[Michael Mattias]

> I don't see how the MousePoint.x or MousePoint.y are DWORDs.

That was my issue, too.

(But I only did 'find' on this page)


FWIW, MSDN says..

typedef struct tagPOINT { 
  LONG x; 
  LONG y; 
} POINT, *PPOINT;

[Rodney Hicks]

Michael, in the second post of this thread we have

DIM MousePoint AS POINTAPI

and in WinDef.inc we have

TYPE POINT
    x AS LONG
    y AS LONG
END TYPE

' [PowerBASIC legacy]
TYPE POINTAPI
    POINT
END TYPE

I don't see how the MousePoint.x or MousePoint.y are DWORDs. Unless I missed another instance of the declaration.

[Michael Mattias]

>There is a cautionary note to add. Mousepoint.x and Mousepoint.y are DWORD's...

Source of "Mousepoint" ??? Firefox could not find on this page.

Not found in PBCC 6 help or my WinAPI reference, either.

[Mark Longley-Cook]

Mousepoint note

Manuel Valdes' program is a nice little routine for identifying the location of the mouse cursor and normally all that is needed.

There is a cautionary note to add. Mousepoint.x and Mousepoint.y are DWORD's, and DWORD variables can have unintended precedence over LONG's.

If Mousepoint.x and Mousepoint.y are to be used in a formula, for example, they should first be converted to LONG variables by
Mousepointx&=Mousepoint.x: Mousepointy&=Mousepoint.y

(Use of CLNG(Mousepoint.x) and CLNG(Mousepoint.y) apparently will NOT work as an alternative.)

[Michael Mattias]

>Sorry, I just had a dose of pious truism fatigue!

No such luck.

You may expect more of same until the less desireable of the two nether worlds freezes over or I relocate to either.

[Dave Biggs]

Oh I know Basil... I know!

[Chris Holbrook]

"Easily avoided by using only the intrinsic functions provided for various purposes when managing proprietary objects."

Oh **** its the Thought Police again. Us code bandits better hide!

Sorry, I just had a dose of pious truism fatigue!

[Michael Mattias]

Proprietary: "Subject to change without notice, negating any assumptions you have made about how it is implemented causing previously-working software to become not-working software if recompiled with a different version/subversion/build of the compiler."

"Easily avoided by using only the intrinsic functions provided for various purposes when managing proprietary objects."

[Dave Biggs]

The PB/CC GRAPHIC WINDOW is proprietary.

Ah so lets be very careful then

[Michael Mattias]

Just one little caution here...

The PB/CC GRAPHIC WINDOW is proprietary.

While often you can use Windows' API functions against these windows, you need to guard against assuming anything. Eg there was a change in these in I think 4x, where the actual graphic 'Windows' window" was changed to be a child window of the 'hWin' returned by the proprietary function (something like that, anyway).

In an ideal world, once you use the GRAPHIC WINDOW statement, you want manage that window using only the provided GRAPHIC <ANY> functions.

BTW..
>How can the current desktop not be the active desktop

Same reason the active window is not necessarily the foreground window. You can be 'working on' a window which is the foreground window, the active window, both or neither. These various attibutes and properties are distinct and separate. Same applies to Desktops; eg, if you start a process using CreateProcessAsUser(), references to the desktop will be to the logon user's desktop, not to the Creator-of-the-process-er's (now THERE is a word!) desktop.

MCM

[Dave Biggs]

I had to attack your code to get it to compile with PBCC.

Doh! I should stop interlopping if I can't stop those DDTs sneeking into my posts!

BTW I just noticed that the graphic window seems to be eating the Tab key (Ctrl-I doesn't get flagged).

Windows NT/2000/XP: The return value is zero for the following cases:

The current desktop is not the active desktop
The foreground thread belongs to another process and the desktop does not allow the hook or the journal record.

I didn't get those lines either! - How can the current desktop not be the active desktop?? The mind boggles.

[Chris Holbrook]

Dave,

I had to attack your code to get it to compile with PBCC. Yes, I have PBWIN also but just in case anyone who doesn't is following this thread... I'll post this now and return ...

...I'm back...

Yes, the result from GetAsyncKeyState(%VK_CONTROL) should in theory be masked. Reading around, a lot of people seem to use it as I did above. I suspect that it is pretty safe without masking, but why take the risk. MSDN tell us that the least significant bit is unreliable, so why bother with it?

Regarding other processes "stealing" the keystate, MSDN says:

Windows NT/2000/XP: The return value is zero for the following cases:

The current desktop is not the active desktop
The foreground thread belongs to another process and the desktop does not allow the hook or the journal record.

Not sure how that squares with your comments above (nor in fact whether MSDN is written in English!).

Any road up we have an apparently reliable way of getting a CTRL-Arrow and FTM lots of other useful keypresses without using a keyboard hook, which is a result.

Fun? ah, I remember fun - seems like only yesterday. Come to think of it it was only yesterday.

#register none
#dim all
#include "WIN32API.INC"

sub ControlCode(sKey as string)
 sKey = read$(asc(sKey))
 'C0 control code set
 data 01 SOH ^A, 02 STX ^B, 03 ETX ^C, 04 EOT ^D, 05 ENQ ^E, 06 ACK ^F, 07 BEL ^G, 08 BS ^H, 09 HT ^I
 data 10 LF ^J, 11 VT ^K, 12 FF ^L, 13 CR ^M, 14 SO ^N, 15 SI ^O, 16 DLE ^P, 17 DC1 ^Q, 18 DC2 ^R
 data 19 DC3 ^S, 20 DC4 ^T, 21 NAK ^U, 22 SYN ^V, 23 ETB ^W, 24 CAN ^X, 25 EM ^Y, 26 SUB ^Z
 data 27 ESC ^[, 28 FS ^\, 29 GS ^], 30 RS ^^, 31 US ^_
end sub
'------------------/ControlCode  'http://en.wikipedia.org/wiki/C0_and_C1_control_codes

function pbmain()
 local hGWnd as dword
 local s, sKey, sTemp as string
 local Clk, x, y as long

  graphic window "KeyMon", 200, 300, 300, 150 to hGWnd
  graphic attach hGWnd, 0

  do while IsWindow(hGWnd) <> 0                     ' Quit on Window close
    graphic inkey$ to sKey
    select case len(sKey)
      case 0                                        ' No keys pressed
        sleep 1
      case 1                                        ' ASCII Key pressed
        s = "' " + sKey + " '" + str$(asc(sKey))
        sendmessage hGWnd, %Wm_settext, 0, byval strptr(s)
        if asc(sKey) => 1 and asc(sKey) =< 31 then  ' Control Code
          sTemp = sKey : ControlCode(sTemp)
          s = " " + "Control Code: " + sTemp
          sendmessage hGWnd, %Wm_settext, 0, byval strptr(s)
        end if
        if sKey = $esc then                         ' Quit on Escape
          s = "Escape key pressed - Bye!" : sleep 2000
          sendmessage hGWnd, %Wm_settext, 0, byval strptr(s)
          exit loop
        end if
        if sKey = chr$(12) or sKey = chr$(18) then
          WinBeep 800,1
        end if
      case 2                                        ' Extended key pressed - * NB not number pad *
       local ctrl as integer
        ctrl = GetAsyncKeyState(%VK_CONTROL)  '10000000 00000001 Ctrl key down, 00000000 00000001 Ctrl released first
        select case asc(right$(sKey,1))
          case 69 : sTemp = "NumLock"
          case 71 : sTemp = "Home"                  ' *
          case 72 : sTemp = "Up Arrow"
          case 73 : sTemp = "Page up"               ' *
          case 75 : sTemp = "Left arrow"
            if ctrl  then WinBeep 800,1 : ? "Ctrl " + bin$(ctrl,16)
          case 77 : sTemp = "Right arrow"
            if ctrl = &H8001 or ctrl = &H8000 then WinBeep 800,1 : ? "Ctrl " + bin$(ctrl,16)
          case 79 : sTemp = "End"                   ' *
          case 80 : sTemp = "Down arrow"
          case 81 : sTemp = "Page down"             ' *
          case 82 : sTemp = "Insert"
          case 83 : sTemp = "Delete"
          case else : sTemp = "Other:" + str$(asc(right$(sKey,1)))
        end select
        s = " " + str$(asc(right$(sKey,1))) + "  " + sTemp : sTemp = ""
        sendmessage hGWnd, %Wm_settext, 0, byval strptr(s)
    end select
   sleep 0
  loop
 graphic window end
end function
'------------------/PBMain

[Dave Biggs]

Sugestion:

    do until IsWindow(hGW) = 0    '< Mod to allow loop to exit if window closed (user bails out w/out using the Esc Key)
        graphic inkey$ to skey
..

SDK Re: GetAsyncKeyState..

If the function succeeds, the return value specifies whether the key was pressed since the last call
to GetAsyncKeyState, and whether the key is currently up or down. If the most significant bit is set,
the key is down, and if the least significant bit is set, the key was pressed after the previous
call to GetAsyncKeyState. However, you should not rely on this last behavior...
Although the least significant bit of the return value indicates whether the key has been pressed
since the last query, due to the pre-emptive multitasking nature of Windows, another application can
call GetAsyncKeyState and receive the "recently pressed" bit instead of your application.

In the test code below you can see this behaviour in action.
If the user presses Ctrl-C for example, then later presses the Left Arrow key the "recently pressed"
bit will be set and the Arrow key press will behave like a Ctrl-LeftArrow key press.

The Right Arrow key code requires that the MSB (or both MSB and LSB) be set (Ctrl key to be currently
down) to get Wordwise navigation.

Noted: If another program (eg your editor code) is running at the same time and that program is
calling GetAsyncKeyState in a loop - it will affect the "recently pressed" bit in this test code

#REGISTER NONE
#DIM ALL
#INCLUDE "WIN32API.INC"
 
SUB ControlCode(sKey AS STRING)
 sKey = READ$(ASC(sKey))
 'C0 control code set
 DATA 01 SOH ^A, 02 STX ^B, 03 ETX ^C, 04 EOT ^D, 05 ENQ ^E, 06 ACK ^F, 07 BEL ^G, 08 BS ^H, 09 HT ^I
 DATA 10 LF ^J, 11 VT ^K, 12 FF ^L, 13 CR ^M, 14 SO ^N, 15 SI ^O, 16 DLE ^P, 17 DC1 ^Q, 18 DC2 ^R
 DATA 19 DC3 ^S, 20 DC4 ^T, 21 NAK ^U, 22 SYN ^V, 23 ETB ^W, 24 CAN ^X, 25 EM ^Y, 26 SUB ^Z
 DATA 27 ESC ^[, 28 FS ^\, 29 GS ^], 30 RS ^^, 31 US ^_
END SUB
'------------------/ControlCode  'http://en.wikipedia.org/wiki/C0_and_C1_control_codes
 
FUNCTION PBMAIN()
 LOCAL hGWnd AS DWORD
 LOCAL sKey, sTemp AS STRING
 LOCAL Clk, x, y AS LONG
 
  GRAPHIC WINDOW "KeyMon", 200, 300, 300, 150 TO hGWnd
  GRAPHIC ATTACH hGWnd, 0
 
  DO WHILE IsWindow(hGWnd) <> 0                     ' Quit on Window close
    GRAPHIC INKEY$ TO sKey
    SELECT CASE LEN(sKey)
      CASE 0                                        ' No keys pressed
        SLEEP 1
      CASE 1                                        ' ASCII Key pressed
        SetWindowText hGWnd, "' " + sKey + " '" + STR$(ASC(sKey))
        IF ASC(sKey) => 1 AND ASC(sKey) =< 31 THEN  ' Control Code
          sTemp = sKey : ControlCode(sTemp)
          SetWindowText hGWnd, " " + "Control Code: " + sTemp
        END IF
        IF sKey = $ESC THEN                         ' Quit on Escape
          SetWindowText hGWnd, "Escape key pressed - Bye!" : SLEEP 2000
          EXIT LOOP
        END IF
      CASE 2                                        ' Extended key pressed - * NB not number pad *
       LOCAL ctrl AS INTEGER
        ctrl = GetAsyncKeyState(%VK_CONTROL)  '10000000 00000001 Ctrl key down, 00000000 00000001 Ctrl released first       
        SELECT CASE ASC(RIGHT$(sKey,1))
          CASE 69 : sTemp = "NumLock"
          CASE 71 : sTemp = "Home"                  ' *
          CASE 72 : sTemp = "Up Arrow"
          CASE 73 : sTemp = "Page Up"               ' *
          CASE 75 : sTemp = "Left Arrow"
            IF ctrl THEN 
              WinBeep 800,1 : MessageBox hGWnd,bin$(ctrl,16),"Ctrl Value",%MB_ICONMASK: _
                    sTemp = "Ctrl+Left Arrow": END IF
          CASE 77 : sTemp = "Right Arrow"
            IF ctrl = &H8001 Or ctrl = &H8000 THEN 
              WinBeep 800,1 : MessageBox hGWnd,bin$(ctrl,16),"Ctrl Value",%MB_ICONMASK: _
                    sTemp = "Ctrl+Right Arrow": END IF
          CASE 79 : sTemp = "End"                   ' *
          CASE 80 : sTemp = "Down Arrow"
          CASE 81 : sTemp = "Page Down"             ' *
          CASE 82 : sTemp = "Insert"
          CASE 83 : sTemp = "Delete"
          CASE ELSE : sTemp = "Other:" + STR$(ASC(RIGHT$(sKey,1)))
        END SELECT
        SetWindowText hGWnd, " " + STR$(ASC(RIGHT$(sKey,1))) + "  " + sTemp : sTemp = ""
    END SELECT
   SLEEP 0
  LOOP
 GRAPHIC WINDOW END
END FUNCTION
'------------------/PBMain

You are right - the Ctrl_Arrow key navigation is built-in to a Rich edit control. (But where's the fun in that! )

[Chris Holbrook]

The cleaned-up wordwrapping editor source code is below (not in the Source Code Forum as it is a prototype). In the example, the text is taken from the clipboard. To run it, first copy a block of text to the clipboard.

On my notoriously slow development PC, the performance is acceptable with a few hundred lines of text.

Wordwise navigation uses the Ctrl-Left & Right arrows. A left click repositions the caret.

The next step would be to create an object with creation, destruction, import, export, etc methods (plus of course the subclass function which ISTR cannot live inside an object).

I'm still wondering why I did this given the relative ease with which a console application can use a Richedit control.

' 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 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 as string
    local x, y, l, movemode, ltc 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
    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
'======================================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
            select case as long lTC
                '
                case %KEY_CTRLV
                    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)
                    else
                        'are we at the right hand end of the row?
    '                    if col = ll(row + 1) - ll(row) - 1 then
    '                    end if
                    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
                    ' delete a character
                    stext = left$(stext, cursoroffset) + mid$(stext, cursoroffset + 2)

                case %KEY_BSP
                    ' 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
                    stext = left$(stext, cursoroffset) + chr$(lTC) + mid$(stext, cursoroffset + 1)
                    incr cursoroffset

                case %KEY_TAB
                    stext = left$(stext, cursoroffset) + $tab + mid$(stext, cursoroffset + 1)
                    'col +=4
                    cursoroffset += 4

                case %KEY_RET
                    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:
    ' 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
    '
    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 (rw > %maxlines) or (p >= endoftext)
    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 gTopRow + LinesPerDisplay -1
        p = ll(rw)
        if (p = 0) or (ll(rw + 1) = 0)  then
            s = space$(charsperline)
        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 + space$(charsperline), 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

[Chris Holbrook]

That will distinguish between whether the control key was pressed since the last call to GetAsyncKeyState, and whether the key is currently down.

Possibly. I was going on what the Win32 Programmer's Reference says:

If the function succeeds, the return value specifies whether the key was pressed since the last call to GetAsyncKeyState

Actually MSDN says it too. MSDN also says:

If the most significant bit is set, the key is down, and if the least significant bit is set, the key was pressed after the previous call to GetAsyncKeyState. However, you should not rely on this last behavior

The way I read this is "ignore the least significant bit" - so if anything it should be ANDed with #8000 before being tested. So my use of it depends upon the key being down, rather than the function being a toggle. It seems to work pretty well even with a SLEEP 200 immediately before the call to GetAsyncKeyState, though it is a bit ragged with a SLEEP 500 and a dead 'un with SLEEP 1000.

**** added **** Calling AsyncKeyControl does NOT clear the internal flag, but (I'm guessing) a keypress does, so as used it should be safe enough.

[Dave Biggs]

Ah I see..

Don't know why you call it a KLUDGE though - looks pretty good to me! (Terse even )

(Later) You should probably use this though..

            ctrl = GetAsyncKeyState(%VK_CONTROL)
            if ctrl = &H8001 then

That will distinguish between whether the control key was pressed since the last call to GetAsyncKeyState, and whether the key is currently down.

[Chris Holbrook]

the Ctrl-L and R keys are recognised as Control Codes as per

Sorry Dave I expressed myself poorly. I meant the Ctrl-Right Arrow and Ctrl-Left Arrow. The way I'm getting these is:

        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 not expected here
        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 arrow & Ctrl-R arrow
            local ctrl as long
            ctrl = GetAsyncKeyState(%VK_CONTROL)
            if ctrl then
                select case as long lTC
                    case %key_right
                        lTC = %KEY_CTRLF ' share Wordstar key function
                    case %Key_left
                        lTC = %KEY_CTRLA ' share Wordstar key function
                end select
            end if
        end if

I'm reworking that word-wrapping example now using the caret code which you posted and tidying it it a bit. I may even break with tradition and test it!