Graphic rectangular area requester

[Olli]

Hello,

I think, near the all is in the title !

Merry day !

Code: Select all

; 2022/12/24 Initial version
; 2022/12/26 Desktop bug on Linux fixed, thanks to juergenkulow
; 2022/12/27 Compatibility : Local vars defined by 'Protected'


Procedure getDesktopSize(*w.integer, *h.integer)
    CompilerIf #PB_Compiler_OS = #PB_OS_Windows
        Protected temp.i
        temp = OpenWindow(#PB_Any, 0, 0, 1, 1, "", #PB_Window_Invisible | #PB_Window_BorderLess | #PB_Window_Maximize)
        *w\i = WindowWidth(temp)
        *h\i = WindowHeight(temp)
        CloseWindow(temp)
    CompilerElse
        ExamineDesktops()
        *w\i = DesktopWidth(0)
        *h\i = DesktopHeight(0)
    CompilerEndIf
EndProcedure



Procedure mouseGetInfo(*x.double, *y.double, *dx.double, *dy.double)
    Static.d mx, my, mx0, my0
    mx = DesktopMouseX()
    my = DesktopMouseY()        
    *x\d = mx
    *y\d = my
    *dx\d = mx - mx0
    *dy\d = my - my0
    mx0 = mx
    my0 = my
EndProcedure

;- recta struc
Structure recta ; RECTangular Area    
    win.i       ; for create()
    x.d
    y.d
    w.i
    h.i
    gad.i
    *getEvent
    
    evType.i        ; for getEvent()
    drag.i
    cbUsed.i                                        ; Call Back USED  
    
    *lace           ; for laceApply()
    i.i
    j.i
EndStructure

;- lace struc
Structure lace
    deskW.i
    deskH.i
    stickW.d
    stickH.d
    Array *r.recta(2, 2) ; Object
    *ok.recta
    *cancel.recta
    x.d
    y.d
    w.d
    h.d
    *xOut.integer
    *yOut.integer
    *wOut.integer
    *hOut.integer
EndStructure



Declare laceApply(*this.lace, i.i, j.i, dx.d, dy.d, applyType.i = 0)
Declare laceUpdate(*this.lace)
Declare laceSetGeometry(*this.lace, x.d, y.d, w.d, h.d)
Declare laceDestroy(*this.lace)
Declare rectaGetEvent()

Procedure rectaCreate(x.d, y.d, w.i, h.i, *callBack = 0, *draw = 0)
    Protected *this.recta = AllocateMemory(SizeOf(recta) )
    With *this
        \win = OpenWindow(#PB_Any, x, y, w, h, "", #PB_Window_BorderLess)
        \gad = CanvasGadget(#PB_Any, 0, 0, w, h, #PB_Canvas_Keyboard)
        If *draw
            StartDrawing(CanvasOutput(\gad) )
            CallFunctionFast(*draw)
            StopDrawing()
        EndIf
        If *callBack
            \getEvent = *callBack
        Else
            \getEvent = @rectaGetEvent()
        EndIf
        \x = x
        \y = y
        \w = w
        \h = h
        SetWindowData(\win, *this)
        BindGadgetEvent(\gad, \getEvent)
        SetActiveGadget(\gad)
        StickyWindow(\win, 1)
    EndWith
    ProcedureReturn *this
EndProcedure

Procedure rectaDestroy(*this.recta)
    With *this
        UnbindGadgetEvent(\gad, \getEvent)
        CloseWindow(\win)
        FreeMemory(*this)
    EndWith
EndProcedure

Procedure rectaGetEvent()
    Protected void.i, none.d
    Protected.d mx, my, mdx, mdy
    Protected *this.recta = GetWindowData(EventWindow() )
    With *this
        If Not \cbUsed
            StartDrawing(CanvasOutput(EventGadget() ) )
            Box(0, 0, \w, \h, RGB(0, 0, 0) )
            StopDrawing()
            \cbUsed = 1
        EndIf
        \evType = EventType()
        If \evType = #PB_EventType_LeftButtonDown
            mouseGetInfo(@none, @none, @none, @none)
            \drag | 1
        EndIf
        If \evType = #PB_EventType_LeftButtonUp 
            \drag & ~1
            laceUpdate(\lace)
        EndIf
        If \evType = #PB_EventType_RightButtonDown
            mouseGetInfo(@none, @none, @none, @none)
            \drag | 2
        EndIf
        If \evType = #PB_EventType_RightButtonUp 
            \drag & ~2
            laceUpdate(\lace)
        EndIf
        If \drag
            mouseGetInfo(@mx, @my, @mdx, @mdy)
            laceApply(\lace, \i - 1, \j - 1, mdx, mdy, Bool(\drag - 1) )
        EndIf
    EndWith
EndProcedure

Procedure laceOkayDraw()
    Protected w = OutputWidth()
    Protected h = OutputHeight()
    Box(0, 0, w, h, RGB(0, 127, 0) )
    Line(1, h / 2, 1, (h - 2) / 2, RGB(255, 255, 255) )
    Line(w - 2, 1, -(w - 2), h - 2, RGB(255, 255, 255) )
EndProcedure 

Procedure laceCancelDraw()
    Protected w = OutputWidth()
    Protected h = OutputHeight()
    Box(0, 0, w, h, RGB(255, 0, 0) )
    Line(1, 1, w - 2, h - 2, RGB(255, 255, 255) )
    Line(w - 2, 1, -(w - 2), h - 2, RGB(255, 255, 255) )
EndProcedure

Procedure laceIsOkay()
    Protected *this.recta = GetWindowData(EventWindow() )
    Protected *that.lace
    With *that
        *this\evType = EventType()
        *that = *this\lace
        If *this\evType = #PB_EventType_LeftClick
            *that\xOut\i = *this\x
            *that\yOut\i = *this\y
            *that\wOut\i = *this\w
            *that\hOut\i = *this\h
            Debug *this\x
            Debug *this\y
            Debug *this\w
            Debug *this\h
            laceDestroy(*that)
            End
        EndIf
    EndWith
EndProcedure

Procedure laceIsCancelled()
    Protected *this.recta = GetWindowData(EventWindow() )
    With *this
        \evType = EventType()
        If \evType = #PB_EventType_LeftClick
            laceDestroy(*this\lace)
            End
        EndIf
    EndWith
EndProcedure

Procedure laceCreate(*x.integer, *y.integer, *w.integer, *h.integer, x.i = 0, y.i = 0, w.i = 0, h.i = 0, stickW.d = 16.0, stickH.d = 16.0)
    Protected *this.lace = AllocateMemory(SizeOf(lace) )
    Protected *that.recta
    Protected dw, dh
    InitializeStructure(*this, lace)
    With *this
        \stickW = stickW
        \stickH = stickH
        getDesktopSize(@\deskW, @\deskH)
        If x + y + w + h = 0
            dw = \deskW
            dh = \deskH
            x = dw / 4
            y = dh / 4
            w = dw / 2
            h = dh / 2
        EndIf
        If x & y & w & h = -1
            x = *x\i
            y = *y\i
            w = *w\i
            h = *h\i
        EndIf
        \xOut = *x
        \yOut = *y
        \wOut = *w
        \hOut = *h
        laceSetGeometry(*this, x, y, w, h)
        \ok = rectaCreate(x + stickW, y + h - stickH, stickW, stickH, @laceIsOkay(), @laceOkayDraw() )
        *that = \ok
        *that\lace = *this
        \cancel = rectaCreate(x + w - stickW, y + stickH, stickW, stickH, @laceIsCancelled(), @laceCancelDraw() )        
        *that = \cancel
        *that\lace = *this
    EndWith
    ProcedureReturn *this
EndProcedure

Procedure laceDestroy(*this.lace)
    With *this
        For j = 0 To 2
            For i = 0 To 2
                rectaDestroy(\r(i, j) )
            Next
        Next    
        rectaDestroy(\ok)
        rectaDestroy(\cancel)
        ClearStructure(*this, lace)    
        FreeMemory(*this)
    EndWith
EndProcedure

Procedure laceSetGeometry(*this.lace, x.d, y.d, w.d, h.d)
    Protected.d dw, dh
    With *this\r(i, j)
        dw = w / 2
        dh = h / 2
        For j = 0 To 2
            For i = 0 To 2
                *this\r(i, j) = rectaCreate(x + i * dw, y + j * dh, *this\stickW, *this\stickH)
                \lace = *this
                \i = i
                \j = j
            Next
        Next    
    EndWith
    With *this
        \x = x
        \y = y
        \w = w
        \h = h
    EndWith
EndProcedure

Procedure laceSetCallBack(*this.lace)
    Protected.d dw, dh
    With *this\r(i, j)
        dw = w / 2
        dh = h / 2
        For j = 0 To 2
            For i = 0 To 2
                *this\r(i, j) = rectaCreate(x + i * dw, y + j * dh, 16, 16)
                \lace = *this
                \i = i
                \j = j
            Next
        Next    
    EndWith
EndProcedure

Procedure laceUpdate(*this.lace)
    Protected i, j
    With *this
        For j = 0 To 2
            ResizeWindow(\r(1, j)\win, (WindowX(\r(0, j)\win) + WindowX(\r(2, j)\win) ) / 2, #PB_Ignore, #PB_Ignore, #PB_Ignore)
        Next
        For i = 0 To 2
            ResizeWindow(\r(i, 1)\win, #PB_Ignore, (WindowY(\r(i, 0)\win) + WindowY(\r(i, 2)\win) ) / 2, #PB_Ignore, #PB_Ignore)
        Next
        For j = 0 To 2
            For i = 0 To 2
                \r(i, j)\x = WindowX(\r(i, j)\win)
                \r(i, j)\y = WindowY(\r(i, j)\win)
            Next
        Next
    EndWith
EndProcedure

Procedure Bound(*x.integer, *y.integer, x.i, y.i, w.i, h.i)
    If *x\i < x
        *x\i = x        
    EndIf
    If *y\i < y
        *y\i = y
    EndIf   
    If *x\i > x + w
        *x\i = x + w
    EndIf
    If *y\i > y + h
        *y\i = y + h
    EndIf   
EndProcedure

Procedure laceApply(*this.lace, i.i, j.i, dx.d, dy.d, applyType.i = 0)
    Protected midd = Bool(Not (i Or j) ) 
    Protected dw, dh
    Protected x, y
    With *this\r(i0 + 1, j0 + 1)
        For j0 = -1 To 1
            For i0 = -1 To 1
                If applyType
                    \x + dx * ((1 + i0 * Sign(i) ) / 2 * Bool(i) + midd)
                    \y + dy * ((1 + j0 * Sign(j) ) / 2 * Bool(j) + midd)
                Else
                    \x + dx * ((i0 * Sign(i) ) * Bool(i) + midd)
                    \y + dy * ((j0 * Sign(j) ) * Bool(j) + midd)
                EndIf
                x = \x
                y = \y
                Bound(@x, @y, 0, 0, *this\deskW - *this\stickW, *this\deskH - *this\stickH)
                ResizeWindow(\win, x, y, #PB_Ignore, #PB_Ignore)
            Next
        Next 
    EndWith
    With *this
        \x = WindowX(\r(0, 0)\win)
        \y = WindowY(\r(0, 0)\win)
        \w = WindowX(\r(2, 2)\win) - \x
        \h = WindowY(\r(2, 2)\win) - \y
        ResizeWindow(\ok\win, \x + \stickW * 1, \y + \h - \stickH * 1, #PB_Ignore, #PB_Ignore)
        ResizeWindow(\cancel\win, \x + \w - \stickW * 1, \y + \stickH * 1, #PB_Ignore, #PB_Ignore)
    EndWith
EndProcedure

;- main

Define x, y, w, h
Define *L0.lace = laceCreate(@x, @y, @w, @h)
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow

[idle]

thanks for sharing, I didn't know you could draw to an invisible window like that.

[juergenkulow]

On Linux, unfortunately, there are only three icons in the upper left corner, one of them black, and always as confirmation output: 16.0 -16.0 16 16

[Olli]

On Linux, unfortunately, there are only three icons in the upper left corner, one of them black, and always as confirmation output: 16.0 -16.0 16 16

I thank your feed back. I must simplify the process in order to allow you to modify several parameters on the fly in such ways.

thanks for sharing, I didn't know you could draw to an invisible window like that.

Note that you have the right button too !

[Olli]

@juergenkulow

Could you test this main process ?

Code: Select all

;- main

Define x = 100, y = 100, w = 400, h = 300
Define *L0.lace = laceCreate(@x, @y, @w, @h, -1, -1, -1, -1)
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow

This forces the provider to use initial values, and this does also ignore the desktop measures.

[juergenkulow]

Code: Select all

Procedure getDesktopSize(*w.integer, *h.integer)
  Define temp.i
  temp = OpenWindow(#PB_Any, 0, 0, 1, 1, "", #PB_Window_Invisible | #PB_Window_BorderLess | #PB_Window_Maximize)
  Debug WindowWidth(temp)
  Debug WindowHeight(temp)
  *w\i = WindowWidth(temp)
  *h\i = WindowHeight(temp)
  CloseWindow(temp)
EndProcedure

getDesktopSize(@w,@h)

; Windows 
; 1440
; 2560

; Linux 
; 1
; 1

If you click on a black icon getDesktopSize is called and everything slides to the upper left corner. The error is still there.

[Olli]

@juergenkulow

I thank you for this detail. It is a mistake from my own : the documentation tells us the #PB_Window_Maximize flag is not ever supported.

I must fix it. Now, I hope it is okay...

[Olli]

Variable names compatibility bug fixed

[Lord]

Is it only for one monitor?
If the window is moved to a monitor placed left,
(negativ WindowX()) the window stops on the
left side and is getting smaller.

[Olli]

Is it only for one monitor?

Yes ! (Why ?)

- coding : does the same system on Linux and on Windows ?
- object : bounds are handlable (you can bound what you want to set, inside the desktop)
- ergo : how to implement what you describe (pass over the initial bounds) without transforming the buttons lace to a too complex interface ?

[ChrisR]

Nice Olli (except for the 11 windows in the taskbar), it works well

Small thing seen, if you stretch the rectangle to the max from the bottom right handle, the top left handle is not in position 0x0
To fix it, you can set the handles to be inside the rectangle, In laceSetGeometry():

Code: Select all

*this\r(i, j) = rectaCreate(x + i * dw, y + j * dh, *this\stickW, *this\stickH)
=>
*this\r(i, j) = rectaCreate(x + i * (dw - *this\stickW / 2), y + j * (dh - *this\stickH / 2), *this\stickW, *this\stickH)

# Also, not much to change, to be compatible also with the DPIaware compiler option:

In mouseGetInfo():

Code: Select all

mx = DesktopUnscaledX(DesktopMouseX())
my = DesktopUnscaledY(DesktopMouseY())

In rectaGetEvent():

Code: Select all

Box(0, 0, DesktopScaledX(\w), DesktopScaledY(\h), RGB(0, 0, 0))

[Olli]

Is it only for one monitor?

If the window is moved to a monitor placed left,
(negativ WindowX()) the window stops on the
left side and is getting smaller.

@Lord

If you test this main process, forcing the initial bounds getting any negative values, what does it happen
?

Code: Select all

;- main

Define x = -100, y = 100, w = 400, h = 300
Define *L0.lace = laceCreate(@x, @y, @w, @h, -1, -1, -1, -1)
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow

@ChrisR

Lots of technical details : this requires more time to analyze them. What it will be the next thing I will do

@e1

I am thinking about :

- a cleverer back data result. The provider would not manage the memory anymore and it would let the coder to manage it (no automatical destroy function anymore)

- continuing to develop the array architecture, by expanding from a 3*3 values size to a 5*5 values size. This allows us to insert the lengths between the positions.

[Lord]

...
If you test this main process, forcing the initial bounds getting any negative values, what does it happen
?

Code: Select all

;- main

Define x = -100, y = 100, w = 400, h = 300
Define *L0.lace = laceCreate(@x, @y, @w, @h, -1, -1, -1, -1)
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow

...

The window is opened on the correct place, but as soon as you
click on the window, the window gets smaller and the left edge of the
window is located on the left edge of the main(right) monitor.
This is the then returned result:

-84.0
384.0
16
16