; Affiche un rectangle de sélection (celui qu'on obtient)
;   quand on maintient la touche gauche de la souris enfoncée
;   et qu'on déplace le curseur
; Permet de mettre de la couleur


; RubberBox PB 4
; einander 20 jul 2006
; http://www.purebasic.fr/english/viewtopic.php?T = 12674&highlight = rubberbox
Global _Drawing, _MX, _MY, _MK, _DX, _DY

Macro MOU ;-MOU
   _MX = WindowMouseX(0)
   _MY = WindowMouseY(0)
   _MK = Abs(GetAsyncKeyState_(#VK_LBUTTON) + GetAsyncKeyState_(#VK_RBUTTON)*2 + GetAsyncKeyState_(#VK_MBUTTON)*3)/$8000
   _DX = DesktopMouseX()
   _DY = DesktopMouseY()
   If GetAsyncKeyState_(#VK_ESCAPE): End: EndIf  ; esto sobra aqui, pero podria ser util<<<<<<<<<<<<<
EndMacro

Procedure RubberBox(RGB, *Rubber.RECT)
   BKG = CreateCompatibleDC_(_Drawing)
   Wi = WindowWidth(EventWindow()): He = WindowHeight(EventWindow())
   GetWindowRect_(WindowID(EventWindow()), @R.RECT)   ; Window bounding rectangle
   Rim =(R\right - R\left - Wi) / 2              ; window rim width
   HiTitle = R\bottom - R\top - He - Rim     ; title height
   SelectObject_(BKG, CreateImage(0, Wi, He))  ; keep background image
   BitBlt_(BKG, 0, 0, Wi, He, _Drawing, 0, 0, #SRCCOPY)
   x =_MX: y =_MY
   lb.LOGBRUSH\lbStyle =#BS_SOLID
   lb\lbColor = RGB
   Repeat
      EV = WindowEvent()
      X1 = WindowMouseX(0): Y1 = WindowMouseY(0)
      If X1 =- 1 : X1 =_DX - WindowX(0)- Rim : EndIf
      If Y1 =- 1 : Y1 =_DY - WindowY(0)- HiTitle : EndIf
      If X1<>xOld Or Y1 <>yOld
         If x<>X1 Or y <>Y1
            BitBlt_(_Drawing, 0, 0, Wi, He, BKG, 0, 0, #SRCCOPY) ; delete previous rectangle
            SelectObject_(_Drawing, GetStockObject_(#NULL_BRUSH ))
            Pen = ExtCreatePen_(#PS_COSMETIC| #PS_ALTERNATE, 1, @lb, 0, 0)
            SelectObject_(_Drawing, Pen)
            Rectangle_(_Drawing, x, y, X1, Y1)
            xOld = X1: yOld = Y1
            DeleteObject_(Pen)
         EndIf
      Else
         Delay(20)
      EndIf
   Until  GetAsyncKeyState_(#VK_LBUTTON)= 0
   BitBlt_(_Drawing, 0, 0, Wi, He, BKG, 0, 0, #SRCCOPY)  ; restore background
   DeleteDC_(BKG) ; recover memory
   *Rubber.RECT\left = x:*Rubber\top = y:*Rubber\right = X1:*Rubber\bottom = Y1 ; keep coords of selected rectangle
FreeImage(0)
EndProcedure
    ; _____________________________________________________
   
hwnd = OpenWindow(0, 100, 100, 600, 400, "RubberBox", #WS_OVERLAPPEDWINDOW )
_Drawing = StartDrawing(WindowOutput(0))
   
Repeat
   EV = WaitWindowEvent()
   MOU
   If EV =#WM_LBUTTONDOWN
      RubberBox(#Red, @Rubber.RECT) ; Rubber.Rect is updated with the selected values
      Box(Rubber\left, Rubber\top, Rubber\right - Rubber\left, Rubber\bottom - Rubber\top, Random($FFFFFF))
   EndIf
Until EV = #PB_Event_CloseWindow