It is currently Thu Jul 18, 2019 2:29 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 15 posts ] 
Author Message
 Post subject: Too flashy
PostPosted: Wed May 15, 2019 9:28 pm 
Offline
User
User

Joined: Thu Aug 30, 2018 11:34 am
Posts: 16
Hi

I'm visually impaired and struggle to locate the mouse pointer on my multiple monitors.

The following code highlights the location of the mouse pointer but screen update too flashy for comfortable use.

Advice on how to modify this code to smooth the display greatly appreciated.

NB: Code below edited since original posting. A mistyped 'mouse' was responsible for flashy display.

Code:

Global DTqty, MouseDesktop, LastMouseDesktop
Global DTxwd, DTyht, DTxog, DTyog, DTmxa, DTmyd
Global DTMouseX, DTMouseY
Global DPgap=40
Global ExitKey=#VK_F12, ExitKeyPressed=0

; Delay(2000)
; Beep_(1000, 500)

DTqty=ExamineDesktops()-1

Procedure MseDT()
    DTMouseX=DesktopMouseX()
    DTMouseY=DesktopMouseY()
    For DTi = 0 To DTqty
      If DTMouseX>=DesktopX(DTi) And DTMouseX<=DesktopX(DTi)+DesktopWidth(DTi) And DTMouseY>=DesktopY(DTi) And DTMouseY<=DesktopY(DTi)+DesktopHeight(DTi)
        MouseDesktop=DTi
        DTxwd=DesktopWidth(MouseDesktop)
        DTyht=DesktopHeight(MouseDesktop)
        DTxog=DesktopX(MouseDesktop)
        DTyog=DesktopY(MouseDesktop)
        ProcedureReturn
      EndIf
    Next DTi
EndProcedure

