09-25-2024, 07:24 PM (This post was last modified: 09-25-2024, 07:25 PM by TerryRitchie.)
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
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 |
' -----------------------------------------
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
' --------------------------------------------------------------
'| 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 |
' -------------------------------------
'-----------------------------------------------------------------------------------------------------------------------------------------
SUB PolyMinMax (Poly() AS TYPE_IPOINT, MinX AS INTEGER, MinY AS INTEGER, MaxX AS INTEGER, MaxY AS INTEGER)
' ------------------------------
'| Get the polygon bounding box |
' ------------------------------
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
' --------------------------------
'| 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. |
' -------------------------------------------------------------------------
' -------------------------------------------------
'| Get the line that creates this new polygon side |
' -------------------------------------------------
' ---------------------------------------------------------------
'| 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)
(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
I will try it as you describe. Thanks for the advice.
(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
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 |
' -----------------------------------------
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
' --------------------------------------------------------------
'| 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 |
' -------------------------------------
'-----------------------------------------------------------------------------------------------------------------------------------------
SUB PolyMinMax (Poly() AS TYPE_IPOINT, MinX AS INTEGER, MinY AS INTEGER, MaxX AS INTEGER, MaxY AS INTEGER)
' ------------------------------
'| Get the polygon bounding box |
' ------------------------------
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
' --------------------------------
'| 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. |
' -------------------------------------------------------------------------
' -------------------------------------------------
'| Get the line that creates this new polygon side |
' -------------------------------------------------
' ---------------------------------------------------------------
'| 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)
(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
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 |
' -----------------------------------------
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
' --------------------------------------------------------------
'| 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 |
' -------------------------------------
'-----------------------------------------------------------------------------------------------------------------------------------------
SUB PolyMinMax (Poly() AS TYPE_IPOINT, MinX AS INTEGER, MinY AS INTEGER, MaxX AS INTEGER, MaxY AS INTEGER)
' ------------------------------
'| Get the polygon bounding box |
' ------------------------------
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
' --------------------------------
'| 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. |
' -------------------------------------------------------------------------
' -------------------------------------------------
'| Get the line that creates this new polygon side |
' -------------------------------------------------
' ---------------------------------------------------------------
'| 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)
09-26-2024, 02:14 AM (This post was last modified: 09-26-2024, 03:54 AM by TerryRitchie.)
--------------------------------------------------------------------------------------
UPDATE: OK, code works now. Error fixed.
--------------------------------------------------------------------------------------
I have cleaned the code up considerably and made it much faster. The PAINT statement now only has to paint a small area on the mask image instead of painting out the entire image.
I also condensed everything into one subroutine, ClipPolygon.
GetPolygon and LineCollide% are only needed for demo purposes.
Code: (Select All)
' Clip a polygon from an image
OPTION _EXPLICIT ' declare those variables
TYPE TYPE_IPOINT ' X,Y INTEGER POINT PAIR
x AS INTEGER ' x value
y AS INTEGER ' y value
END TYPE
TYPE TYPE_LINE ' LINE SEGMENT DEFINITION
Start AS TYPE_IPOINT ' x,y start of line segment
Finish AS TYPE_IPOINT ' x,y end of line segment
END TYPE
REDIM Poly(0) AS TYPE_IPOINT ' polygon points
DIM Image AS LONG ' image to clip from
DIM Clip AS LONG ' clipped image
DIM sWidth AS INTEGER ' width of image
DIM sHeight AS INTEGER ' height of image
' -----------------
'| Begin demo code |
' -----------------
Image = _LOADIMAGE("canyon.png", 32) ' get image to clip from
sWidth = _WIDTH(Image) ' image width
sHeight = _HEIGHT(Image) ' image height
SCREEN _NEWIMAGE(sWidth, sHeight, 32) ' create graphics screen to hold image
_PUTIMAGE (0, 0), Image ' display the image
GetPolygon Image, Poly() ' get polygon using mouse
ClipPolygon Image, Poly(), Clip ' clip polygon from image
CLS
_PUTIMAGE (0, 0), Clip ' display the final polygon clipped from the image
'-----------------------------------------------------------------------------------------------------------------------------------------
SUB ClipPolygon (Image AS LONG, Poly() AS TYPE_IPOINT, Clip AS LONG)
' ---------------------------------------------
'| Clip an image contained in a polygon |
'| |
'| Image - the source image |
'| Poly() - the list of polygon points |
'| Clip - the returned clipped polygon image |
' ---------------------------------------------
CONST TRACE~& = _RGBA32(0, 0, 1, 255) ' polygon outline color
CONST OUTER~& = _RGBA32(255, 0, 255, 255) ' outside the polygon (bright magenta)
CONST INNER~& = _RGBA32(0, 0, 0, 0) ' inside the polygon (transparent black)
DIM Min AS TYPE_IPOINT ' minimum polygon x,y points seen (upper left boundary box)
DIM Max AS TYPE_IPOINT ' maximum polygon x,y points seen (lower right boundary box)
DIM ImageCopy AS LONG ' copy of image to work with
DIM Mask AS LONG ' image mask
DIM oDest AS LONG ' calling destination image
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
' -------------------------------------
'| Create a copy of image to work with |
' -------------------------------------
oDest = _DEST ' save calling destination
ImageCopy = _COPYIMAGE(Image, 32) ' create a copy of image to work with
_DEST ImageCopy ' draw on the image copy
' --------------------------------------------------------
'| Get polygon bounding box while tracing polygon outline |
' --------------------------------------------------------
Min = Poly(0) ' seed minimum values
Max = Poly(0) ' seed maximum values
p = 0 ' reset point counter
PSET (Poly(0).x, Poly(0).y), TRACE ' set graphics cursor at first polypoint point
DO ' begin tracing loop
LINE -(Poly(p).x, Poly(p).y), TRACE ' draw a line to next polygon point
IF Poly(p).x < Min.x THEN ' is this the farthest left seen?
Min.x = Poly(p).x ' yes, record as minimum x
ELSEIF Poly(p).x > Max.x THEN ' no, is this the farthest right seen?
Max.x = Poly(p).x ' yes, record as maximum x
END IF
IF Poly(p).y < Min.y THEN ' if this the top-most seen?
Min.y = Poly(p).y ' yes, record as minimum y
ELSEIF Poly(p).y > Max.y THEN ' no, is this the bottom-most seen?
Max.y = Poly(p).y ' yes, record as maximum y
END IF
p = p + 1 ' increment point counter
LOOP UNTIL p > UBOUND(Poly) ' leave when all points examined
LINE -(Poly(0).x, Poly(0).y), TRACE ' connected last point of polygon to first point
' -------------------------------------
'| Create an image mask of the polygon |
' -------------------------------------
Mask = _NEWIMAGE(Max.x - Min.x + 3, Max.y - Min.y + 3, 32) ' create mask image holder
_PUTIMAGE (1, 1), ImageCopy, Mask, (Min.x, Min.y)-(Max.x, Max.y) ' copy polygon boundary to mask
_DEST Mask ' draw on mask
$CHECKING:OFF
PAINT (0, 0), OUTER, TRACE ' paint mask outside of polygon
m = _MEMIMAGE(Mask) ' create image memory buffer
o = m.OFFSET ' get start memory location
e = o + m.SIZE ' calculate end memory location
DO ' begin color replace loop
_MEMGET m, o, p ' get pixel at memory location
IF p <> OUTER THEN _MEMPUT m, o, INNER AS _UNSIGNED LONG ' if pixel is not outer color change to inner color
o = o + 4 ' advance 4 bytes (RGBA = 32 bits)
LOOP UNTIL o = e ' leave when end of memory reached
_MEMFREE m ' free memory buffer
$CHECKING:ON
' -----------------------------------
'| Apply the mask and clip the image |
' -----------------------------------
Clip = _NEWIMAGE(Max.x - Min.x, Max.y - Min.y, 32) ' create the clipped image holder
_PUTIMAGE (0, 0), Image, ImageCopy ' restore copy of image
_PUTIMAGE (Min.x - 1, Min.y - 1), Mask, ImageCopy ' place mask over image
_PUTIMAGE (0, 0), ImageCopy, Clip, (Min.x, Min.y)-(Max.x, Max.y) ' clip masked area from image
_CLEARCOLOR OUTER, Clip ' set outer mask color as transparent
_FREEIMAGE ImageCopy ' free image copy
_FREEIMAGE Mask ' free mask image
_DEST oDest ' restore calling destination
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
' --------------------------------
'| 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. |
' -------------------------------------------------------------------------
' -------------------------------------------------
'| Get the line that creates this new polygon side |
' -------------------------------------------------
' ---------------------------------------------------------------
'| 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 SUB
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)
The improved code just above had an error in it for about an hour after I posted it. If the lower right side of the clipped image is always square then you copied the buggy code. The code above has been corrected. Sorry for the confusion.
New to QB64pe? Visit the QB64 tutorial to get started. QB64 Tutorial
09-26-2024, 07:59 AM (This post was last modified: 09-26-2024, 08:14 AM by Petr.)
Hello again. I just couldn't do it - get out from this program. When free-selecting a section of an image in a painting, the selection line can easily be crossed several times and the selection will be made correctly. That was my next goal.
I guess partly because I was trying to apply the solution that Steve wrote here, partly because I was looking at TerryRitchie's source code and eventually somehow connected it all together in my head and reworked my version.
Now I can say that I am satisfied. Try this version. When selecting, make different figure eights, curls, spirals, feel free to cross the selection line several times. The only condition - the beginning and end of the selection line must connect (as in previous versions). Now I would say it finally works the same as in drawing.
In the source code is intentionally only commented with apostrophes the sections of the program that there are for debugging.
Code: (Select All)
'copy/paste polygon image
'use mouse for inserting image
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
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
Source code upgraded, so line for selecting is not visible in output image now.
