(09-25-2024, 04:24 PM)SMcNeill Wrote: The way I'd go about this would be to :

1) Make a _CopyImage of the existing screen.
2) Set _DontBlend on that CopyImage
3) When clicking the mouse, I'd draw a line from point A to point B in COLOR 0 (no alpha, no red, no green, no blue.)   Do this until you enclose the area you want to copy.  Keep the max top/left/bottom/right coordinates to make a box later.
4) PAINT that screen in COLOR 0, outside the box to keep.
5) Turn _Blend on for that CopyImage
6) You can now _PutImage that top/left/bottom/right box onto the main screen.
7) Freeimage that _CopyImage

(09-25-2024, 07:24 PM)TerryRitchie Wrote: Here's some quick code I hacked together over the past few hours showing how I would do this.

The GetPolygon subroutine I added just so you would have something to select. The ClipImage subroutine is really all that is needed, along with a populated Poly() list to clip an image.

Use the left mouse button to select your points.  Use the right mouse button (or cross any two lines) to close the polygon and have the image clipped.

The ZIP file below contains the code and image I used. Again, this was a quick hack, it will probably have unforseen error conditions that need to be taken into account.

Code: (Select All)

' Quick hack to show how to clip a polygon area from an image


OPTION _EXPLICIT

TYPE TYPE_IPOINT
    x AS INTEGER
    y AS INTEGER
END TYPE

TYPE TYPE_LINE '               line segment definition
    Start AS TYPE_IPOINT '     x,y start of line segment (defined in LIB_TYPE_SPOINT.BI)
    Finish AS TYPE_IPOINT '    x,y end of line segment   (defined in LIB_TYPE_SPOINT.BI)
END TYPE

REDIM Poly(0) AS TYPE_IPOINT
DIM Image AS LONG
DIM Clip AS LONG
DIM sWidth AS INTEGER
DIM sHeight AS INTEGER

Image = _LOADIMAGE("canyon.png", 32)
sWidth = _WIDTH(Image)
sHeight = _HEIGHT(Image)


SCREEN _NEWIMAGE(sWidth, sHeight, 32)
_PUTIMAGE (0, 0), Image
GetPolygon Image, Poly()
ClipImage Image, Poly(), Clip

CLS
_PUTIMAGE (0, 0), Clip ' the final polygon clipped from the image



'-----------------------------------------------------------------------------------------------------------------------------------------
SUB MakeMask (i AS LONG)

    ' -----------------------------------------------------------------------------------------
    '| This subroutine assumes the image passed in has already had an outer mask color applied |
    ' -----------------------------------------------------------------------------------------

    CONST OUTER~& = _RGBA32(255, 0, 255, 255) '   outside the polygon (bright magenta)
    CONST INNER~& = _RGBA32(0, 0, 0, 0) '         inside the ploygon  (transparent black)
    DIM m AS _MEM '                               memory block holding image data
    DIM e AS _OFFSET '                            end of memory block
    DIM o AS _OFFSET '                            4 byte pixel location within memory block
    DIM p AS _UNSIGNED LONG '                     individual pixel

    IF i < -1 THEN
        IF _PIXELSIZE(i) = 4 THEN
            $CHECKING:OFF
            m = _MEMIMAGE(i)
            o = m.OFFSET
            e = o + m.SIZE
            DO
                _MEMGET m, o, p
                IF p <> OUTER THEN _MEMPUT m, o, INNER AS _UNSIGNED LONG
                o = o + 4
            LOOP UNTIL o = e
            _MEMFREE m
            $CHECKING:ON
        END IF
    END IF

END SUB


'-----------------------------------------------------------------------------------------------------------------------------------------
SUB ClipImage (Image AS LONG, Poly() AS TYPE_IPOINT, Clip AS LONG)

    ' -----------------------------------------
    '| Clip the image contained in the polygon |
    ' -----------------------------------------

    CONST TRACE~& = _RGB32(0, 0, 1)
    CONST OUTER~& = _RGB32(255, 0, 255)

    DIM ImageCopy AS LONG
    DIM Mask AS LONG
    DIM Minx AS INTEGER
    DIM Miny AS INTEGER
    DIM MaxX AS INTEGER
    DIM MaxY AS INTEGER
    DIM c AS INTEGER
    DIM oDest AS LONG

    oDest = _DEST
    PolyMinMax Poly(), Minx, Miny, MaxX, MaxY
    ImageCopy = _NEWIMAGE(_WIDTH(Image) + 2, _HEIGHT(Image) + 2, 32)
    _PUTIMAGE (1, 1), Image, ImageCopy
    _DEST ImageCopy

    ' --------------------------------------------------------------
    '| Trace the outer edges of the polygon and paint outside of it |
    ' --------------------------------------------------------------

    PSET (Poly(0).x + 1, Poly(0).y + 1), TRACE
    FOR c = 1 TO UBOUND(Poly)
        LINE -(Poly(c).x + 1, Poly(c).y + 1), TRACE
    NEXT c
    LINE -(Poly(0).x + 1, Poly(0).y + 1), TRACE
    PAINT (0, 0), OUTER, TRACE

    ' -------------------------------------
    '| Create an image mask of the polygon |
    ' -------------------------------------

    Mask = _NEWIMAGE(MaxX - Minx, MaxY - Miny, 32)
    _PUTIMAGE (0, 0), ImageCopy, Mask, (Minx + 1, Miny + 1)-(MaxX + 1, MaxY + 1)
    MakeMask Mask

    ' -----------------------------------
    '| Apply the mask and clip the image |
    ' -----------------------------------

    _PUTIMAGE (1, 1), Image, ImageCopy
    _PUTIMAGE (Minx + 1, Miny + 1), Mask, ImageCopy
    Clip = _NEWIMAGE(MaxX - Minx, MaxY - Miny, 32)
    _PUTIMAGE (0, 0), ImageCopy, Clip, (Minx + 1, Miny + 1)-(MaxX + 1, MaxY + 1)
    _CLEARCOLOR OUTER, Clip
    _FREEIMAGE ImageCopy
    _FREEIMAGE Mask
    _DEST oDest

END SUB

'-----------------------------------------------------------------------------------------------------------------------------------------
SUB PolyMinMax (Poly() AS TYPE_IPOINT, MinX AS INTEGER, MinY AS INTEGER, MaxX AS INTEGER, MaxY AS INTEGER)

    ' ------------------------------
    '| Get the polygon bounding box |
    ' ------------------------------

    DIM c AS INTEGER

    MinX = Poly(0).x
    MinY = Poly(0).y
    MaxX = Poly(0).x
    MaxY = Poly(0).y

    FOR c = 0 TO UBOUND(Poly)
        IF Poly(c).x < MinX THEN MinX = Poly(c).x
        IF Poly(c).y < MinY THEN MinY = Poly(c).y
        IF Poly(c).x > MaxX THEN MaxX = Poly(c).x
        IF Poly(c).y > MaxY THEN MaxY = Poly(c).y
    NEXT c

END SUB

'-----------------------------------------------------------------------------------------------------------------------------------------
SUB GetPolygon (Image AS LONG, Poly() AS TYPE_IPOINT)

    ' ---------------------------------------
    '| Allow user to select a polygon region |
    ' ---------------------------------------

    REDIM Poly(0) AS TYPE_IPOINT
    DIM lStyle(1) AS _UNSIGNED INTEGER
    DIM Style AS _BYTE
    DIM c AS INTEGER
    DIM Frame AS INTEGER
    DIM NewLine AS TYPE_LINE
    DIM PolyLine AS TYPE_LINE
    DIM Intersection AS TYPE_IPOINT

    lStyle(0) = &B1111000011110000 ' moving selection line styles
    lStyle(1) = &B0000111100001111

    ' --------------------------------
    '| wait for first point selection |
    ' --------------------------------

    DO
        _LIMIT 60
        WHILE _MOUSEINPUT: WEND
        IF _MOUSEBUTTON(1) THEN
            Poly(0).x = _MOUSEX
            Poly(0).y = _MOUSEY
            EXIT DO
        END IF
    LOOP

    ' ---------------------------------
    '| Get subsequent point selections |
    ' ---------------------------------

    DO
        _LIMIT 60
        _PUTIMAGE (0, 0), Image
        WHILE _MOUSEINPUT: WEND
        IF _MOUSEBUTTON(1) THEN

            ' -------------------------------------------------------------------------
            '| User clicked left mouse button. Add x,y location to polygon point list. |
            ' -------------------------------------------------------------------------

            REDIM _PRESERVE Poly(UBOUND(Poly) + 1) AS TYPE_IPOINT
            Poly(UBOUND(Poly)).x = _MOUSEX
            Poly(UBOUND(Poly)).y = _MOUSEY

            ' -------------------------------------------------
            '| Get the line that creates this new polygon side |
            ' -------------------------------------------------

            NewLine.Start.x = Poly(UBOUND(Poly) - 1).x
            NewLine.Start.y = Poly(UBOUND(Poly) - 1).y
            NewLine.Finish.x = _MOUSEX
            NewLine.Finish.y = _MOUSEY

            ' ---------------------------------------------------------------
            '| Check if polygon side collides with any existing polygon side |
            ' ---------------------------------------------------------------

            FOR c = 1 TO UBOUND(Poly) - 1
                IF c > 1 THEN
                    PolyLine.Start.x = Poly(c - 1).x
                    PolyLine.Start.y = Poly(c - 1).y
                    PolyLine.Finish.x = Poly(c).x
                    PolyLine.Finish.y = Poly(c).y
                    IF LineCollide(NewLine, PolyLine, Intersection) THEN
                        IF Intersection.x <> PolyLine.Finish.x AND Intersection.y <> PolyLine.Finish.y THEN
                            Poly(UBOUND(Poly)) = Poly(0)
                            EXIT SUB
                        END IF
                    END IF
                END IF
            NEXT c
        ELSEIF _MOUSEBUTTON(2) THEN

            ' -----------------------------------------------------
            '| User clicked right mouse button. Close the polygon. |
            ' -----------------------------------------------------

            REDIM _PRESERVE Poly(UBOUND(Poly) + 1) AS TYPE_IPOINT
            Poly(UBOUND(Poly)).x = _MOUSEX
            Poly(UBOUND(Poly)).y = _MOUSEY
            EXIT DO
        END IF

        ' -----------------------------------------
        '| Draw the polygon selected to this point |
        ' -----------------------------------------

        Frame = Frame + 1
        IF Frame = 61 THEN Frame = 1
        IF Frame MOD 15 = 0 THEN Style = 1 - Style
        PSET (Poly(0).x, Poly(0).y)
        FOR c = 1 TO UBOUND(Poly)
            LINE -(Poly(c).x, Poly(c).y), , , lStyle(Style)
        NEXT c
        LINE -(_MOUSEX, _MOUSEY), , , lStyle(Style)
        _DISPLAY
    LOOP

END SUB