Procedure WIinit()
    LastMouseDesktop=MouseDesktop
    CreateImage(0,DTxwd,DTyht,#PB_Image_DisplayFormat)
    OpenWindow(0,DTxog,DTyog,DTxwd,DTyht,"",#PB_Window_BorderLess|#PB_Window_Invisible|#PB_Window_NoActivate)
    ImageGadget(0,0,0,DTxwd,DTyht,ImageID(0))
    StickyWindow(0,#True)
    SmartWindowRefresh(0,#True)
    HideWindow(0,#False)
    SetWindowLong_(WindowID(0),#GWL_EXSTYLE,GetWindowLong_(WindowID(0),#GWL_EXSTYLE)|#WS_EX_LAYERED|#WS_EX_NOACTIVATE)
    SetLayeredWindowAttributes_(WindowID(0),0,0,#LWA_COLORKEY)
EndProcedure
 
Procedure DrwLne(lcolor)
    DC=StartDrawing(ImageOutput(0))
   
    Brush.LOGBRUSH
    Brush\lbstyle=#BS_SOLID
    Brush\lbcolor=lcolor
    Brush\lbhatch=0
 
    newpen=ExtCreatePen_(#PS_GEOMETRIC|#PS_SOLID|#PS_ENDCAP_FLAT|#PS_JOIN_MITER,4,@Brush,0,0)
    oldpen=SelectObject_(DC,newpen)
 
    MoveToEx_(DC,0,0,0)
;   From top left to mouse
    LineTo_(DC,DTmxa-DPgap,DTmyd-DPgap)
       
    MoveToEx_(DC,DTxwd,0,0)
;   From top right to mouse
    LineTo_(DC,DTmxa+DPgap,DTmyd-DPgap)
       
    MoveToEx_(DC,0,DTyht,0)
;   From bottom left to mouse
    LineTo_(DC,DTmxa-DPgap,DTmyd+DPgap)
   
    MoveToEx_(DC,DTxwd,DTyht,0)
;   From bottom right to mouse
    LineTo_(DC,DTmxa+DPgap,DTmyd+DPgap)
   
    LineTo_(DC,DTmxa-DPgap,DTmyd+DPgap)
    LineTo_(DC,DTmxa-DPgap,DTmyd-DPgap)
    LineTo_(DC,DTmxa+DPgap,DTmyd-DPgap)
    LineTo_(DC,DTmxa+DPgap,DTmyd+DPgap)   
 
    SelectObject_(DC,oldpen)
    DeleteObject_(newpen)
    StopDrawing()
 
    ImageGadget(0,0,0,DTxwd,DTyht,ImageID(0))
    StickyWindow(0,#True)
    SmartWindowRefresh(0,#True)
    HideWindow(0,#False)
EndProcedure
     
MseDT()
WIinit()
 
; Delay(1000)
; Beep_(2000, 500)

Repeat
 
  DTMouseX=DesktopMouseX()
  DTMouseY=DesktopMouseY()
 
  DTmxa=DTMouseX-DTxog
  DTmyd=DTMouseY-DTyog

  DrwLne($00FF00)
 
  StillMouse=0
  StartTime=ElapsedMilliseconds()
  While DTMouseX=DesktopMouseX() And DTMouseY=DesktopMouseY()
    WaitWindowEvent(25)
    Delay(25)
    If StillMouse=0 And ElapsedMilliseconds()-StartTime>2000
      StillMouse=1
      DrwLne($000000) 
    EndIf
    ExitKeyPressed=GetAsyncKeyState_(ExitKey) & 32768
  Wend
 
  MseDT()
 
  If LastMouseDesktop=MouseDesktop
    DrwLne($000000) 
  Else
    FreeImage(0)
    CloseWindow(0)
    WIinit()
  EndIf
 
Until ExitKeyPressed<>0

Beep_(3000, 500)
End



Last edited by BlindMan on Thu May 16, 2019 11:15 am, edited 1 time in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: Too flashy
PostPosted: Thu May 16, 2019 10:18 am 
Offline
User
User

Joined: Thu Aug 30, 2018 11:34 am
Posts: 16
Variable viewer tool found problem. Mistype of 'mouse' fixed.


Top
 Profile  
Reply with quote  
 Post subject: Re: Too flashy
PostPosted: Thu May 16, 2019 11:09 am 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sat May 05, 2007 5:31 pm
Posts: 570
Location: Linz, Austria
Do you really need the connecting lines?
Code:
sizeW = 150
sizeH = 150
borderW = 5
borderH = 5

OpenWindow(0, 0, 0, sizeW, sizeH, "", #PB_Window_BorderLess)
SetWindowColor(0, #Green)

Orgn = CreateRectRgn_(0, 0, sizeW, sizeH)
Irgn = CreateRectRgn_(borderW, borderH, sizeW-borderW, sizeH-borderH)
CombineRgn_(Orgn, Orgn, Irgn, #RGN_DIFF)
SetWindowRgn_(WindowID(0), Orgn, 1)
DeleteObject_(Irgn)

Repeat 
  event = WaitWindowEvent(16)   
  SetWindowPos_(WindowID(0), #HWND_TOPMOST, DesktopMouseX()-(sizeW/2), DesktopMouseY()-(sizeH/2), 0, 0, #SWP_NOSIZE|#SWP_NOACTIVATE)
Until event = #PB_Event_CloseWindow Or GetAsyncKeyState_(#VK_ESCAPE) & 1


Top
 Profile  
Reply with quote  
 Post subject: Re: Too flashy
PostPosted: Thu May 16, 2019 11:58 am 
Offline
User
User

Joined: Thu Aug 30, 2018 11:34 am
Posts: 16
Thank you Chi. That's a neat alternative solution.

I do find the extra lines helpful though as I can only see a small portion of the screen.


Top
 Profile  
Reply with quote  
 Post subject: Re: Too flashy
PostPosted: Thu May 16, 2019 3:19 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sun Jun 11, 2006 12:07 am
Posts: 488
Location: Germany / one of the fishheads
Interesting, chi, if you compile the code with DPI aware option (PB 5.7x), the position of the rectangle will be calculated wrong the further you move the mouse to the right or downwards.

_________________
PB 5.62, OS: Windows 7 Pro x64, Desktopscaling: 125%, CPU: I7 6500, RAM: 16 GB, GPU: Intel Graphics HD 520, User age: 51y
"Happiness is a pet." | "Never run a changing system!"


Top
 Profile  
Reply with quote  
 Post subject: Re: Too flashy
PostPosted: Thu May 16, 2019 4:41 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sat Jun 24, 2006 3:29 am
Posts: 186
BlindMan wrote:
Variable viewer tool found problem. Mistype of 'mouse' fixed.


You can use EnableExplicit to help with this kind of problem.

_________________
Proud supporter of PB! * Musician * C64/6502 Freak


Top
 Profile  
Reply with quote  
 Post subject: Re: Too flashy
PostPosted: Thu May 16, 2019 8:22 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sat May 05, 2007 5:31 pm
Posts: 570
Location: Linz, Austria
kurzer wrote:
Interesting, chi, if you compile the code with DPI aware option (PB 5.7x), the position of the rectangle will be calculated wrong the further you move the mouse to the right or downwards.
DesktopMouse?() is returning wrong coordinates when DPI aware is checked. Guess it's a bug :shock:

Workaround:
Code:
sizeW = DesktopScaledX(150)
sizeH = DesktopScaledY(150)
borderW = DesktopScaledX(5)
borderH = DesktopScaledY(5)

OpenWindow(0, 0, 0, sizeW, sizeH, "", #PB_Window_BorderLess)
SetWindowColor(0, #Green)

Orgn = CreateRectRgn_(0, 0, sizeW, sizeH)
Irgn = CreateRectRgn_(borderW, borderH, sizeW-borderW, sizeH-borderH)
CombineRgn_(Orgn, Orgn, Irgn, #RGN_DIFF)
SetWindowRgn_(WindowID(0), Orgn, 1)
DeleteObject_(Irgn)

Repeat
  event = WaitWindowEvent(16)
  GetCursorPos_(cp.POINT)
  SetWindowPos_(WindowID(0), #HWND_TOPMOST, cp\x-(sizeW/2), cp\y-(sizeH/2), 0, 0, #SWP_NOSIZE|#SWP_NOACTIVATE)
  ;SetWindowPos_(WindowID(0), #HWND_TOPMOST, DesktopMouseX()-(sizeW/2), DesktopMouseY()-(sizeH/2), 0, 0, #SWP_NOSIZE|#SWP_NOACTIVATE)
  Debug cp\x
  Debug DesktopMouseX()
  Debug ""
Until event = #PB_Event_CloseWindow Or GetAsyncKeyState_(#VK_ESCAPE) & 1


Top
 Profile  
Reply with quote  
 Post subject: Re: Too flashy
PostPosted: Fri May 17, 2019 10:41 am 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sat May 05, 2007 5:31 pm
Posts: 570
Location: Linz, Austria
@BlindMan: Following snippet works without (obvious) flickering and is less CPU hungry... Maybe you wanna adapt one or two things in your code ;)
Code:
Global w = GetSystemMetrics_(0)
Global h = GetSystemMetrics_(1)
Global boxW = 50
Global boxH = 50

Procedure Draw(x, y, color)
  DrawingMode(#PB_2DDrawing_Outlined)
  Box(x-(boxW/2), y-(boxH/2), boxW, boxH, color)
  LineXY(0, 0, x-(boxW/2), y-(boxH/2), color)
  LineXY(w, 0, x+(boxW/2), y-(boxH/2), color)
  LineXY(0, h, x-(boxW/2), y+(boxH/2), color)
  LineXY(w, h, x+(boxW/2), y+(boxH/2), color)
EndProcedure

CreateImage(0, w, h)

OpenWindow(0, 0, 0, w, h, "", #PB_Window_BorderLess|#PB_Window_ScreenCentered|#PB_Window_Invisible)
ImageGadget(0, 0, 0, w, h, 0)

SetWindowLongPtr_(WindowID(0), #GWL_EXSTYLE, GetWindowLongPtr_(WindowID(0), #GWL_EXSTYLE)|#WS_EX_LAYERED)
SetLayeredWindowAttributes_(WindowID(0), 0, 0, #LWA_COLORKEY)

HideWindow(0, #False)

Repeat
  event = WindowEvent()
 
  StartDrawing(ImageOutput(0))
    Draw(oldX, oldY, #Black)
    GetCursorPos_(cp.POINT)
    Draw(cp\x, cp\y, #Green)
    oldX = cp\x
    oldY = cp\y
  StopDrawing()
  SetGadgetState(0, ImageID(0))
 
  SetWindowPos_(WindowID(0), #HWND_TOPMOST, 0, 0, 0, 0, #SWP_NOSIZE|#SWP_NOMOVE|#SWP_NOACTIVATE|#SWP_NOREDRAW)
 
  Delay(25)
Until event = #PB_Event_CloseWindow Or GetAsyncKeyState_(#VK_ESCAPE) & 1

@kurzer: Thanks for the bug report 8)


Top
 Profile  
Reply with quote  
 Post subject: Re: Too flashy
PostPosted: Fri May 17, 2019 11:04 am 
Offline
User
User

Joined: Thu Aug 30, 2018 11:34 am
Posts: 16
Thank you again. Very much appreciated.

Seeing other ways of coding solution is very educational. I was aware my code was heavy on CPU but unsure how it could be improved.

I've also made small change to your original solution and find it works well for me.

Code:

ExitKey = #VK_F12

sizeW = 250
sizeH = 250
borderW = 16
borderH = 20

OpenWindow(0, 0, 0, sizeW, sizeH, "", #PB_Window_BorderLess)
SetWindowColor(0, #Red)

Orgn = CreateRectRgn_(0, 0, sizeW, sizeH)
Irgn = CreateRectRgn_(borderW, borderH, sizeW-borderW, sizeH-borderH)
CombineRgn_(Orgn, Orgn, Irgn, #RGN_DIFF)
SetWindowRgn_(WindowID(0), Orgn, 1)
DeleteObject_(Irgn)

Repeat 
  StillMouse=0
  StartTime=ElapsedMilliseconds()
  While DTMouseX=DesktopMouseX() And DTMouseY=DesktopMouseY()
    If StillMouse=0 And ElapsedMilliseconds()-StartTime>2000
      StillMouse=1
      HideWindow(0,#True)
    EndIf
    WaitWindowEvent(16)
  Wend
 
  DTMouseX=DesktopMouseX()
  DTMouseY=DesktopMouseY()
  HideWindow(0,#False)
  SetWindowPos_(WindowID(0), #HWND_TOPMOST, DesktopMouseX()-(sizeW/2), DesktopMouseY()-(sizeH/2), 0, 0, #SWP_NOSIZE|#SWP_NOACTIVATE)
  WaitWindowEvent(16)   
  ExitKeyPressed=GetAsyncKeyState_(ExitKey) & 32768 
Until ExitKeyPressed<>0

Beep_(3000, 500)
End



Top
 Profile  
Reply with quote  
 Post subject: Re: Too flashy
PostPosted: Fri May 17, 2019 11:35 am 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sat May 05, 2007 5:31 pm
Posts: 570
Location: Linz, Austria
np, happy to help ;)


Top
 Profile  
Reply with quote  
 Post subject: Re: Too flashy
PostPosted: Fri May 17, 2019 1:41 pm 
Offline
User
User

Joined: Thu Aug 30, 2018 11:34 am
Posts: 16
I would like to do the same with the caret but having issues with obtaining caret position.

Is there a better way to get caret position than in my code below?

Code:

Define StringCaretPos.Point

OpenWindow(0, 0, 0, 200, 160, "GetCaretPos", #PB_Window_SystemMenu)

EditorGadget(0, 0, 0, 200, 50, #PB_Editor_WordWrap)
SetGadgetText(0, "abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz")

TextGadget(1, 20,  80, 160, 25, "")
TextGadget(2, 20, 110, 160, 25, "")

Repeat
 
  Event = WaitWindowEvent(100)
 
  Select Event
     
    Case #PB_Event_CloseWindow
 
      End
     
    Default
             
      ThisID = GetCurrentThreadId_()
      ForeID = GetWindowThreadProcessId_(GetForegroundWindow_(), 0)
     
      If ThisID <> ForeID
        AttachThreadInput_(ThisID, ForeID, #True)
      EndIf     
     
      GetCaretPos_(@StringCaretPos)
     
      If (StringCaretPos\x <> 0) Or (StringCaretPos\y <> 0)
        focusedHandle = GetFocus_()     
        ClientToScreen_(focusedHandle, @StringCaretPos)
      EndIf     
     
      If ThisID <> ForeID
        AttachThreadInput_(ThisID, ForeID, #False)
      EndIf
     
      SetGadgetText(1, "Caret X:" + Str(StringCaretPos\x) + ", Y:" + Str(StringCaretPos\y))
     
      iters = iters + 1
      SetGadgetText(2, "Iteration " + Str(iters))
     
  EndSelect
 
ForEver




Top
 Profile  
Reply with quote  
 Post subject: Re: Too flashy
PostPosted: Fri May 17, 2019 9:54 pm 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Apr 12, 2009 6:27 am
Posts: 3351
- Resize able
- LBUTTONDOWN to move
- Escape to end
Code:
#SC_DragMove      = $F012

CreateImage(0, 140,140,24,$FF0000)

Procedure WndProc(hwnd, uMsg, wParam, lParam)   
result = #PB_ProcessPureBasicEvents       
 Select uMsg
    Case #WM_NCCALCSIZE
      If OSVersion() >= #PB_OS_Windows_10
        *rc.RECT=lParam
        *rc\top - 7
      EndIf
       
    Case #WM_SIZE
      ResizeImage(0,WindowWidth(0)-10,WindowHeight(0)-10)
      ResizeGadget(0,5,5,WindowWidth(0)-10,WindowHeight(0)-10)
      SetGadgetState(0,ImageID(0))
       
    Case #WM_NCACTIVATE
        Result = 1
       
 EndSelect   
ProcedureReturn result
EndProcedure

OpenWindow(0, 0, 0,150,150 , "Window_0",#PB_Window_BorderLess| #PB_Window_ScreenCentered| #WS_SIZEBOX | #PB_Window_Invisible)
  SetWindowColor(0,$54FC2A)
   
  ImageGadget(0,5,5,WindowWidth(0)-10,WindowHeight(0)-10,ImageID(0))
 
  SetWindowLongPtr_(WindowID(0),#GWL_EXSTYLE, #WS_EX_LAYERED)
  SetLayeredWindowAttributes_(WindowID(0),$FF0000,0, #LWA_COLORKEY)     
  DisableGadget(0,1)

  SetWindowCallback(@WndProc())
  HideWindow(0,0)
     
Repeat
  Select WaitWindowEvent()
    Case #WM_LBUTTONDOWN
      SendMessage_(WindowID(0), #WM_SYSCOMMAND , #SC_DragMove,0)
       
  EndSelect     
Until GetAsyncKeyState_(#VK_ESCAPE) & $8000 = $8000
End

_________________
Egypt my love


Top
 Profile  
Reply with quote  
 Post subject: Re: Too flashy
PostPosted: Sat May 18, 2019 2:29 am 
Offline
Enthusiast
Enthusiast

Joined: Thu Apr 18, 2019 8:17 am
Posts: 193
RASHAD wrote:
Resize able

It needs error-checking for resizing: I resized it too small (vertically) and it crashes.


Top
 Profile  
Reply with quote  
 Post subject: Re: Too flashy
PostPosted: Thu May 23, 2019 2:34 pm 
Offline
User
User

Joined: Thu Aug 30, 2018 11:34 am
Posts: 16
Is there a way to make your app window display on top of the Windows Start menu?
StickyWindow() doesn't appear to work in this instance.


Top
 Profile  
Reply with quote  
 Post subject: Re: Too flashy
PostPosted: Thu May 23, 2019 6:39 pm 
Offline
Addict
Addict
User avatar

Joined: Thu Feb 09, 2006 11:27 pm
Posts: 2430
Please add the line...
Code:
WindowBounds(0,11,11,9999,9999)

...to Rashad's code, otherwise avoid shrinking the windows to zero size :wink:


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 15 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 15 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye