Copying and pasting a non-rectangular area of screen

[Petr]

Hey, I needed to dust the cobwebs out of my brain anyway and this caught my eye (obviously I couldn't find the old source), so a bit of thinking and here's the output. Mark any shape, the condition is that you must connect the beginning of the line with the end (tolerance of 5 pixels from each other). After marking the selection of the image, the program will only show you what you marked with the selection.

Code: (Select All)

'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

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



            'copy full rectangle image area to new image

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

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





            'create alpha mask for image

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

            _Dest Mask&

            Cls 'now is the background color black and alpha is full - set to 0,0,0,255



            For D = 1 To max

                Line (-minX + P(D - 1).x, -minY + P(D - 1).y)-(-minX + P(D).x, -minY + P(D).y), _RGB32(100)

            Next

            Line (-minX + P(0).x, -minY + P(0).y)-(-minX + P(max).x, -minY + P(max).y), _RGB32(100)



            Paint (_Width(Mask&) \ 2, _Height(Mask&) \ 2), _RGB32(100) 'colorize selected area

            _SetAlpha 0, _RGB32(100), Mask&





            'place mask image

            _PutImage , Mask&, copyImg&

            _FreeImage Mask&

            _Dest 0

            _Source 0

            'view output

            Cls

            _PutImage (0, 0), copyImg&

            _FreeImage copyImg&

            End





        End If

    End If



    _Limit 30

    _Display

Loop