Re-sizable Rectangle

[kevin]

  Re-sizable Rectangle

  This example sets up a zone that the user can interact with.  The logic allows the zone to be dragged/sized from any edge or the corners.  

PlayBASIC Code: [Select]

   Type tRect
         x1,y1,x2,y2
   EndType   
   
   Type tScreen
         Viewport as tRect
   EndType


   Dim Screen as tScreen
   
   Screen.Viewport.x1=0
   Screen.Viewport.y1=0
   Screen.Viewport.x2=GetScreenWidth()-1
   Screen.Viewport.y2=GetScreenHeight()-1

   
   Setfps 61.7
   
   Do
      Cls $445566   

      DrawRect(Screen.Viewport,$ff00000)

      Mb=MouseButton()
      Mx=MouseX()
      My=Mousey()
      

         if MB<>1
               SelectedEdge=-1
         endif

         ; Looking for an edge selection   
         if MB=1
               if SelectedEdge=-1
                  ThisEdge=DetectClickedRectEdge(Screen.Viewport,mx,my)                  
                  if ThisEdge>0
                     SelectedEdge=ThisEdge
                  endif

               else
                  DragEdge(Screen.Viewport,SelectedEdge,Mx,my)
               endif               
         endif




      Sync   
   loop








Psub DrawRect(Rect as tRect pointer,COlour)
   linec Rect.x1,Rect.y1,Rect.x2,Rect.y1,COlour
   linec Rect.x1,Rect.y2,Rect.x2,Rect.y2,COlour
   linec Rect.x1,Rect.y1,Rect.x1,Rect.y2,COlour
   linec Rect.x2,Rect.y1,Rect.x2,Rect.y2,COlour
endPsub


psub DetectClickedRectEdge(Rect as tRect pointer, Mx,My)

   Edge=0
   Radius=4   
   if LineIntersectCircle(Rect.x1,Rect.y1,Rect.x2,Rect.y1,mx,my,radius,0)
      Edge=1
   endif
   
   if LineIntersectCircle(Rect.x1,Rect.y2,Rect.x2,Rect.y2,mx,my,radius,0)
      Edge=2
   endif

   if LineIntersectCircle(Rect.x1,Rect.y1,Rect.x1,Rect.y2,mx,my,radius,0)
      Edge+=4
   endif

   if LineIntersectCircle(Rect.x2,Rect.y1,Rect.x2,Rect.y2,mx,my,radius,0)
      Edge+=8
   endif

EndPsub Edge




psub DragEdge(Rect as tRect pointer,Edge, Mx,My)

   Mx=ClipRange(mx,0,GetScreenWidth())
   My=ClipRange(my,0,GetScreenHeight())

   if Edge & 1
      Rect.y1=My   
   endif

   if Edge & 2
      Rect.y2=My   
   endif

   if Edge & 4
      Rect.X1=Mx   
   endif

   if Edge & 8
      Rect.X2=Mx   
   endif

EndPsub Edge

 Related Examples:

    * Drag Rectangles/ GUI Selection
    * Drag Sprites