RubberBand Selection PhotoShop style. No screen
Posted: Sun Jan 09, 2011 10:41 pm
				
				Hi forum! I'm a newbie. Hopefully you experienced guys can improve this rubberband selection tool. Thanks to member Thorium it's now flickerfree. The only difference is the single code line by the option gadgets. Thoriums advice removed the flicker. No need to use BitBlt any more (unvoluntarily). I dislike "screens" since they change the "feel" (resolution) of my monitor (and it even goes BOING when using full screens).
Here you go:
			Here you go:
Code: Select all
EnableExplicit
Define.l lMouse, FlagDrag, n
Structure udtMousePos
  lMoX.l
  lMoY.l
EndStructure
Define.udtMousePos udvMouseXY, udvOldMouseXY ,udvStartPosXY
;==============================================================
;   CONSTANTS 
;==============================================================
#LMouseButtonUp = 0
Enumeration
  #Main_Window
  #ImageOriginal
  #ImageCanvas
  #ImageGadgetBG
  #OptImageGadget
  #OptSetGadget
EndEnumeration
Procedure Draw_RubberBand()
  Define.l ctrX, ctrY, lSwitch, lModuloRest
  Shared udvMouseXY, udvStartPosXY
  CopyImage(#ImageOriginal,#ImageCanvas);Clearing the old rubberband.
  If StartDrawing(ImageOutput(#ImageCanvas))
    
    For ctrX = udvStartPosXY\lMoX To (udvMouseXY\lMoX - 3) Step 4;Line with dashes 4 pixels wide.
      lSwitch= 1 - lSwitch
;       If udvMouseXY\lMoX - udvStartPosXY\lMoX > 20
;         Debug ""
;       EndIf
       LineXY(ctrX, udvStartPosXY\lMoY, ctrX + 3, udvStartPosXY\lMoY,#White * lSwitch)
    Next ctrX;Row below taking care of rest (modulus) pixel 1 to 3 if any.
    If ctrX-4+3 < (udvMouseXY\lMoX);If last dravingstartpoint+3px was smaller than desired endpoint.
      lModuloRest = (udvMouseXY\lMoX) - (ctrX-4+3)
      LineXY(ctrX-4+3, udvStartPosXY\lMoY, udvMouseXY\lMoX , udvStartPosXY\lMoY,#White * (1-lSwitch))
    EndIf
  
    For ctrY = udvStartPosXY\lMoY To (udvMouseXY\lMoY-3) Step 4;Dashed line with 3 pixels
      lSwitch= 1 - lSwitch
      LineXY(udvStartPosXY\lMoX, ctrY, udvStartPosXY\lMoX, ctrY + 3, #White * lSwitch)
    Next ctrY;Row below taking care of rest (modulus) pixel 1 to 3 if any.
    If ctrY-4+3 < (udvMouseXY\lMoY);If last dravingstartpoint+3px was smaller than desired endpoint.
      lModuloRest = (udvMouseXY\lMoY) - (ctrY-4+3)
      LineXY(udvStartPosXY\lMoX, ctrY-4+3, udvStartPosXY\lMoX, udvMouseXY\lMoY,#White * (1-lSwitch))
    EndIf
  
    For ctrX = udvStartPosXY\lMoX To (udvMouseXY\lMoX - 3) Step 4;Dashed line with 3 pixels
      lSwitch= 1 - lSwitch
      LineXY(ctrX, udvMouseXY\lMoY, ctrX + 3, udvMouseXY\lMoY,#White * lSwitch)
    Next ctrX;Row below taking care of rest (modulus) pixel 1 to 3 if any.
    If ctrX-4+3 < (udvMouseXY\lMoX);If last dravingstartpoint+3px was smaller than desired endpoint.
      lModuloRest = (udvMouseXY\lMoX) - (ctrX-4+3)
      LineXY(ctrX-4+3, udvStartPosXY\lMoY, udvMouseXY\lMoX , udvStartPosXY\lMoY,#White * (1-lSwitch))
    EndIf
  
    For ctrY = udvStartPosXY\lMoY To (udvMouseXY\lMoY - 3) Step 4;Dashed line with 3 pixels
      lSwitch= 1 - lSwitch
      LineXY(udvMouseXY\lMoX, ctrY, udvMouseXY\lMoX, ctrY + 3, #White * lSwitch)
    Next ctrY;Row below taking care of rest (modulus) pixel 1 to 3 if any.
    If ctrY-4+3 < (udvMouseXY\lMoY);If last dravingstartpoint+3px was smaller than desired endpoint.
      lModuloRest = (udvMouseXY\lMoY) - (ctrY-4+3)
      LineXY(udvMouseXY\lMoX, ctrY-4+3, udvMouseXY\lMoX, udvMouseXY\lMoY,#White * (1-lSwitch))
    EndIf
    
  StopDrawing()
    
  Select #True
     Case GetGadgetState(#OptImageGadget)
       ImageGadget(#ImageGadgetBG,#PB_Any,#PB_Any,#PB_Any,#PB_Any,ImageID(#ImageCanvas))
       
     Case GetGadgetState(#OptSetGadget)
       SetGadgetState(#ImageGadgetBG, ImageID(#ImageCanvas))
  EndSelect
  
EndIf;Regarding StartDrawing(ImageOutput(#ImageCanvas))     
EndProcedure
;================================================================================
;     GADGETS
;================================================================================
CreateImage(#ImageOriginal, 222,222)
StartDrawing(ImageOutput(#ImageOriginal))
  Box(0,0,222,222,#Blue)
StopDrawing()
CopyImage(#ImageOriginal,#ImageCanvas)
OpenWindow(#Main_Window,0,0,222,222,"",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
ImageGadget(#ImageGadgetBG,0,0,160,120,ImageID(#ImageOriginal))
DisableGadget(#ImageGadgetBG,1); Has to be DISABLED to allow actions from the optiongadgets.
OptionGadget(#OptImageGadget,0,0,133,13, "ImageGadget - Flicker")
OptionGadget(#OptSetGadget,0,15,133,13, "SetGadget - No Flicker")
;==========================================================================================
;     MAIN LOOP
;==========================================================================================
Repeat
WaitWindowEvent()
  ;---SENSE MOUSE MOVEMENTS *********************************
lMouse = GetAsyncKeyState_(#VK_LBUTTON);API MS_WINDOWS.   *
;******* HOVERING MOUSEOVER ********************************
udvMouseXY\lMoX = WindowMouseX(#Main_Window)
udvMouseXY\lMoY = WindowMouseY(#Main_Window)
;Debug EventGadget()
Select EventGadget()
  Case   #OptImageGadget
    DisableGadget(#ImageGadgetBG,0); Has to be ENABLED below to make the EventGadget() = #ImageGadgetBG work.
  Case #OptSetGadget 
    DisableGadget(#ImageGadgetBG,0); Has to be ENABLED below to make the EventGadget() = #ImageGadgetBG work.
  Case #ImageGadgetBG;Something action is happening on #ImageGadgetBG.
  ;MessageRequester("","EventGadget() = #ImageGadgetBG")
 ;*** DETECTING IF USER HITS THE MOUSE BUTTON FOR A FRESH ROUND *** IF SO THE DO INITIATE THE DRAWING COORDINATES ****************
  If lMouse<> #LMouseButtonUp;This means that mousebutton is DOWN. I don't normally use #LMouseButtonDown because PB gives me several flags from the mouse down.
   If FlagDrag=#False;Waiting for user to hit the mousebuton.
      FlagDrag=#True
      udvStartPosXY = udvMouseXY;starting to detect differences in mousepos aka movements.
      ;n+1:SetWindowTitle(0,Str(n) + " visits in StartPos!")
   EndIf
  EndIf
  DisableGadget(#ImageGadgetBG,1); Has to be DISABLED to work as a stable container.
  SetWindowTitle(#Main_Window,Str(FlagDrag))
 
EndSelect;Regarding EventGadget()
;SetWindowTitle(#Main_Window,Str(lMouse))
   ;*** DETECTING IF MOUSE I STILL DOWN AND MOVING ELSE 
  If FlagDrag = #True
   If lMouse <> #LMouseButtonUp;This means that mousebutton is DOWN. I don't normally use #LMouseButtonDown because PB gives me several flags from the mouse down.
       If  udvMouseXY <> udvOldMouseXY; If mouse has moved.
         Draw_RubberBand()
       EndIf
   Else
     FlagDrag = #False;MouseButton is UP.
     MessageRequester("","Please click option before trying again!")
     DisableGadget(#ImageGadgetBG,1); Has to be DISABLED to make the other gadgets work.
     ;*** REFRESH GADGETS ***
     SetActiveGadget(#OptImageGadget)
     SetActiveGadget(#OptSetGadget)
   EndIf
 EndIf
Until WaitWindowEvent()=#WM_CLOSE