After drawing a graphic on the screen, can I then continuously read the location of the mouse (cursor-pointer)?
Announcement
Collapse
No announcement yet.
Graphic Screen Mouse Cursor Location
Collapse
X
-
GuestTags: None
-
I think so, but you have to include the window api. Maybe somebody has a better example.
Code:#COMPILE EXE #DIM ALL #INCLUDE "C:\PBCC40\WINAPI\WIN32API.INC" FUNCTION PBMAIN () AS LONG LOCAL NewCaption AS ASCIIZ * 40 LOCAL hGWin AS DWORD LOCAL t AS STRING, FileNam AS STRING, VolLabel AS STRING GRAPHIC WINDOW "Undraw test...",0,0,800,600 TO hgwin GRAPHIC ATTACH hGWin, 0, REDRAW NewCaption = "Howdy Folks" SetWindowText(hgWin, NewCaption) GRAPHIC SET POS (200,300) GRAPHIC PRINT "Now is the time for all good men to come to the aid of their country" GRAPHIC SET POS (200,340) GRAPHIC PRINT "The quick red fox jumped over the lazy dogs back many times." GRAPHIC SET POS (200,380) GRAPHIC PRINT "Now is the time for all good men to come to the aid of their country" GRAPHIC REDRAW SLEEP 3000 GRAPHIC SET MIX %MIX_NOTXORSRC GRAPHIC LINE (200,200)-(600,500) GRAPHIC REDRAW SLEEP 4000 GRAPHIC LINE (200,200)-(600,500) GRAPHIC REDRAW ' restore the default mode... GRAPHIC SET MIX %MIX_COPYSRC DIM MousePoint AS POINTAPI DO GetCursorPos Mousepoint GRAPHIC SET POS (200,480) GRAPHIC PRINT Mousepoint.y GRAPHIC SET POS (200,500) GRAPHIC PRINT Mousepoint.x GRAPHIC REDRAW LOOP GRAPHIC SET FOCUS NewCaption = "Goodbye Friends" SetWindowText(hgWin, NewCaption) SLEEP 6000 GRAPHIC WINDOW END END FUNCTION
-
-
Norm:
Look at a Code posted by Guy Dombroski on January 16th, 2009, in the Source Code Forum.
Regards,Last edited by Manuel Valdes; 8 Sep 2009, 05:14 PM.
Comment
-
-
Look at a Code posted by Guy Dombroski on January 16th, 2009, in the Source Code Forum.
The "GetCursorPos" solution suggested in post #2 might be easier, except that the returned POINT structure is in SCREEN coordinates, so you have to use the ScreenToClient() function to get the coordinates relative to the client area of the graphics window.
FWIW, the way the PB/CC "GRAPHICS" commands work... they are pretty much PROCEDURAL in nature, so "continuous" monitoring will entail some kind of looping structure. eg
Code:DO GetCursorPos pt ScreenToClient hWNd, pt do something with pt.x and pt.y (nmouse coordinates relative to graphics window) " now do whatever it is you REALLY want to do" LOOP
Last edited by Michael Mattias; 8 Sep 2009, 05:29 PM.Michael Mattias
Tal Systems (retired)
Port Washington WI USA
[email protected]
http://www.talsystems.com
Comment
-
-
I also just posed some code in the Source Code forum. "Display All 21 ...". It's for PBWin, but it show several examples of using API to get positions.
Code:Case %WM_SetCursor GetCursorPos pt 'pt has xy screen coordinates ScreenToClient hDlg, pt 'pt now has dialog client coordinates Control Set Text hDlg, %IDC_LabelA, "SetCursor: " + Str$(pt.x) + ":" + Str$(pt.y) Case %WM_MouseMove GetCursorPos pt 'pt has xy screen coordinates ScreenToClient hDlg, pt 'pt now has dialog client coordinates Control Set Text hDlg, %IDC_LabelB, "MouseMove: " + Str$(pt.x) + ":" + Str$(pt.y)
Comment
-
-
Combining Jerry's and Michael's. Close the Graphic Window to end.
Code:#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
Comment
-
-
A comment would have been useful...
Code:#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 ' with this line out, process does not end on 'X' . That makes no sense to me. ' oh yes it does. hvin never becomes zero, so loop never exits. "X" ' destroys the window, making the DC zero and forcing the exit from the loop. 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
Michael Mattias
Tal Systems (retired)
Port Washington WI USA
[email protected]
http://www.talsystems.com
Comment
-
-
Michael:
You are right. This is the reason why it is necessary to add the sleep 20. If commented, the screen manipulation, for instance to move the graphic screen turns extremely slugguish.
This is also one reason why I prefer not to use the cursor position in my programs, relying on the clicks positions instead, So you can stop the loop until a click is performed.
Regards,
Comment
-
-
Code:DO WHILE IsWindow (hWin) LOOP
PB/Win has a new ISWIN() function; PB/CC does not, for reasons unknown to this writer.Michael Mattias
Tal Systems (retired)
Port Washington WI USA
[email protected]
http://www.talsystems.com
Comment
-
-
Graphic input added
Hi everybody,
I reworked the previous code a bit to show Norm how to get a keyboard input in a graphic window.
Now, you can type any characters and a Return will get you to the next line.
Very simple and straightforward code.
Of course, there is a lot more code to add in order to catch all the other special keys and all mouse events.
But I also wanted to add a caret to show the typing position but I must miss something as it will not work. In my Graphic console I use a non blinking box.
Anyone can show me my error ?
Code:#COMPILE EXE #BREAK ON #CONSOLE OFF #DEBUG ERROR ON DEFLNG a-z #INCLUDE "WIN32API.INC" FUNCTION PBMAIN () AS LONG DIM MousePoint AS POINTAPI LOCAL hWin AS LONG GRAPHIC WINDOW "Show Cursor Position and input any characters. Return for next line. Esc to end.",0,0,800,600 TO hwin GRAPHIC ATTACH hWin, 0, REDRAW FONT NEW "Lucida Console",12,0,0,0,0 TO F1 GRAPHIC SET FONT F1: GRAPHIC CHR SIZE TO W1,H1 ' Find pixel width and height of fnt1 graphic font x=0: y=H1 DO GRAPHIC INKEY$ TO ink$: SLEEP 1 GRAPHIC GET DC TO hwin: IF hwin=0 THEN EXIT DO GetCursorPos Mousepoint: ScreenToClient hWin,mousepoint GRAPHIC SET POS (0,0): GRAPHIC PRINT "X:";Mousepoint.x;" Y:";Mousepoint.y;" ": GRAPHIC REDRAW IF ink$="" THEN ITERATE '------------------------------------------------ Trying to get a caret -------------------- DestroyCaret CaretWidth=12: CaretHeight=9 CreateCaret(hwin,%null,caretWidth,CaretHeight) SetCaretPos(x,y): ShowCaret (hwin) '-------------------------------------------------------------------------------------------- IF ink$=CHR$(13) THEN IF y<600 THEN y=y+h1: x=0: ink$="": ITERATE ELSE BEEP ' Return for next line END IF '--------------------------------------------------------------------------------------------- GRAPHIC SET POS (x,y): GRAPHIC PRINT ink$ IF x<800 THEN x=x+w1 ELSE BEEP GRAPHIC REDRAW LOOP UNTIL ink$=CHR$(27) GRAPHIC WINDOW END END FUNCTION
Old QB45 Programmer
Comment
-
-
Code:DO GRAPHIC INKEY$ TO ink$: SLEEP 1 [COLOR="Red"] GRAPHIC GET DC TO hwin: IF hwin=0 THEN EXIT DO <<<<<<< [/COLOR] ... LOOP
Code:DO ....... LOOP UNTIL ink$= $ESC or ISFALSE IsWindow(hWin)
Michael Mattias
Tal Systems (retired)
Port Washington WI USA
[email protected]
http://www.talsystems.com
Comment
-
-
Subclassing ?
Norm, maybe this is also more than what you want, but i once posted
a set of screenhandlers with built in subclassing at
Subclassing enables the PBCC graphic window to receive Windows messages,
for example about the mouse.
As i posted it, the screenhandlers support just the mouse clicks.
However, other mouse support may be added easily.
If you want this, you should do the following:
1. #include the screenhandlers in your code.
2. add in sub Sub Process_GS_Message a case %wm_mousemove as shown below,
and insert code to process the mouse coordinates.
Alternatively you may use the same method as used for handling the mouse clicks.
3. instead of calling the PBCC Graphic Window, call the Function GraphicWindow
as indicated.
This will give you continuous updates of the mouse position.
Arie Verheul
Code:Sub Process_GS_Message( ByVal hWnd As Dword, ByVal wMsg As Dword,_ ByVal wParam As Dword, ByVal lParam As Long) Graphic Attach hWnd,0 Select Case wMsg Case %wm_destroy : WindowClosed = -1 ' To be properly processed ' after window has been closed Case %wm_mousemove ' Insert here the code to process mouse coordinates <<<<<<<<< ' Mouse coordinates are : ' X = Lo (Word,lparam) ' Y = Hi (Word,lparam) Case %wm_lbuttondown If LMouse_HA Then Call Dword LMouse_HA BDecl (lparam) Case %wm_rbuttondown If RMouse_HA Then Call Dword RMouse_HA BDecl (lparam) Case %wm_char If Char_HA Then Call Dword Char_HA BDecl (wparam) Case %wm_keydown If Key_HA Then Call Dword Key_HA BDecl (wparam) End Select CallWindowProc(OldProc, hWnd, wMsg, wParam, lParam) End Sub
Comment
-
-
> LOOP UNTIL ink$= $ESC or ISFALSE IsWindow(hWin)
Always good to streamline your code !
What Thou Wouldst 'GET', 'OPEN or 'CREATE' Thou Shalt 'FREE', 'CLOSE' or 'DESTROY' When Thy Use for Same Hath Been Completed.
MCMMichael Mattias
Tal Systems (retired)
Port Washington WI USA
[email protected]
http://www.talsystems.com
Comment
-
-
Guy,
I case you are still looking for caret code. Here is your sample with a few extra lines which add a Subclass proc to handle the caret..
Code:#COMPILE EXE #BREAK ON ' commented out for PBWin901 #CONSOLE OFF ' #DEBUG ERROR ON DEFLNG a-z #INCLUDE "WIN32API.INC" FUNCTION PBMAIN () AS LONG DIM MousePoint AS POINTAPI LOCAL hWin AS LONG GRAPHIC WINDOW "Show Cursor Position and input any characters. Return for next line. Esc to end.",0,0,800,600 TO hwin '//------------------/ ' SubClass Graphic Window Local hStatic As Long hStatic = GetWindow(hWin, %GW_CHILD) ' handle of Static child of Gfx Window SetProp hWin, "OldStaticProc", SetWindowLong(hStatic, %GWL_WNDPROC, CodePtr(StaticProc)) SendMessage hStatic, %WM_User + 1000, 0, 0 ' Create caret in Subclass proc '//------------------/ GRAPHIC ATTACH hWin, 0, REDRAW FONT NEW "Lucida Console",12,0,0,0,0 TO F1 GRAPHIC SET FONT F1: GRAPHIC CHR SIZE TO W1,H1 ' Find pixel width and height of fnt1 graphic font x=0: y=H1 DO '//------------------/ SendMessage hStatic, %WM_User + 1001, 0, Mak(Long, x, y) ' Update caret pos '//------------------/ GRAPHIC INKEY$ TO ink$: SLEEP 1 GRAPHIC GET DC TO hwin: IF hwin=0 THEN EXIT DO GetCursorPos Mousepoint: ScreenToClient hWin,mousepoint GRAPHIC SET POS (0,0): GRAPHIC PRINT "X:";Mousepoint.x;" Y:";Mousepoint.y;" ": GRAPHIC REDRAW IF ink$="" THEN ITERATE '------------------------------------------------ Trying to get a caret -------------------- ' DestroyCaret ' CaretWidth=12: CaretHeight=9 ' CreateCaret(hwin,%null,caretWidth,CaretHeight) ' SetCaretPos(x,y): ShowCaret (hwin) '-------------------------------------------------------------------------------------------- IF ink$=CHR$(13) THEN IF y<500 THEN y=y+h1: x=0: ink$="": ITERATE ELSE BEEP ' Return for next line END IF '--------------------------------------------------------------------------------------------- GRAPHIC SET POS (x,y): GRAPHIC PRINT ink$ IF x<800 THEN x=x+w1 ELSE BEEP GRAPHIC REDRAW LOOP UNTIL ink$=CHR$(27) '//------------------/ ' Cleanup SetWindowLong(hStatic, %GWL_WNDPROC, GetProp(hgWin, "OldStaticProc")) RemoveProp hWin, "OldStaticProc" '//------------------/ GRAPHIC WINDOW END END FUNCTION '//------------------/ Function StaticProc(ByVal hWnd As Dword, ByVal wMsg As Dword, _ ByVal wParam As Dword, ByVal lParam As Long) As Long Select Case As Long wMsg Case %WM_User + 1000 ' Startup CreateCaret hWnd, 0, 2, 16 ' solid caret 2x16 pixels Case %WM_User + 1001 ' Update caret pos x = Lo(Word, lParam) : y = Hi(Word, lParam) SetCaretPos x, y ShowCaret hWnd Case %WM_Destroy DestroyCaret End Select Function = CallWindowProc(GetProp (GetParent(hWnd), "OldStaticProc"), hWnd, wMsg, wParam, lParam) End Function '//------------------/SubClass proc
Rgds, Dave
Comment
-
-
This test code may be a little closer to what the OP was looking for..
Code:#Compile Exe #Dim All #Register None #Include "WIN32API.INC" '#CONSOLE OFF '------------------/ Function PBMain () As Long Local hGWin???, hFont???, hStatic???, x!, y!, ncW!, ncH!, sI$ Font New "Courier", 12, 1 To hFont ' NB. Fixed-width font ' Create and show a Graphic window Graphic Window "Graphic Window", 300, 300, 400, 300 To hGWin hStatic = GetWindow(hGWin, %GW_CHILD) ' handle of Static child of Gfx Window ' SubClass Static to attach cursor etc SetProp hGWin, "OldStaticProc", SetWindowLong(hStatic, %GWL_WNDPROC, CodePtr(StaticProc)) SendMessage hStatic, %WM_User + 1000, 0, 0 ' Create caret Graphic Attach hGWin, 0 Graphic Set Font hFont ' Font select. Graphic Chr Size To ncW!, ncH! ' Get char size for this font. Graphic Box (10, 10) - (390, 290), 0, %Blue ' Draw box - has 'char grid' of 17 x 37 Graphic Set Pos (20,2) ' with the Courier 12 point font. Graphic Print "Graphic Note Pad" Graphic Set Pos (2*ncW, 2*ncH) Graphic Get Pos To x, y SendMessage hStatic, %WM_User + 1001, Mak(Long, ncW, ncH), Mak(Long, x, y) ' Update caret pos SetCaretPos 2*ncW,2*ncH ' pass char size and x, y ' InKey$ Loop Do Graphic InKey$ To sI ' Get keyboard input If Len(sI)=1 Then If sI = $Cr Then ' New Line.. unless at bottom of typing range (this e.g. = 270) Graphic Print "" : Graphic Get Pos To x,y : Graphic Set Pos (2*ncW, Min(y, 270)) SendMessage hStatic, %WM_User + 1001, 0, Mak(Long, 2*ncW, Min(y, 270)) End If If sI = $Bs Then ' Backspace (easier when using fixed width font!) Graphic Get Pos To x,y If x <= 2*ncW Then sI = "" : Iterate Loop Graphic Set Pos (x-ncW,y) : Graphic Print Space$(1) Graphic Set Pos (x-ncW,y) : SendMessage hStatic, %WM_User + 1001, 0, Mak(Long, x-ncW, y) sI = "" : Iterate Loop End If Graphic Get Pos To x,y If x => 370 Then Graphic Print sI : Graphic Get Pos To x,y : Graphic Set Pos (2*ncW, Min(y, 270)) Else Graphic Print sI; End If Graphic Get Pos To x,y : SendMessage hStatic, %WM_User + 1001, 0, Mak(Long, x, y) Dialog DoEvents End If If Len(sI) = 2 Then ' Extended key pressed (not number pad) Graphic Get Pos To x, y Select Case Asc(Right$(sI,1)) Case 72 : y = Max(y - ncH, 2*ncH) : Graphic Set Pos (x,y) ' Up Arrow SendMessage hStatic, %WM_User + 1001, 0, Mak(Long, x, y) Case 75 : x = Max(x - ncW, 2*ncW) : Graphic Set Pos (x,y) ' Left Arrow SendMessage hStatic, %WM_User + 1001, 0, Mak(Long, x, y) Case 77 : x = Min(x + ncW, 37*ncW) : Graphic Set Pos (x,y) ' Right Arrow SendMessage hStatic, %WM_User + 1001, 0, Mak(Long, x, y) Case 80 : y = Min(y + ncH, 17*ncH) : Graphic Set Pos (x,y) ' Down Arrow SendMessage hStatic, %WM_User + 1001, 0, Mak(Long, x, y) End Select End If Dialog DoEvents ' Avoid hogging the CPU Loop While IsWindow(hGWin) ' Cleanup SetWindowLong(hStatic, %GWL_WNDPROC, GetProp(hGWin, "OldStaticProc")) RemoveProp hGWin, "OldStaticProc" SetWindowLong(hGWin, %GWL_WNDPROC, GetProp(hGWin, "OldGWProc")) RemoveProp hGWin, "OldGWroc" Graphic Window END End Function '------------------/PBMain Function StaticProc(ByVal hWnd As Dword, ByVal wMsg As Dword, _ ByVal wParam As Dword, ByVal lParam As Long) As Long Local x! ,y! Static ncw!, ncH! Select Case As Long wMsg Case %WM_User + 1000 ' Startup - initialize caret CreateCaret hWnd, 0, 2, 16 ' solid caret 2x16 pixels Case %WM_User + 1001 ' User message to update caret pos If wParam Then ncW = Lo(Word, wParam) : ncH = Hi(Word, wParam) x = Lo(Word, lParam) : y = Hi(Word, lParam) SetCaretPos x, y ShowCaret hWnd Case %WM_KillFocus DestroyCaret ' Don't show caret if focus elsewhere Case %WM_SetFocus CreateCaret hWnd, 0, 2, 16 ' solid caret 2x16 pixels ShowCaret hWnd ' we're back! - show caret Case %WM_MouseMove If GetFocus = hWnd Then ' don't update cursor pos if focus elsewhere x = Lo(Word, lParam) : y = Hi(Word, lParam) SetWindowText GetParent(hWnd), "x" + Str$(x) + ", y" + Str$(y) End If Case %WM_LButtonUp x = Lo(Word, lParam) : y = Hi(Word, lParam) SetWindowText GetParent(hWnd), "LBtnUp at: " + "x" + Str$(x) + ", y" + Str$(y) x = (x\ncW)*ncW : y = (y\ncH)*ncH : SetCaretPos x, y ' new pos adjusted to char/line spacing Graphic Attach GetParent(hWnd), 0 : Graphic Set Pos (x, y) End Select Function = CallWindowProc(GetProp (GetParent(hWnd), "OldStaticProc"), hWnd, wMsg, wParam, lParam) End Function '------------------/StaticProc
Rgds, Dave
Comment
-
Comment