'-----------------------------------------------------------------------------------------------------------------------------------------
FUNCTION LineCollide% (L1 AS TYPE_LINE, L2 AS TYPE_LINE, Collide AS TYPE_IPOINT)

    'https://www.jeffreythompson.org/collision-detection/line-line.php

    DIM uA AS SINGLE
    DIM uB AS SINGLE

    LineCollide% = 0 '                                              assume no collision (FALSE)
    Collide.x = -32767
    Collide.y = -32767

    ' calculate the distance to intersection point

    uA = ((L2.Finish.x - L2.Start.x) * (L1.Start.y - L2.Start.y) - (L2.Finish.y - L2.Start.y) * (L1.Start.x - L2.Start.x)) / _
         ((L2.Finish.y - L2.Start.y) * (L1.Finish.x - L1.Start.x) - (L2.Finish.x - L2.Start.x) * (L1.Finish.y - L1.Start.y))
    uB = ((L1.Finish.x - L1.Start.x) * (L1.Start.y - L2.Start.y) - (L1.Finish.y - L1.Start.y) * (L1.Start.x - L2.Start.x)) / _
         ((L2.Finish.y - L2.Start.y) * (L1.Finish.x - L1.Start.x) - (L2.Finish.x - L2.Start.x) * (L1.Finish.y - L1.Start.y))
    IF (uA >= 0) AND (uA <= 1) AND (uB >= 0) AND (uB <= 1) THEN '    are uA and uB both between 0 and 1?
        LineCollide% = -1 '                                         yes, a collision occurred (TRUE)
        Collide.x = L1.Start.x + (uA * (L1.Finish.x - L1.Start.x)) ' record collision point
        Collide.y = L1.Start.y + (uA * (L1.Finish.y - L1.Start.y))
    END IF

END FUNCTION

(09-25-2024, 07:34 PM)Petr Wrote: This works perfectly. And it includes great collision detection in a straight line! Thanks for sharing.

(09-25-2024, 07:24 PM)TerryRitchie Wrote: Here's some quick code I hacked together over the past few hours showing how I would do this.

The GetPolygon subroutine I added just so you would have something to select. The ClipImage subroutine is really all that is needed, along with a populated Poly() list to clip an image.

Use the left mouse button to select your points.  Use the right mouse button (or cross any two lines) to close the polygon and have the image clipped.

The ZIP file below contains the code and image I used. Again, this was a quick hack, it will probably have unforseen error conditions that need to be taken into account.

Code: (Select All)

' Quick hack to show how to clip a polygon area from an image


OPTION _EXPLICIT

TYPE TYPE_IPOINT
    x AS INTEGER
    y AS INTEGER
END TYPE

TYPE TYPE_LINE '               line segment definition
    Start AS TYPE_IPOINT '     x,y start of line segment (defined in LIB_TYPE_SPOINT.BI)
    Finish AS TYPE_IPOINT '    x,y end of line segment   (defined in LIB_TYPE_SPOINT.BI)
END TYPE

REDIM Poly(0) AS TYPE_IPOINT
DIM Image AS LONG
DIM Clip AS LONG
DIM sWidth AS INTEGER
DIM sHeight AS INTEGER

Image = _LOADIMAGE("canyon.png", 32)
sWidth = _WIDTH(Image)
sHeight = _HEIGHT(Image)


SCREEN _NEWIMAGE(sWidth, sHeight, 32)
_PUTIMAGE (0, 0), Image
GetPolygon Image, Poly()
ClipImage Image, Poly(), Clip

CLS
_PUTIMAGE (0, 0), Clip ' the final polygon clipped from the image



'-----------------------------------------------------------------------------------------------------------------------------------------
SUB MakeMask (i AS LONG)

    ' -----------------------------------------------------------------------------------------
    '| This subroutine assumes the image passed in has already had an outer mask color applied |
    ' -----------------------------------------------------------------------------------------

    CONST OUTER~& = _RGBA32(255, 0, 255, 255) '   outside the polygon (bright magenta)
    CONST INNER~& = _RGBA32(0, 0, 0, 0) '         inside the ploygon  (transparent black)
    DIM m AS _MEM '                               memory block holding image data
    DIM e AS _OFFSET '                            end of memory block
    DIM o AS _OFFSET '                            4 byte pixel location within memory block
    DIM p AS _UNSIGNED LONG '                     individual pixel

    IF i < -1 THEN
        IF _PIXELSIZE(i) = 4 THEN
            $CHECKING:OFF
            m = _MEMIMAGE(i)
            o = m.OFFSET
            e = o + m.SIZE
            DO
                _MEMGET m, o, p
                IF p <> OUTER THEN _MEMPUT m, o, INNER AS _UNSIGNED LONG
                o = o + 4
            LOOP UNTIL o = e
            _MEMFREE m
            $CHECKING:ON
        END IF
    END IF

END SUB


'-----------------------------------------------------------------------------------------------------------------------------------------
SUB ClipImage (Image AS LONG, Poly() AS TYPE_IPOINT, Clip AS LONG)

    ' -----------------------------------------
    '| Clip the image contained in the polygon |
    ' -----------------------------------------

    CONST TRACE~& = _RGB32(0, 0, 1)
    CONST OUTER~& = _RGB32(255, 0, 255)

    DIM ImageCopy AS LONG
    DIM Mask AS LONG
    DIM Minx AS INTEGER
    DIM Miny AS INTEGER
    DIM MaxX AS INTEGER
    DIM MaxY AS INTEGER
    DIM c AS INTEGER
    DIM oDest AS LONG

    oDest = _DEST
    PolyMinMax Poly(), Minx, Miny, MaxX, MaxY
    ImageCopy = _NEWIMAGE(_WIDTH(Image) + 2, _HEIGHT(Image) + 2, 32)
    _PUTIMAGE (1, 1), Image, ImageCopy
    _DEST ImageCopy

    ' --------------------------------------------------------------
    '| Trace the outer edges of the polygon and paint outside of it |
    ' --------------------------------------------------------------

    PSET (Poly(0).x + 1, Poly(0).y + 1), TRACE
    FOR c = 1 TO UBOUND(Poly)
        LINE -(Poly(c).x + 1, Poly(c).y + 1), TRACE
    NEXT c
    LINE -(Poly(0).x + 1, Poly(0).y + 1), TRACE
    PAINT (0, 0), OUTER, TRACE

    ' -------------------------------------
    '| Create an image mask of the polygon |
    ' -------------------------------------

    Mask = _NEWIMAGE(MaxX - Minx, MaxY - Miny, 32)
    _PUTIMAGE (0, 0), ImageCopy, Mask, (Minx + 1, Miny + 1)-(MaxX + 1, MaxY + 1)
    MakeMask Mask

    ' -----------------------------------
    '| Apply the mask and clip the image |
    ' -----------------------------------

    _PUTIMAGE (1, 1), Image, ImageCopy
    _PUTIMAGE (Minx + 1, Miny + 1), Mask, ImageCopy
    Clip = _NEWIMAGE(MaxX - Minx, MaxY - Miny, 32)
    _PUTIMAGE (0, 0), ImageCopy, Clip, (Minx + 1, Miny + 1)-(MaxX + 1, MaxY + 1)
    _CLEARCOLOR OUTER, Clip
    _FREEIMAGE ImageCopy
    _FREEIMAGE Mask
    _DEST oDest

END SUB

'-----------------------------------------------------------------------------------------------------------------------------------------
SUB PolyMinMax (Poly() AS TYPE_IPOINT, MinX AS INTEGER, MinY AS INTEGER, MaxX AS INTEGER, MaxY AS INTEGER)

    ' ------------------------------
    '| Get the polygon bounding box |
    ' ------------------------------

    DIM c AS INTEGER

    MinX = Poly(0).x
    MinY = Poly(0).y
    MaxX = Poly(0).x
    MaxY = Poly(0).y

    FOR c = 0 TO UBOUND(Poly)
        IF Poly(c).x < MinX THEN MinX = Poly(c).x
        IF Poly(c).y < MinY THEN MinY = Poly(c).y
        IF Poly(c).x > MaxX THEN MaxX = Poly(c).x
        IF Poly(c).y > MaxY THEN MaxY = Poly(c).y
    NEXT c

END SUB

