Shaped Window with mouse area problem

New to FreeBASIC? Post your questions here.
Forgotten Coder
Posts: 6
Joined: Jan 12, 2019 12:23

Shaped Window with mouse area problem

Postby Forgotten Coder » Jan 13, 2019 23:24

Hi everyone

There are many gui's like Windows, Linux flavors, etc. But what if we want to make a new one ? Where to start ? Well i started by trying to make a colored window with a bar on top. So far so good. But problems started when i tried to use the mouse ...

The problem is i can't fix the mouse position inside top area when i am pressing a button. If i move it "violently" up, down, left, right it will go off the limits of top bar ...:(

Here is my code. Any ideas ? Making experiments with this for hours. I am using Windows 7.

Code: Select all

#include "fbgfx.bi"
Using fb

Dim e As EVENT

Dim As Integer x, y, pressed, buttons, wx, wy
Dim As Any Ptr img

Screen 20, 32,, GFX_SHAPED_WINDOW

img=imagecreate(1024,768)

Line img, (0, 0)-(1024, 768), RGBA(96, 96, 96,255), BF
Line img, (0, 0)-(1024, 40), RGBA(64, 64, 64,200), BF

put (0,0), img

pressed = 0

Do
   
    screenLock()
    if (ScreenEvent(@e)) then
       
      if e.type = EVENT_MOUSE_BUTTON_PRESS then
        pressed=1
      end if 
     
      if e.type = EVENT_MOUSE_BUTTON_RELEASE then
        pressed = 0
      end if
     
      'check if mouse is in top area
      if pressed=1 then
        if (e.x>=0 and e.x<=1024 and e.y>=0 and e.y<=40) then
          'move window 
          ScreenControl GET_WINDOW_POS, wx, wy
          ScreenControl SET_WINDOW_POS, wx + e.dx, wy + e.dy
        end if
      end if   
     
   end if
   
   screenunLock()   
   
   'Sleep 1
   
Loop While Not MultiKey(1)


badidea
Posts: 1286
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Shaped Window with mouse area problem

Postby badidea » Jan 13, 2019 23:43

May I suggest the name: YaGUI = Yet another Graphical User Interface.
Making a good GUI with all the features is a lot of work.

I cannot move the window at all here (on linux).
oyster
Posts: 179
Joined: Oct 11, 2005 10:46

Re: Shaped Window with mouse area problem

Postby oyster » Jan 14, 2019 1:35

it seems that fltk supports shaped window
leopardpm
Posts: 1791
Joined: Feb 28, 2009 20:58

Re: Shaped Window with mouse area problem

Postby leopardpm » Jan 14, 2019 2:24

hmmm... i see the problem, but don't know the fix.

I modified your code so that you don't loose the window when you move mouse violently.... but it still doesn't track the mouse fast enough for some reason... this will work for you though:

Code: Select all

#include "fbgfx.bi"
Using fb

Dim e As EVENT

Dim As Integer x, y, pressed, buttons, wx, wy
Dim As Any Ptr img

Screen 20, 32,, GFX_SHAPED_WINDOW

img=imagecreate(1024,768)

Line img, (0, 0)-(1024, 768), RGBA(96, 96, 96,255), BF
Line img, (0, 0)-(1024, 40), RGBA(64, 64, 64,200), BF

put (0,0), img

pressed = 0
dim as integer windowgrab = 0
Do
   
   
    if (ScreenEvent(@e)) then
       
      if e.type = EVENT_MOUSE_BUTTON_PRESS then
        pressed=1
        if (e.x>=0 and e.x<=1024 and e.y>=0 and e.y<=40) then
            windowgrab = 1
        end if
      end if 
     
      if e.type = EVENT_MOUSE_BUTTON_RELEASE then
        pressed = 0
        windowgrab = 0
      end if
     
      'check if mouse is in top area
      if windowgrab=1 then
          'move window
          screenLock()
          ScreenControl GET_WINDOW_POS, wx, wy
          ScreenControl SET_WINDOW_POS, wx + e.dx, wy + e.dy
          screenunLock()
      end if   
     
   end if
   
     
   
   'Sleep 1
   
Loop While Not MultiKey(1)

Forgotten Coder
Posts: 6
Joined: Jan 12, 2019 12:23

Re: Shaped Window with mouse area problem

Postby Forgotten Coder » Jan 30, 2019 0:08

Hi everyone

Still trying to move shapedwindow with mouse to work just like windows. Well made some advances. This is my best mojo so far.
Left and right movement with mouse in top area is working fine(i think). Problems start when you move window up and down. But if you move window at low speed everything looks to be fine. At high speed mouse tends to block movement. I think mouse is not staying in the same place even with setmouse activated. setmouse bug/lag ? Any ideas ?

I am using windows 7 64bit /freebasic 32bit.

