FB II Compiler

PG PRO

Debugging

Memory

System

Mathematics

Resources

Disk I/O

Windows

Controls

Menus

Mouse

Keyboard

Text

Fonts

Drawing

Sound

Clipboard

Printing

Communication

ASM

Made with FB

DRAWING

Use DragGrayRgn


I did not write the following code, but I did tweak it a bit. It will show you how to create a DragRect by using the mouse in concert with the shiftkey. You can create up to ten rectangles (with their own grow boxes) and drag them around the window. Have fun.

tedd

DIM RECORD infor
  DIM gRect.8
DIM END RECORD.infor
DIM rect.infor(10) 'Up to ten rects
DIM noItems
DIM gLastMsH, gLastMsV
DIM shftKeyDown
END GLOBALS

LOCAL
  DIM msPt.4
  DIM sRect.8

CLEAR LOCAL FN DoMouse 'must clear local var
  msEvnt = MOUSE (0)
  IF EVENT% AND _shiftKey% THEN shftFlag=_true
  SELECT CASE shftFlag
    CASE _false
      FOR x= 1 TO noItems
        CALL GETMOUSE (msPt)
        myvert%= msPt.v%
        myhorz%= msPt.h%
        oldhorz%=msPt.h% 'save myvert &horz for undo
        oldvert%=msPt.v%
        LONG IF FN PTINRECT(msPt,rect.infor.gRect (x))
          PEN ,,, _patXor,0 'erase old rect
          CALL SETRECT(sRect,rect.infor.gRect.right%(x)-4,rect.infor.gRect.bottom%(x)-4,rect.infor.gRect.right%(x),rect.infor.gRect.bottom%(x) )

          LONG IF FN PTINRECT(msPt,sRect)
            WHILE FN STILLDOWN
              CALL GETMOUSE (msPt)
              CALL FRAMERECT (rect.infor.gRect (x))
              PEN ,,, _patXor,3 'gray pat

              rect.infor.gRect.bottom% (x) = msPt.v%
              rect.infor.gRect.right% (x) = msPt.h%
              DELAY 10
              CALL FRAMERECT (rect.infor.gRect (x))
              CALL ERASERECT (sRect)

            WEND
          XELSE
            WHILE FN STILLDOWN 'is mouse btn down?, then drag rect
              CALL GETMOUSE (msPt) 'update muse position
              CALL FRAMERECT (rect.infor.gRect (x))
              PEN ,,, _patXor,3
              CALL OFFSETRECT(rect.infor.gRect(x),msPt.h%-oldhorz%,msPt.v-oldvert%)
              DELAY 10
              CALL FRAMERECT (rect.infor.gRect (x))
              CALL ERASERECT (sRect) '?works?
              oldhorz%=msPt.h%
              oldvert%=msPt.v%

            WEND
          END IF
          yes=x
          PEN ,,, _patCopy, 0 'reset pen mode
          FOR n= 1 TO noItems 'refresh screen
            CALL FRAMERECT (rect.infor.gRect (n))
            CALL SETRECT(sRect,rect.infor.gRect.right%(n)-4,rect.infor.gRect.bottom%(n)-4,rect.infor.gRect.right%(n),rect.infor.gRect.bottom%(n) )

            CALL FRAMERECT (sRect)
          NEXT n
        END IF
      NEXT x
      LONG IF yes
        TEXT,,,_srcCopy
        LOCATE 1,1
        PRINT" "
        LOCATE 1,1
        PRINT yes
      XELSE
        BEEP
      END IF

    CASE ELSE
      CALL GETMOUSE (msPt)
      myvert%= msPt.v%
      myhorz%= msPt.h%
      PEN ,,, _patXor,3 'set pen mode
      rect.infor.gRect.left% (noItems) = myhorz%
      rect.infor.gRect.top% (noItems) = myvert%'from current mosue position
      WHILE FN STILLDOWN 'is mouse btn down?, then drag rect
        CALL GETMOUSE (msPt) 'update muse position
'erase last rect position

'calc new rect position
        rect.infor.gRect.bottom% (noItems) = msPt.v%
        rect.infor.gRect.right% (noItems) = msPt.h%
        CALL FRAMERECT (rect.infor.gRect (noItems))'show at new position
        DELAY 10
        CALL FRAMERECT (rect.infor.gRect (noItems))
      WEND
      PEN ,,, _patCopy, 0 'reset pen mode
      CALL FRAMERECT (rect.infor.gRect (noItems))
      CALL SETRECT(sRect,rect.infor.gRect.right%(noItems)-4,rect.infor.gRect.bottom%(noItems)-4,rect.infor.gRect.right%(noItems),rect.infor.gRect.bottom%(noItems) )

      CALL FRAMERECT (sRect)
      INC (noItems)
      IF noItems>10 THEN noItems=10
  END SELECT
END FN

noItems=1
WINDOW 1
PRINT "Use mouse click and shift key to create drag boxes"
ON MOUSE FN DoMouse

DO
  HANDLEEVENTS
UNTIL 0
END