Wouhh, that seems very impressive!! I will try your code ASAP. Many thanks, Arnaud. I will let you know if it works and will publish modifications (if any) for members interested in.
Jean-Luc Arnaud Le 30/01/2016 14:19, Marnaud a écrit : >> In you canvas (where everything will be done, unless stated), add these >> properties: Selection() as integer, ClickedCorner As Integer=-1 >> When Selection is an empty array, it means there's no selection; else, we >> expect it to have a size of 7 (0-7), with x and y for each bound. >> ClickedCorner is meant to know what the user has clicked. >> >> First part, the selection: >> In the MouseDown event: >> Selection=Array(x,y,x,y,x,y,x,y) //All bounds default to the origin >> Return True >> >> In the MouseDrag: >> Selection(2)=x 'New x for the right-top corner >> Selection(5)=y 'New y for the left-bottom corner >> Selection(6)=x 'New x for the right-bottom corner >> Selection(7)=y 'New y for the right-bottom corner >> me.refresh false >> >> In the paint event, near the end: >> if UBound(Selection)>=7 then >> g.ForeColor=HighlightColor >> g.DrawRect >> Selection(0),Selection(1),Selection(2)-Selection(0),Selection(3),Selection(4),Selection(5)-Selection(1),Selection(6)-Selection(0),Selection(7)-Selection(1) >> end if >> >> Now, add a method like this: >> Function GetCornerForXAndY(x as integer,y as integer) >> if UBound(selection)<7 then return -1 //No corner exists >> >> if abs(x-selection(0))<5 then 'We're at the left line >> if abs(y-selection(1))<5 then Return 0 //Left-Top >> if abs(y-selection(7)<5 then Return 2 //Left-Bottom >> elseif abs(x-selection(2)<5 then 'We're at the right line >> if abs(y-selection(1))<5 then Return 1 //Right-Top >> if abs(y-selection(7)<5 then Return 3 //Right-Bottom >> end if > if x<selection(0) or y<selection(1) or x>selection(6) or y>selection(7) then > return -1 //the user clicked outside of the rectangle; we may start a new one > return 4 //User clicked inside the rectangle; we'll move it > End Function > > Add another method: > Function GetXAndYForCorner(CornerID as integer) as Pair > if UBound(Selection)<7 then return nil > select case CornerID > case 0 > return new Pair(selection(0),selection(1)) > case 1 > return new Pair(selection(2),selection(3)) > case 2 > return new Pair(selection(4),selection(5)) > case 3 > return new Pair(selection(6),selection(7)) > end select > end function > > Add two properties to the canvas: DeltaX as integer, DeltaY as integer. Those > will be used for the distance between the mouse and (either) the centre of a > handle or the left-top corner for a move. > Modify the MouseDown event like this (since we're at the next step): > > ClickedCorner=GetCornerForXAndY(x,y) > select case ClickedCorner > case -1 //Start new selection > Selection=Array(x,y,x,y,x,y,x,y) //All bounds default to the origin > Return True > case 4 //Move > DeltaX=x-Selection(0) > DeltaY=y-Selection(1) > Return True > else 'A handler > dim p as pair > > p=GetXAndYForCorner(ClickedCorner) > if p<>nil then > DeltaX=x-p.left > DeltaY=y-p.right > return true > end if > end select > > Add another method: > Sub MoveSelection(Corner as integer,HValue as integer,VValue as integer) > dim i as integer > > select case Corner > case 4 //Move > for i=0 to UBound(selection) > if i mod 2=0 then > selection(i)=selection(i)+HValue > else > selection(i)=selection(i)+VValue > end if > next > else > selection(corner*2)=selection(corner*2)+HValue > selection(corner*2+1)=selection(corner*2+1)+VValue > end select > end sub > > Modify the MouseDrag: > select case ClickedCorner > case -1 //Start new selection > Selection(2)=x 'New x for the right-top corner > Selection(5)=y 'New y for the left-bottom corner > Selection(6)=x 'New x for the right-bottom corner > Selection(7)=y 'New y for the right-bottom corner > case 4 //Move > MoveSelection(ClickedCorner,selection(0),(x-selection(0))-DeltaX,(y-selection(1))-DeltaY) > else 'A handler > dim p as pair > > p=GetXAndYForCorner(ClickedCorner) > if p<>nil then > MoveSelection(ClickedCorner,(x-p.left)-DeltaX,(y-p.right)-DeltaY > end if > end select > me.refresh false > > Again, it's not a tested code, just a hint. > _______________________________________________ > Mbsplugins_monkeybreadsoftware.info mailing list > [email protected] > https://ml01.ispgateway.de/mailman/listinfo/mbsplugins_monkeybreadsoftware.info > _______________________________________________ Mbsplugins_monkeybreadsoftware.info mailing list [email protected] https://ml01.ispgateway.de/mailman/listinfo/mbsplugins_monkeybreadsoftware.info