Code: Select all

 
#include "fbgfx.bi"
Using fb

dim e As EVENT

dim as integer mxpressed, mypressed, mx, my, mxold, myold, buttons
dim As integer newwx, newwy, deltax, deltay, oldwx, oldwy
dim As Any Ptr img
dim as ubyte dragging

Screen 20, 32,, (GFX_SHAPED_WINDOW)

img=imagecreate(1024,768)

Line img, (0, 0)-(1024, 768), RGBA(96, 96, 96,255), BF
Line img, (0, 0)-(1024, 40), RGBA(64, 64, 64,200), BF

put (0,0), img

dragging=0

Do
 
  if (ScreenEvent(@e)) then   
    Select Case e.type
      Case EVENT_MOUSE_BUTTON_PRESS
        If (e.button = BUTTON_LEFT) Then
          getmouse(mxpressed,mypressed,,buttons)
          if (mxpressed>=0 and mxpressed<=1023 and mypressed>=0 and mypressed<=40) then
            dragging = 1

            mxold=mxpressed
            myold=mypressed
           
          end if 
        end if   
   
      Case EVENT_MOUSE_BUTTON_RELEASE
        If (e.button = BUTTON_LEFT) Then
          dragging = 0
        end if   

      Case EVENT_MOUSE_MOVE
        if (dragging=1) then
          getmouse(mx,my, ,buttons)

          if (mx>=0 and mx<=1023 and my>=0 and my<=40) then
             
            ScreenControl GET_WINDOW_POS, oldwx, oldwy
                       

            deltax= mx - mxold
            deltay= my - myold
           
            newwx = oldwx + deltax
            newwy = oldwy + deltay
           
            ScreenControl SET_WINDOW_POS, newwx, newwy
           
          else
              setmouse(mxold,myold)                   
              sleep 10
          end if
         
           
        end if 'dragging   
      Case EVENT_MOUSE_ENTER
      Case EVENT_MOUSE_EXIT
         
    end select

  end if 
   
     
   
Loop While Not MultiKey(1)







 
dodicat
Posts: 5693
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Shaped Window with mouse area problem

Postby dodicat » Jan 30, 2019 0:31

Looks good Forgotten Coder.
I had a bash myself, but got confused along the way and now I move the mouse by the window.

Code: Select all

 
type point
    as integer x,y
end type

Sub drawpolygon(p() As Point,Byref col As Ulong,Byref c As Point=type(0,0))
    Dim k As Long=Ubound(p)+1
    Dim As Long index,nextindex
    Dim As Long cx,cy
    For n As Long=1 To Ubound(p)
        cx+=p(n).x:cy+=p(n).y
        index=n Mod k:nextindex=(n+1) Mod k
        If nextindex=0 Then nextindex=1
        Line (p(index).x,p(index).y)-(p(nextindex).x,p(nextindex).y),col
    Next
    cx/=Ubound(p):cy/=Ubound(p)
    c=type(cx,cy)
    Paint (cx,cy),col,col
End Sub

sub circulate(p() as point,byref c as point)
 
For p1 as long  = lbound(p) To ubound(p)-1
    For p2 as long  = p1 + 1 To ubound(p)
        if atan2(p(p1).y-c.y,p(p1).x-c.x)< atan2(p(p2).y-c.y,p(p2).x-c.x) then
            swap p(p1),p(p2)
            end if
         Next p2
    Next p1
end sub

Sub _line(x1 As Integer,y1 As Integer,x2 As Integer,y2 As Integer,l As Integer,col As Uinteger,Byref xp As Integer=0,Byref yp As Integer=0)
    Dim As Integer diffx=x2-x1,diffy=y2-y1,ln=Sqr(diffx*diffx+diffy*diffy)
    If ln=0 Then ln=1e-6
    Dim As Single nx=diffx/ln,ny=diffy/ln
    xp=x1+l*nx:yp=y1+l*ny
End Sub

Sub Nmouse(mx As Integer,my As Integer,sz As Integer,col As Ulong,p() as point)
   #macro set(x1,y1)
    redim preserve p(1 to ubound(p)+1)
    p(ubound(p))=type((x1),(y1))
    #endmacro
    Dim As Integer xp,yp
    _line(mx,my,mx+sz,my+.8*sz,sz,col,xp,yp)
     set(mx,my):set(xp,yp)
    _line(xp,yp,mx+sz/2,yp+.03*sz,.4*sz,col,xp,yp)
    set(xp,yp)
    Var tx=xp,ty=yp
    _line(mx,my,mx,my+1.2*sz,sz,col,xp,yp)
    set(xp,yp)
    _line(xp,yp,mx+sz/2,yp-sz/2,.4*sz,col,xp,yp)
    set(xp,yp)
    _line(xp,yp,mx+sz/2,yp+sz/2,sz,col,xp,yp)
    set(xp,yp)
    _line(xp,yp,xp+sz/2,yp-.4*sz,.2*sz,col,xp,yp)
    set(xp,yp)
    _line(xp,yp,tx,ty,.95*sz,col,xp,yp)
   