'-----------------------------------------------------------------------------------------------------------------------------------------
SUB GetPolygon (Image AS LONG, Poly() AS TYPE_IPOINT)

    ' ---------------------------------------
    '| Allow user to select a polygon region |
    ' ---------------------------------------

    REDIM Poly(0) AS TYPE_IPOINT
    DIM lStyle(1) AS _UNSIGNED INTEGER
    DIM Style AS _BYTE
    DIM c AS INTEGER
    DIM Frame AS INTEGER
    DIM NewLine AS TYPE_LINE
    DIM PolyLine AS TYPE_LINE
    DIM Intersection AS TYPE_IPOINT

    lStyle(0) = &B1111000011110000 ' moving selection line styles
    lStyle(1) = &B0000111100001111

    ' --------------------------------
    '| wait for first point selection |
    ' --------------------------------

    DO
        _LIMIT 60
        WHILE _MOUSEINPUT: WEND
        IF _MOUSEBUTTON(1) THEN
            Poly(0).x = _MOUSEX
            Poly(0).y = _MOUSEY
            EXIT DO
        END IF
    LOOP

    ' ---------------------------------
    '| Get subsequent point selections |
    ' ---------------------------------

    DO
        _LIMIT 60
        _PUTIMAGE (0, 0), Image
        WHILE _MOUSEINPUT: WEND
        IF _MOUSEBUTTON(1) THEN

            ' -------------------------------------------------------------------------
            '| User clicked left mouse button. Add x,y location to polygon point list. |
            ' -------------------------------------------------------------------------

            REDIM _PRESERVE Poly(UBOUND(Poly) + 1) AS TYPE_IPOINT
            Poly(UBOUND(Poly)).x = _MOUSEX
            Poly(UBOUND(Poly)).y = _MOUSEY

            ' -------------------------------------------------
            '| Get the line that creates this new polygon side |
            ' -------------------------------------------------

            NewLine.Start.x = Poly(UBOUND(Poly) - 1).x
            NewLine.Start.y = Poly(UBOUND(Poly) - 1).y
            NewLine.Finish.x = _MOUSEX
            NewLine.Finish.y = _MOUSEY

            ' ---------------------------------------------------------------
            '| Check if polygon side collides with any existing polygon side |
            ' ---------------------------------------------------------------

            FOR c = 1 TO UBOUND(Poly) - 1
                IF c > 1 THEN
                    PolyLine.Start.x = Poly(c - 1).x
                    PolyLine.Start.y = Poly(c - 1).y
                    PolyLine.Finish.x = Poly(c).x
                    PolyLine.Finish.y = Poly(c).y
                    IF LineCollide(NewLine, PolyLine, Intersection) THEN
                        IF Intersection.x <> PolyLine.Finish.x AND Intersection.y <> PolyLine.Finish.y THEN
                            Poly(UBOUND(Poly)) = Poly(0)
                            EXIT SUB
                        END IF
                    END IF
                END IF
            NEXT c
        ELSEIF _MOUSEBUTTON(2) THEN

            ' -----------------------------------------------------
            '| User clicked right mouse button. Close the polygon. |
            ' -----------------------------------------------------

            REDIM _PRESERVE Poly(UBOUND(Poly) + 1) AS TYPE_IPOINT
            Poly(UBOUND(Poly)).x = _MOUSEX
            Poly(UBOUND(Poly)).y = _MOUSEY
            EXIT DO
        END IF

        ' -----------------------------------------
        '| Draw the polygon selected to this point |
        ' -----------------------------------------

        Frame = Frame + 1
        IF Frame = 61 THEN Frame = 1
        IF Frame MOD 15 = 0 THEN Style = 1 - Style
        PSET (Poly(0).x, Poly(0).y)
        FOR c = 1 TO UBOUND(Poly)
            LINE -(Poly(c).x, Poly(c).y), , , lStyle(Style)
        NEXT c
        LINE -(_MOUSEX, _MOUSEY), , , lStyle(Style)
        _DISPLAY
    LOOP

END SUB