End Sub

Sub MoveScreenByMouse(mx As Long=0,my As Long=0,mb As Long=0)
    getmouse mx,my,,mb
    Static As Long lastmx,lastmy,lastx,lasty
    If lastx=mx andalso lasty=my Then Exit Sub Else lastx=Mx:lasty=my
    Dim As integer x,y: Screencontrol 0, x, y
    If mb=1 Then Screencontrol 100, x-(lastmx-mx),y-(lastmy-my):Exit Sub
    lastmx=mx:lastmy=my
End Sub

screenres 800,700,32,,&h10

dim as point c
dim as integer w,__
color ,rgb(255,0,255)
do
    getmouse __,__,w
    redim as point p(0)
    screenlock
    cls
nmouse(300,150,300,rgb(0,200,0),p())
c=type((p(1).x+p(5).x+p(3).x)/3,(p(1).y+p(5).y+p(3).y)/3)
circulate(p(),c)

drawpolygon(p(),rgb(0,0,200),c)
movescreenbymouse
screenunlock
sleep 1,1
loop until len(inkey)
sleep
 
Forgotten Coder
Posts: 6
Joined: Jan 12, 2019 12:23

Re: Shaped Window with mouse area problem

Postby Forgotten Coder » Jan 30, 2019 0:48

Hi dodicat

Thanks for trying to help. Tested you program and ... if you point your mouse to the end of arrow and start dragging it up and down with "violence" you will separate mouse from form(arrow) when you are pressing left button.
We both need the secret of OS windows movement. You can move them slowly and hard and that the mouse stays on the same position. Just open notepad window and move it to see what i mean. :)
leopardpm
Posts: 1791
Joined: Feb 28, 2009 20:58

Re: Shaped Window with mouse area problem

Postby leopardpm » Jan 30, 2019 1:12

the lag does not make sense to me - where is it coming from? I can think of a crude work-around:

when the mouse button is pressed, make an image of the window including the mouse cursor and then hide the cursor and move that image around until button is released.... i dont like it, but it would work
3622
Posts: 13
Joined: Mar 14, 2015 23:53

Re: Shaped Window with mouse area problem

Postby 3622 » Jan 30, 2019 21:48

Hi Forgotten Coder,

I've modified your original code. It seems better now ( tested on Linux only but should be OK on Windows).

Not sure about the 'violent' mouse movement though.

Take it easy.

Code: Select all

 
#include "fbgfx.bi"
Using fb

dim e As EVENT

dim as integer mxpressed, mypressed, mx, my, mxold, myold, buttons
dim As integer newwx, newwy, deltax, deltay, oldwx, oldwy
dim As Any Ptr img
dim as ubyte dragging

Screen 20, 32,, (GFX_SHAPED_WINDOW)

img=imagecreate(1024,768)

Line img, (0, 0)-(1024, 768), RGBA(96, 96, 96,255), BF
Line img, (0, 0)-(1024, 40), RGBA(64, 64, 64,200), BF

put (0,0), img

dragging=0

Do
 
  if (ScreenEvent(@e)) then   
    Select Case e.type
      Case EVENT_MOUSE_BUTTON_PRESS
        If (e.button = BUTTON_LEFT) Then
          getmouse(mxpressed,mypressed,,buttons)
          if ( /'mxpressed>=0 and mxpressed<=1023 and '/mypressed>=0 and mypressed<=40) then
            dragging = 1
            setmouse ,,,1

            mxold=mxpressed
            myold=mypressed
           
          end if
        end if   
   
      Case EVENT_MOUSE_BUTTON_RELEASE
        'If (e.button = BUTTON_LEFT) Then
          dragging = 0
          setmouse ,,,0
        'end if   

      Case EVENT_MOUSE_MOVE
        if (dragging=1) then
          getmouse(mx,my, ,buttons)

          if ( /'mx>=0 and mx<=1023 and '/my>=0 /'and my<=40'/) then
             
            ScreenControl GET_WINDOW_POS, oldwx, oldwy
                       

            deltax= mx - mxold
            deltay= my - myold
           
            newwx = oldwx + deltax
            newwy = oldwy + deltay
           
            ScreenControl SET_WINDOW_POS, newwx, newwy
            sleep 10                                       ' added extra sleep
          else
              setmouse(mxold,myold,,1)                   
              sleep 10
          end if
         
           
        end if 'dragging   
      Case EVENT_MOUSE_ENTER
      Case EVENT_MOUSE_EXIT
         
    end select

  end if
   
 
   
Loop While Not MultiKey(1)







 

Return to “Beginners”

Who is online

Users browsing this forum: No registered users and 0 guests