'-----------------------------------------------------------------------------------------------------------------------------------------
FUNCTION LineCollide% (L1 AS TYPE_LINE, L2 AS TYPE_LINE, Collide AS TYPE_IPOINT)

    'https://www.jeffreythompson.org/collision-detection/line-line.php

    DIM uA AS SINGLE
    DIM uB AS SINGLE

    LineCollide% = 0 '                                              assume no collision (FALSE)
    Collide.x = -32767
    Collide.y = -32767

    ' calculate the distance to intersection point

    uA = ((L2.Finish.x - L2.Start.x) * (L1.Start.y - L2.Start.y) - (L2.Finish.y - L2.Start.y) * (L1.Start.x - L2.Start.x)) / _
         ((L2.Finish.y - L2.Start.y) * (L1.Finish.x - L1.Start.x) - (L2.Finish.x - L2.Start.x) * (L1.Finish.y - L1.Start.y))
    uB = ((L1.Finish.x - L1.Start.x) * (L1.Start.y - L2.Start.y) - (L1.Finish.y - L1.Start.y) * (L1.Start.x - L2.Start.x)) / _
         ((L2.Finish.y - L2.Start.y) * (L1.Finish.x - L1.Start.x) - (L2.Finish.x - L2.Start.x) * (L1.Finish.y - L1.Start.y))
    IF (uA >= 0) AND (uA <= 1) AND (uB >= 0) AND (uB <= 1) THEN '    are uA and uB both between 0 and 1?
        LineCollide% = -1 '                                         yes, a collision occurred (TRUE)
        Collide.x = L1.Start.x + (uA * (L1.Finish.x - L1.Start.x)) ' record collision point
        Collide.y = L1.Start.y + (uA * (L1.Finish.y - L1.Start.y))
    END IF

END FUNCTION

(09-25-2024, 08:24 PM)Dav Wrote: That's perfect, Terry.  Just I'm looking for.  Thanks for sharing!

- Dav

'copy/paste polygon image

'use mouse for inserting image



Image& = _ScreenImage

_Delay .5



Screen _NewImage(_DesktopWidth, _DesktopHeight, 32)

_FullScreen

Cls



Type Points

    As Integer x, y

End Type



Type LinePoints

    X As Integer

    Y As Integer

End Type

ReDim Shared LP(0) As LinePoints

ReDim nP(0) As Points





ReDim P(20000) As Points



Do

    _PutImage , Image& 'place complete image to screen



    Locate 1

    Print "Use mouse, press left button and select any image area"







    While _MouseInput

    Wend

    MX = _MouseX

    MY = _MouseY

    LB = _MouseButton(1)





    Print LB, MX, MY, j, max





    If LB = -1 Then

        'insert coordinate to array if is left mouse button pressed

        If oMX <> MX Or oMY <> MY Then 'if is mouse moved to other position

            P(j).x = MX '              add new coordinates to array P

            P(j).y = MY

            oMX = MX '                  and memorize old coordinates

            oMY = MY

            j = j + 1

            max = 0

            i = UBound(P)

            If j = i Then '            if array P is full, add next 20000 records

                ReDim _Preserve P(i + 20000) As Points

                max = 0

            End If

        End If

    End If





    'draw selected area: find used indexes



    If max = 0 Then 'lock for search maximum once if now record is not added

        max = UBound(P)

        Do Until P(max).x > 0 Or P(max).y > 0

            If max > 0 Then max = max - 1 Else Exit Do

        Loop

    End If





    If max Then

        PReset (P(0).x, P(0).y)

        For D = 1 To max

            Line -(P(D).x, P(D).y)

        Next

    End If



    'control if area is completed

    If max > 10 Then

        If Abs(P(max).x - P(0).x) < 5 And Abs(P(max).y - P(0).y) < 5 Then

            Print "select complete!"



            'find maximal/minimal X and Y

            c = 0

            minX = _Width

            minY = _Height

            Do Until c = max

                If minX > P(c).x Then minX = P(c).x

                If maxX < P(c).x Then maxX = P(c).x

                If minY > P(c).y Then minY = P(c).y

                If maxY < P(c).y Then maxY = P(c).y

                c = c + 1

            Loop



            'create alpha mask for image

            Mask& = _NewImage(maxX - minX + 20, maxY - minY + 20, 32)

            _Dest Mask&

            Cls , _RGB32(255)

            'here next rows is my new acces to this:

            ' 1) calculate all points in image border and write it to array nP



            For FillnP = 0 To max - 1

                ReDim LP(0) As LinePoints

                GETPOINTS P(FillnP).x, P(FillnP).y, P(FillnP + 1).x, P(FillnP + 1).y, LP()

                UnP = UBound(nP)

                ReDim _Preserve nP(UnP + UBound(LP)) As Points

                For Fnp = 0 To UBound(LP) 'calculate all new points to field nP

                    nP(UnP + Fnp).x = LP(Fnp).X

                    nP(UnP + Fnp).y = LP(Fnp).Y

                Next

            Next



            ReDim LP(0) As LinePoints

            GETPOINTS P(0).x, P(0).y, P(max).x, P(max).y, LP()

            UnP = UBound(nP)

            ReDim _Preserve nP(UnP + UBound(LP)) As Points

            For Fnp = 0 To UBound(LP) 'write all new points to field nP

                nP(UnP + Fnp).x = LP(Fnp).X

                nP(UnP + Fnp).y = LP(Fnp).Y

            Next



            '2) recalculate points on selected image border to mask image size

            For recal = 0 To UBound(nP)

                nP(recal).x = -minX + nP(recal).x

                nP(recal).y = -minY + nP(recal).y

            Next recal



            '3) now use LINE statement and make LINE from minX to selected image border on left

            '  and from selected image border on right to maxX



            '  3.1 draw selected image border

            '_AutoDisplay

            '_Dest 0

            'Cls

            '  Print UBound(nP)

            '  Sleep



            'Screen Mask&



            For LineDraw = 0 To UBound(nP)

                PSet (10 + nP(LineDraw).x, 10 + nP(LineDraw).y), _RGB32(254)

            Next

            Paint (_Width(Mask&) - 1, 0), _RGB32(0), _RGB32(254)



            'Sleep



            'here is done mask: Black color - was is not selected,  White color - was is selected



            _SetAlpha 0, _RGB32(255), Mask&

            _SetAlpha 0, _RGB32(254), Mask&



            'create done image + mask: Step 1 - apply full image

            '                          Step 2 - apply mask:



            doneImage& = _NewImage(maxX - minX, maxY - minY, 32)

            'step 1

            _PutImage (0, 0), Image&, doneImage&, (minX, minY)-(maxX, maxY)

            'step 2

            _PutImage (-10, -10), Mask&, doneImage&



            'erase ram

            _FreeImage Mask&

            _FreeImage Image&



            'return to my screen

            _Dest 0

            _Source 0



            'view output

            Cls

            _PutImage (0, 0), doneImage&

            _Display

            Sleep

            _FreeImage doneImage&

            End





        End If

    End If



    _Limit 30

    _Display

Loop



Sub GETPOINTS (x1, y1, x2, y2, A() As LinePoints)

    Dim lenght As Integer

    lenght = _Hypot(x1 - x2, y1 - y2) 'Fellippe Heitor show me using this great function.

    ReDim A(lenght) As LinePoints

    For fill = 0 To lenght

        If x1 > x2 Then A(fill).X = x1 - fill * ((x1 - x2) / lenght)

        If x1 < x2 Then A(fill).X = x1 + fill * ((x2 - x1) / lenght)

        If x1 = x2 Then A(fill).X = x1

        If y1 > y2 Then A(fill).Y = y1 - fill * ((y1 - y2) / lenght)

        If y1 < y2 Then A(fill).Y = y1 + fill * ((y2 - y1) / lenght)

        If y1 = y2 Then A(fill).Y = y1

    Next

End Sub